Merge pull request #14 from davorg/7-abbreviate-multiple-greats

Add abbr attribute

Changes.md

@@ -1,12 +1,16 @@
 # Change Log
 
-## [Unreleased]
+## [0.2.0 - 2023-05-24]
 
 ### Fixed
 
 - Pod error
 - IDs no longer need to be numbers
+
+### Added
+
 - Added `get_relationship_ancestors()` method
+- Added `abbr` attribute
 
 ## [0.1.2] - 2023-05-23
 

lib/Genealogy/Relationship.pm

@@ -75,6 +75,18 @@ how to fix it as soon as possible.
 
 =back
 
+=head2 Constructor
+
+The constructor for this class takes one optional attribute called `abbr`.
+The default value for this attribute is 2. When set, strings of repeated
+"great"s in a relationship description will collapsed to "$n x great".
+
+For example, if the description you have is "Great, great, great
+grandfather", then that will be abbreviated to to "3 x great grandfather".
+
+The value for `abbr` is the maximum number of repetitions that will be left
+untouched. You can turn abbreviations off by setting `abbr` to zero.
+
 =head2 Caching
 
 Calculating relationship names isn't at all different. But there can be a lot
@@ -89,12 +101,12 @@ consider putting a caching layer in front of C<get_relationship>.
 package Genealogy::Relationship;
 
 use Moo;
-use Types::Standard qw[Str HashRef];
+use Types::Standard qw[Int Str HashRef];
 use List::Util qw[first];
 use List::MoreUtils qw[firstidx];
 use Lingua::EN::Numbers qw[num2en num2en_ordinal];
 
-our $VERSION = '0.1.2';
+our $VERSION = '0.2.0';
 
 has parent_field_name => (
   is => 'ro',
@@ -141,6 +153,12 @@ sub _build_relationship_table {
   };
 }
 
+has abbr => (
+  is => 'ro',
+  isa => Int,
+  default => 3,
+);
+
 =head1 Methods
 
 The following methods are defined.
@@ -207,12 +225,40 @@ sub get_relationship {
 
   my ($x, $y) = $self->get_relationship_coords($person1, $person2);
 
+  my $rel;
+
   if (defined $self->relationship_table->{$person1->gender}[$x][$y]) {
-    return $self->relationship_table->{$person1->gender}[$x][$y];
+    $rel = $self->relationship_table->{$person1->gender}[$x][$y];
   } else {
-    return $self->relationship_table->{$person1->gender}[$x][$y] =
+    $rel = $self->relationship_table->{$person1->gender}[$x][$y] =
       ucfirst $self->make_rel($person1->gender, $x, $y);
   }
+
+  $rel = $self->abbr_rel($rel) if $self->abbr;
+
+  return $rel;
+}
+
+=head2 abbr_rel
+
+Optionally abbreviate a relationship description.
+
+=cut
+
+sub abbr_rel {
+  my $self = shift;
+  my ($rel) = @_;
+
+  return $rel unless $self->abbr;
+
+  my @greats = $rel =~ /(great)/gi;
+  my $count  = @greats;
+
+  return $rel if $count < $self->abbr;
+
+  $rel =~ s/(great,\s+)+/$count x /i;
+
+  return $rel;
 }
 
 =head2 make_rel

t/03-cousins.t

@@ -22,12 +22,12 @@ my @expected = (
   [ 'First cousin',   'Uncle' ],
   [ 'Second cousin',  'Great uncle' ],
   [ 'Third cousin',   'Great, great uncle' ],
-  [ 'Fourth cousin',  'Great, great, great uncle' ],
-  [ 'Fifth cousin',   'Great, great, great, great uncle' ],
-  [ 'Sixth cousin',   'Great, great, great, great, great uncle' ],
-  [ 'Seventh cousin', 'Great, great, great, great, great, great uncle' ],
-  [ 'Eighth cousin',  'Great, great, great, great, great, great, great uncle' ],
-  [ 'Ninth cousin',   'Great, great, great, great, great, great, great, great uncle' ],
+  [ 'Fourth cousin',  '3 x great uncle' ],
+  [ 'Fifth cousin',   '4 x great uncle' ],
+  [ 'Sixth cousin',   '5 x great uncle' ],
+  [ 'Seventh cousin', '6 x great uncle' ],
+  [ 'Eighth cousin',  '7 x great uncle' ],
+  [ 'Ninth cousin',   '8 x great uncle' ],
 );
 
 for my $g (1 .. 10) {
@@ -73,4 +73,19 @@ is($rel->get_relationship($generations[9][0], $generations[9][1]),
 is($rel->get_relationship($generations[8][0], $generations[5][1]),
    'Fourth cousin three times removed');
 
-done_testing;
+can_ok($rel, 'abbr');
+
+# Test a higher number for abbr
+$rel = Genealogy::Relationship->new(abbr => 4);
+is($rel->get_relationship($generations[1][0], $generations[5][1]), 'Great, great, great uncle');
+is($rel->get_relationship($generations[1][0], $generations[6][1]), '4 x great uncle');
+
+# Turn off abbr
+$rel = Genealogy::Relationship->new(abbr => 0);
+is($rel->get_relationship($generations[1][0], $generations[3][1]), 'Great uncle');
+is($rel->get_relationship($generations[1][0], $generations[4][1]), 'Great, great uncle');
+is($rel->get_relationship($generations[1][0], $generations[5][1]), 'Great, great, great uncle');
+
+
+done_testing;
+