Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm

   1 package MFHD::Caption;
   2 use strict;
   3 use integer;
   4 use Carp;
   5
   6 use Data::Dumper;
   7
   8 use OpenILS::Utils::MFHD::Date;
   9
  10 use base 'MARC::Field';
  11
  12 sub new {
  13     my $proto     = shift;
  14     my $class     = ref($proto) || $proto;
  15     my $self      = shift;
  16     my $last_enum = undef;
  17
  18     $self->{_mfhdc_ENUMS}        = {};
  19     $self->{_mfhdc_CHRONS}       = {};
  20     $self->{_mfhdc_PATTERN}      = {};
  21     $self->{_mfhdc_COPY}         = undef;
  22     $self->{_mfhdc_UNIT}         = undef;
  23     $self->{_mfhdc_LINK_ID}      = undef;
  24     $self->{_mfhdc_COMPRESSIBLE} = 1;       # until proven otherwise
  25
  26     foreach my $subfield ($self->subfields) {
  27         my ($key, $val) = @$subfield;
  28         if ($key eq '8') {
  29             $self->{_mfhdc_LINK_ID} = $val;
  30         } elsif ($key =~ /[a-h]/) {
  31             # Enumeration Captions
  32             $self->{_mfhdc_ENUMS}->{$key} = {
  33                 CAPTION => $val,
  34                 COUNT   => undef,
  35                 RESTART => undef
  36             };
  37             if ($key =~ /[ag]/) {
  38                 $last_enum = undef;
  39             } else {
  40                 $last_enum = $key;
  41             }
  42         } elsif ($key =~ /[i-m]/) {
  43             # Chronology captions
  44             $self->{_mfhdc_CHRONS}->{$key} = $val;
  45         } elsif ($key eq 'u') {
  46             # Bib units per next higher enumeration level
  47
  48             # Some files seem to have "empty" $u subfields,
  49             # especially for top level of enumeration. Just drop them
  50             next if (!defined($val) || !$val);
  51
  52             carp('$u specified for top-level enumeration')
  53               unless defined($last_enum);
  54             $self->{_mfhdc_ENUMS}->{$last_enum}->{COUNT} = $val;
  55         } elsif ($key eq 'v') {
  56             # Is this level of enumeration continuous, or does it restart?
  57
  58             # Some files seem to have "empty" $v subfields,
  59             # especially for top level of enumeration. Just drop them
  60             next if (!defined($val) || !$val);
  61
  62             carp '$v specified for top-level enumeration'
  63               unless defined($last_enum);
  64             $self->{_mfhdc_ENUMS}->{$last_enum}->{RESTART} = ($val eq 'r');
  65         } elsif ($key =~ /[npwz]/) {
  66             # Publication Pattern info ('o' == type of unit, 'q'..'t' undefined)
  67             $self->{_mfhdc_PATTERN}->{$key} = $val;
  68         } elsif ($key =~ /x/) {
  69             # Calendar change can have multiple comma-separated values
  70             $self->{_mfhdc_PATTERN}->{x} = [split /,/, $val];
  71         } elsif ($key eq 'y') {
  72             $self->{_mfhdc_PATTERN}->{y} = {}
  73               unless exists $self->{_mfhdc_PATTERN}->{y};
  74             update_pattern($self, $val);
  75         } elsif ($key eq 'o') {
  76             # Type of unit
  77             $self->{_mfhdc_UNIT} = $val;
  78         } elsif ($key eq 't') {
  79             $self->{_mfhdc_COPY} = $val;
  80         } else {
  81             carp "Unknown caption subfield '$key'";
  82         }
  83     }
  84
  85     # subsequent levels of enumeration (primary and alternate)
  86     # If an enumeration level doesn't document the number
  87     # of "issues" per "volume", or whether numbering of issues
  88     # restarts, then we can't compress.
  89     foreach my $key ('b', 'c', 'd', 'e', 'f', 'h') {
  90         if (exists $self->{_mfhdc_ENUMS}->{$key}) {
  91             my $pattern = $self->{_mfhdc_ENUMS}->{$key};
  92             if (   !$pattern->{RESTART}
  93                 || !$pattern->{COUNT}
  94                 || ($pattern->{COUNT} eq 'var')
  95                 || ($pattern->{COUNT} eq 'und')) {
  96                 $self->{_mfhdc_COMPRESSIBLE} = 0;
  97                 last;
  98             }
  99         }
 100     }
 101
 102     my $pat = $self->{_mfhdc_PATTERN};
 103
 104     # If there's a $x subfield and a $j, then it's compressible
 105     if (exists $pat->{x} && exists $self->{_mfhdc_CHRONS}->{'j'}) {
 106         $self->{_mfhdc_COMPRESSIBLE} = 1;
 107     }
 108
 109     bless($self, $class);
 110
 111     return $self;
 112 }
 113
 114 sub update_pattern {
 115     my $self    = shift;
 116     my $val     = shift;
 117     my $pathash = $self->{_mfhdc_PATTERN}->{y};
 118     my ($pubcode, $pat) = unpack("a1a*", $val);
 119
 120     $pathash->{$pubcode} = [] unless exists $pathash->{$pubcode};
 121     push @{$pathash->{$pubcode}}, $pat;
 122 }
 123
 124 sub decode_pattern {
 125     my $self    = shift;
 126     my $pattern = $self->{_mfhdc_PATTERN}->{y};
 127
 128     # XXX WRITE ME (?)
 129 }
 130
 131 sub pattern {
 132     my $self = shift;
 133
 134     return $self->{_mfhdc_PATTERN};
 135 }
 136
 137 sub compressible {
 138     my $self = shift;
 139
 140     return $self->{_mfhdc_COMPRESSIBLE};
 141 }
 142
 143 sub chrons {
 144     my $self = shift;
 145     my $key  = shift;
 146
 147     if (exists $self->{_mfhdc_CHRONS}->{$key}) {
 148         return $self->{_mfhdc_CHRONS}->{$key};
 149     } else {
 150         return undef;
 151     }
 152 }
 153
 154 sub capfield {
 155     my $self = shift;
 156     my $key  = shift;
 157
 158     if (exists $self->{_mfhdc_ENUMS}->{$key}) {
 159         return $self->{_mfhdc_ENUMS}->{$key};
 160     } elsif (exists $self->{_mfhdc_CHRONS}->{$key}) {
 161         return $self->{_mfhdc_CHRONS}->{$key};
 162     } else {
 163         return undef;
 164     }
 165 }
 166
 167 sub capstr {
 168     my $self = shift;
 169     my $key  = shift;
 170     my $val  = $self->capfield($key);
 171
 172     if (ref $val) {
 173         return $val->{CAPTION};
 174     } else {
 175         return $val;
 176     }
 177 }
 178
 179 sub type_of_unit {
 180     my $self = shift;
 181
 182     return $self->{_mfhdc_UNIT};
 183 }
 184
 185 sub link_id {
 186     my $self = shift;
 187
 188     return $self->{_mfhdc_LINK_ID};
 189 }
 190
 191 sub calendar_change {
 192     my $self = shift;
 193
 194     return $self->{_mfhdc_PATTERN}->{x};
 195 }
 196
 197 # If items are identified by chronology only, with no separate
 198 # enumeration (eg, a newspaper issue), then the chronology is
 199 # recorded in the enumeration subfields $a - $f.  We can tell
 200 # that this is the case if there are $a - $f subfields and no
 201 # chronology subfields ($i-$k), and none of the $a-$f subfields
 202 # have associated $u or $v subfields, but there's a $w and no $x
 203
 204 sub enumeration_is_chronology {
 205     my $self = shift;
 206
 207     # There is always a '$a' subfield in well-formed fields.
 208     return 0
 209       if exists $self->{_mfhdc_CHRONS}->{i}
 210           || exists $self->{_mfhdc_PATTERN}->{x};
 211
 212     foreach my $key ('a'..'f') {
 213         my $enum;
 214
 215         last if !exists $self->{_mfhdc_ENUMS}->{$key};
 216
 217         $enum = $self->{_mfhdc_ENUMS}->{$key};
 218         return 0 if defined $enum->{COUNT} || defined $enum->{RESTART};
 219     }
 220
 221     return (exists $self->{_mfhdc_PATTERN}->{w});
 222 }
 223
 224 sub regularity_match {
 225     my $self    = shift;
 226     my $pubcode = shift;
 227     my @date    = @_;
 228
 229     # we can't match something that doesn't exist.
 230     return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{$pubcode};
 231
 232     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{$pubcode}}) {
 233         my $chroncode = substr($regularity, 0, 1);
 234         my $matchfunc = MFHD::Date::dispatch($chroncode);
 235         my @pats      = split(/,/, substr($regularity, 1));
 236
 237         if (!defined $matchfunc) {
 238             carp "Unrecognized chroncode '$chroncode'";
 239             return 0;
 240         }
 241
 242         # XXX WRITE ME
 243         foreach my $pat (@pats) {
 244             $pat =~ s|/.+||;    # If it's a combined date, match the start
 245             if ($matchfunc->($pat, @date)) {
 246                 return 1;
 247             }
 248         }
 249     }
 250
 251     return 0;
 252 }
 253
 254 sub is_omitted {
 255     my $self = shift;
 256     my @date = @_;
 257
 258     #     printf("# is_omitted: testing date %s: %d\n", join('/', @date),
 259     #      $self->regularity_match('o', @date));
 260     return $self->regularity_match('o', @date);
 261 }
 262
 263 sub is_published {
 264     my $self = shift;
 265     my @date = @_;
 266
 267     return $self->regularity_match('p', @date);
 268 }
 269
 270 sub is_combined {
 271     my $self = shift;
 272     my @date = @_;
 273
 274     return $self->regularity_match('c', @date);
 275 }
 276
 277 sub enum_is_combined {
 278     my $self     = shift;
 279     my $subfield = shift;
 280     my $iss      = shift;
 281     my $level    = ord($subfield) - ord('a') + 1;
 282
 283     return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{c};
 284
 285     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{c}}) {
 286         next unless $regularity =~ m/^e$level/o;
 287
 288         my @pats = split(/,/, substr($regularity, 2));
 289
 290         foreach my $pat (@pats) {
 291             $pat =~ s|/.+||;    # if it's a combined issue, match the start
 292             return 1 if ($iss eq $pat);
 293         }
 294     }
 295
 296     return 0;
 297 }
 298
 299 # Test to see if $dt1 is on or after $dt2
 300 # if length(@{$dt2} == 2, then just month/day are compared
 301 # if length(@{$dt2} == 1, then just the months are compared
 302 sub on_or_after {
 303     my $dt1 = shift;
 304     my $dt2 = shift;
 305
 306 #     printf("# on_or_after(%s, %s): ", join('/', @{$dt1}), join('/', @{$dt2}));
 307
 308     foreach my $i (0..(scalar(@{$dt2}) - 1)) {
 309         if ($dt1->[$i] > $dt2->[$i]) {
 310             #       printf("after - pass\n");
 311             # $dt1 occurs AFTER $dt2
 312             return 1;
 313         } elsif ($dt1->[$i] < $dt2->[$i]) {
 314             #       printf("before - fail\n");
 315             # $dt1 occurs BEFORE $dt2
 316             return 0;
 317         }
 318         # both are still equal, keep going
 319     }
 320
 321     # We fell out of the loop with them being equal, so it's 'on'
 322     #     printf("on - pass\n");
 323     return 1;
 324 }
 325
 326 sub calendar_increment {
 327     my $self       = shift;
 328     my $cur        = shift;
 329     my $new        = shift;
 330     my $cal_change = $self->calendar_change;
 331     my $month;
 332     my $day;
 333     my $cur_before;
 334     my $new_on_or_after;
 335
 336     # A calendar change is defined, need to check if it applies
 337     if (scalar(@{$new}) == 1) {
 338         carp "Can't calculate date change for ", $self->as_string;
 339         return 0;
 340     }
 341
 342     foreach my $change (@{$cal_change}) {
 343         my $incr;
 344
 345         if (length($change) == 2) {
 346             $month = $change;
 347         } elsif (length($change) == 4) {
 348             ($month, $day) = unpack("a2a2", $change);
 349         }
 350
 351         #       printf("# calendar_increment('%s', '%s'): change on '%s/%s'\n",
 352         #              join('/', @{$cur}), join('/', @{$new}),
 353         #              $month, defined($day) ? $day : 'UNDEF');
 354
 355         if ($cur->[0] == $new->[0]) {
 356             # Same year, so a 'simple' month/day comparison will be fine
 357             $incr =
 358               (     !on_or_after([$cur->[1], $cur->[2]], [$month, $day])
 359                   && on_or_after([$new->[1], $new->[2]], [$month, $day]));
 360         } else {
 361             # @cur is in the year before @new. There are
 362             # two possible cases for the calendar change date that
 363             # indicate that it's time to change the volume:
 364             # (1) the change date is AFTER @cur in the year, or
 365             # (2) the change date is BEFORE @new in the year.
 366             #
 367             #  -------|------|------X------|------|
 368             #       @cur    (1)   Jan 1   (2)   @new
 369
 370             $incr =
 371               (on_or_after([$new->[1], $new->[2]], [$month, $day])
 372                   || !on_or_after([$cur->[1], $cur->[2]], [$month, $day]));
 373         }
 374         return $incr if $incr;
 375     }
 376
 377     return 0;
 378 }
 379
 380 sub next_chron {
 381     my $self  = shift;
 382     my $next  = shift;
 383     my $carry = shift;
 384     my @keys  = @_;
 385     my @cur;
 386     my @new;
 387     my @newend;    # only used for combined issues
 388     my $incr;
 389
 390     my $reg     = $self->{_mfhdc_REGULARITY};
 391     my $pattern = $self->{_mfhdc_PATTERN};
 392     my $freq    = $pattern->{w};
 393
 394     foreach my $i (0..$#keys) {
 395         if (exists $next->{$keys[$i]}) {
 396             $cur[$i] = $next->{$keys[$i]};
 397             # If the current issue has a combined date (eg, May/June)
 398             # get rid of the first date and base the calculation
 399             # on the final date in the combined issue.
 400             $cur[$i] =~ s|^[^/]+/||;
 401         }
 402     }
 403
 404     if (defined $pattern->{y}->{p}) {
 405         # There is a $y publication pattern defined in the record:
 406         # use it to calculate the next issue date.
 407
 408         foreach my $pubpat (@{$pattern->{y}->{p}}, @{$pattern->{y}->{c}}) {
 409             my $chroncode = substr($pubpat, 0, 1);
 410             my $genfunc   = MFHD::Date::generator($chroncode);
 411             my @pats      = split(/,/, substr($pubpat, 1));
 412
 413             next if $chroncode eq 'e';
 414
 415             if (!defined $genfunc) {
 416                 carp "Unrecognized chroncode '$chroncode'";
 417                 return undef;
 418             }
 419
 420             foreach my $pat (@pats) {
 421                 my $combined = $pat =~ m|/|;
 422                 my ($start, $end);
 423                 my @candidate;
 424
 425                 #               printf("# next_date: generating with pattern '%s'\n", $pat);
 426
 427                 if ($combined) {
 428                     ($start, $end) = split('/', $pat, 2);
 429                 } else {
 430                     ($start, $end) = (undef, undef);
 431                 }
 432
 433                 @candidate = $genfunc->($start || $pat, \@cur, $self);
 434
 435                 while ($self->is_omitted(@candidate)) {
 436                     #               printf("# pubpat omitting date '%s'\n",
 437                     #                      join('/', @candidate));
 438                     @candidate = $genfunc->($start || $pat, \@candidate, $self);
 439                 }
 440
 441                 #               printf("# testing new candidate '%s' against '%s'\n",
 442                 #                      join('/', @candidate), join('/', @new));
 443
 444                 if (!defined($new[0]) || !on_or_after(\@candidate, \@new)) {
 445                     # first time through the loop
 446                     # or @candidate is before @new =>
 447                     # @candidate is the next issue.
 448                     @new = @candidate;
 449                     if (defined $end) {
 450                         @newend = $genfunc->($end, \@cur, $self);
 451                     } else {
 452                         $newend[0] = undef;
 453                     }
 454
 455            #                printf("# selecting candidate date '%s'\n", join('/', @new));
 456                 }
 457             }
 458         }
 459
 460         $new[1] = 24 if ($new[1] == 20); # restore fake early winter
 461
 462         if (defined($newend[0])) {
 463             # The best match was a combined issue
 464             foreach my $i (0..$#new) {
 465                 # don't combine identical fields
 466                 next if $new[$i] eq $newend[$i];
 467                 $new[$i] .= '/' . $newend[$i];
 468             }
 469         }
 470     }
 471
 472     if (scalar @new == 0) {
 473         # There was no suitable publication pattern defined,
 474         # so use the $w frequency to figure out the next date
 475         if (!defined($freq)) {
 476             carp "Undefined frequency in next_chron!";
 477         } elsif (!MFHD::Date::can_increment($freq)) {
 478             carp "Don't know how to deal with frequency '$freq'!";
 479         } else {
 480             # One of the standard defined issue frequencies
 481             @new = MFHD::Date::incr_date($freq, @cur);
 482
 483             while ($self->is_omitted(@new)) {
 484                 @new = MFHD::Date::incr_date($freq, @new);
 485             }
 486
 487             if ($self->is_combined(@new)) {
 488                 my @second_date = MFHD::Date::incr_date($freq, @new);
 489                 foreach my $i (0..$#new) {
 490                     # don't combine identical fields
 491                     next if $new[$i] eq $second_date[$i];
 492                     $new[$i] .= '/' . $second_date[$i];
 493                 }
 494             }
 495         }
 496     }
 497
 498     for my $i (0..$#new) {
 499         $next->{$keys[$i]} = $new[$i];
 500     }
 501
 502     # Figure out if we need to adjust volume number
 503     #
 504     # If we are incrementing based on date, $carry doesn't
 505     # matter: we're not going to increment the v. number twice
 506     #
 507     # It is conceivable that a serial could increment based on date for some
 508     # volumes and issue numbering for other volumes, but until a real case
 509     # comes up, let's assume that defined calendar changes always trump $u
 510     if (defined $pattern->{x}) {
 511         my $increment = $self->calendar_increment(\@cur, \@new);
 512         # if we hit a calendar change, restart dependant restarters
 513         # regardless of whether they thought they should
 514         if ($increment) {
 515             $next->{a} += $increment;
 516             foreach my $key ('b'..'f') {
 517                 next if !exists $next->{$key};
 518                 my $cap = $self->capfield($key);
 519                 if ($cap->{RESTART}) {
 520                     $next->{$key} = 1;
 521                     if ($self->enum_is_combined($key, $next->{$key})) {
 522                         $next->{$key} .= '/' . ($next->{$key} + 1);
 523                     }
 524                 } else {
 525                     last; # if we find a non-restarting level, stop
 526                 }
 527             }
 528         }
 529     } elsif ($carry) {
 530         $next->{a} += $carry;
 531     }
 532 }
 533
 534 sub winter_starts_year {
 535     my $self = shift;
 536
 537     my $pubpats = $self->{_mfhdc_PATTERN}->{y}->{p};
 538     my $freq = $self->{_mfhdc_PATTERN}->{w};
 539
 540     if ($freq =~ /^\d$/) {
 541         foreach my $pubpat (@$pubpats) {
 542             my $chroncode = substr($pubpat, 0, 1);
 543             if ($chroncode eq 's' and substr($pubpat, 1, 2) == 24) {
 544                 return 1;
 545             }
 546         }
 547     }
 548     return 0;
 549 }
 550
 551
 552 sub next_alt_enum {
 553     my $self = shift;
 554     my $next = shift;
 555
 556     # First handle any "alternative enumeration", since they're
 557     # a lot simpler, and don't depend on the the calendar
 558     foreach my $key ('h', 'g') {
 559         next if !exists $next->{$key};
 560         if (!$self->capstr($key)) {
 561             warn "Holding data exists for $key, but no caption specified";
 562             $next->{$key} += 1;
 563             last;
 564         }
 565
 566         my $cap = $self->capfield($key);
 567         if (   $cap->{RESTART}
 568             && $cap->{COUNT}
 569             && ($next->{$key} == $cap->{COUNT})) {
 570             $next->{$key} = 1;
 571         } else {
 572             $next->{$key} += 1;
 573             last;
 574         }
 575     }
 576 }
 577
 578 # Check caption for $ype subfield, specifying that there's a
 579 # particular publication pattern for the given level of enumeration
 580 # returns the pattern string or undef
 581 sub enum_pubpat {
 582     my $self  = shift;
 583     my $level = shift;
 584
 585     return undef if !exists $self->{_mfhdc_PATTERN}->{y}->{p};
 586
 587     foreach my $reg (@{$self->{_mfhdc_PATTERN}->{y}->{p}}) {
 588         if ($reg =~ m/^e$level/o) {
 589             return substr($reg, 2);
 590         }
 591     }
 592     return undef;
 593 }
 594
 595 sub next_enum {
 596     my $self = shift;
 597     my $next = shift;
 598     my $carry;
 599
 600     # $carry keeps track of whether we need to carry into the next
 601     # higher level of enumeration. It's not actually necessary except
 602     # for when the loop ends: if we need to carry from $b into $a
 603     # then $carry will be set when the loop ends.
 604     #
 605     # We need to keep track of this because there are two different
 606     # reasons why we might increment the highest level of enumeration ($a)
 607     # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly)
 608     # 2) it's the right time of the year.
 609     #
 610
 611     # If there's a subfield b, then we will go through the loop at
 612     # least once. If there's no subfield b, then there's only a single
 613     # level of enumeration, so we just add one to it and we're done.
 614     if (exists $next->{b}) {
 615         $carry = 0;
 616     } else {
 617         $carry = 1;
 618     }
 619     foreach my $key (reverse('b'..'f')) {
 620         my $level;
 621         my $pubpat;
 622
 623         next if !exists $next->{$key};
 624
 625         # If the current issue has a combined issue number (eg, 2/3)
 626         # get rid of the first issue number and base the calculation
 627         # on the final issue number in the combined issue.
 628         if ($next->{$key} =~ m|/|) {
 629             $next->{$key} =~ s|^[^/]+/||;
 630         }
 631
 632         $level = ord($key) - ord('a') + 1;    # enumeration level
 633
 634         $pubpat = $self->enum_pubpat($level);
 635
 636         if ($pubpat) {
 637             #       printf("# next_enum: found pubpat '%s' for subfield '%s'\n",
 638             #              $pubpat, $key);
 639             my @pats = split(/,/, $pubpat);
 640
 641             # If we fall out the bottom of the loop, then $carry
 642             # will still be 1, and we will reset the current
 643             # level to the first value in @pats and increment
 644             # then next higher level.
 645             $carry = 1;
 646
 647             foreach my $pat (@pats) {
 648                 my $combined = $pat =~ m|/|;
 649                 my $end;
 650
 651              #          printf("# next_enum: checking current '%s' against pat '%s'\n",
 652              #                 $next->{$key}, $pat);
 653
 654                 if ($combined) {
 655                     ($pat, $end) = split('/', $pat, 2);
 656                 } else {
 657                     $end = undef;
 658                 }
 659
 660                 if ($pat > $next->{$key}) {
 661                     $carry = 0;
 662                     $next->{$key} = $pat;
 663                     $next->{$key} .= '/' . $end if $end;
 664      #              printf("# next_enum: selecting new issue no. %s\n", $next->{$key});
 665                     last;    # We've found the correct next issue number
 666                 }
 667             }
 668             if ($carry) {
 669                 $next->{$key} = $pats[0];
 670             } else {
 671                 last;        # exit the top level loop because we're done
 672             }
 673
 674         } else {
 675             # No enumeration publication pattern specified for this level,
 676             # just keep adding one.
 677
 678             if (!$self->capstr($key)) {
 679                 # Just assume that it increments continuously and give up
 680                 warn "Holding data exists for $key, but no caption specified";
 681                 $next->{$key} += 1;
 682                 $carry = 0;
 683                 last;
 684             }
 685
 686         #           printf("# next_enum: no publication pattern, using frequency\n");
 687
 688             my $cap = $self->capfield($key);
 689             if (   $cap->{RESTART}
 690                 && $cap->{COUNT}
 691                 && ($next->{$key} eq $cap->{COUNT})) {
 692                 $next->{$key} = 1;
 693                 $carry = 1;
 694             } elsif ($cap->{COUNT} > 0 and !($next->{$key} % $cap->{COUNT})) {
 695                 # If we have a non-restarting enum, but we define a count,
 696                 # we need to carry to the next level when the current value
 697                 # divides evenly by the count
 698                 # XXX: this code naively assumes that there has never been an
 699                 # issue number anomaly of any kind (like an extra issue), but this
 700                 # limit is inherent in the standard
 701                 $next->{$key} += 1;
 702                 $carry = 1;
 703             } else {
 704                 # If I don't need to "carry" beyond here, then I just increment
 705                 # this level of the enumeration and stop looping, since the
 706                 # "next" hash has been initialized with the current values
 707
 708                 $next->{$key} += 1;
 709                 $carry = 0;
 710             }
 711
 712             # You can't have a combined issue that spans two volumes: no.12/1
 713             # is forbidden
 714             if ($self->enum_is_combined($key, $next->{$key})) {
 715                 $next->{$key} .= '/' . ($next->{$key} + 1);
 716             }
 717
 718             last if !$carry;
 719         }
 720     }
 721
 722     # The easy part is done. There are two things left to do:
 723     # 1) Calculate the date of the next issue, if necessary
 724     # 2) Increment the highest level of enumeration (either by date
 725     #    or because $carry is set because of the above loop
 726
 727     if (!$self->subfield('i') || !$next->{i}) {
 728         # The simple case: if there is no chronology specified
 729         # then just check $carry and return
 730         $next->{'a'} += $carry;
 731     } else {
 732         # Figure out date of next issue, then decide if we need
 733         # to adjust top level enumeration based on that
 734         $self->next_chron($next, $carry, ('i'..'m'));
 735     }
 736 }
 737
 738 sub next {
 739     my $self    = shift;
 740     my $holding = shift;
 741     my $next    = {};
 742
 743     # If the holding is compressed and not open ended, base next() on the
 744     # closing date.  If the holding is open-ended, next() is undefined
 745     my $index;
 746     if ($holding->is_compressed) {
 747         return undef if $holding->is_open_ended;
 748         # TODO: error on next for open-ended holdings?
 749         $index = 1;
 750     } else {
 751         $index = 0;
 752     }
 753
 754     # Initialize $next with current enumeration & chronology, then
 755     # we can just operate on $next, based on the contents of the caption
 756     foreach my $key ('a'..'m') {
 757         my $holding_values = $holding->field_values($key);
 758         $next->{$key} = ${$holding_values}[$index] if defined $holding_values;
 759     }
 760
 761     if ($self->enumeration_is_chronology) {
 762         $self->next_chron($next, 0, ('a'..'h'));
 763         return $next;
 764     }
 765
 766     if (exists $next->{'h'}) {
 767         $self->next_alt_enum($next);
 768     }
 769
 770     $self->next_enum($next);
 771
 772     return ($next);
 773 }
 774
 775 # return a simple subfields list
 776 sub subfields_list {
 777     my $self = shift;
 778     my @subfields;
 779
 780     foreach my $subfield ($self->subfields) {
 781         push(@subfields, $subfield->[0], $subfield->[1]);
 782     }
 783     return @subfields;
 784 }
 785
 786 1;