Open-ILS/src/perlmods/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 DateTime;
   9
  10 use base 'MARC::Field';
  11
  12 sub new
  13 {
  14     my $proto = shift;
  15     my $class = ref($proto) || $proto;
  16     my $self = shift;
  17     my $last_enum = undef;
  18
  19     $self->{_mfhdc_ENUMS} = {};
  20     $self->{_mfhdc_CHRONS} = {};
  21     $self->{_mfhdc_PATTERN} = {};
  22     $self->{_mfhdc_COPY} = undef;
  23     $self->{_mfhdc_UNIT} = 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->{LINK} = $val;
  30         } elsif ($key =~ /[a-h]/) {
  31             # Enumeration Captions
  32             $self->{_mfhdc_ENUMS}->{$key} = {CAPTION => $val,
  33                                              COUNT => undef,
  34                                              RESTART => undef};
  35             if ($key =~ /[ag]/) {
  36                 $last_enum = undef;
  37             } else {
  38                 $last_enum = $key;
  39             }
  40         } elsif ($key =~ /[i-m]/) {
  41             # Chronology captions
  42             $self->{_mfhdc_CHRONS}->{$key} = $val;
  43         } elsif ($key eq 'u') {
  44             # Bib units per next higher enumeration level
  45             carp('$u specified for top-level enumeration')
  46               unless defined($last_enum);
  47             $self->{_mfhdc_ENUMS}->{$last_enum}->{COUNT} = $val;
  48         } elsif ($key eq 'v') {
  49             carp '$v specified for top-level enumeration'
  50               unless defined($last_enum);
  51             $self->{_mfhdc_ENUMS}->{$last_enum}->{RESTART} = ($val eq 'r');
  52         } elsif ($key =~ /[npwz]/) {
  53             # Publication Pattern info ('o' == type of unit, 'q'..'t' undefined)
  54             $self->{_mfhdc_PATTERN}->{$key} = $val;
  55         } elsif ($key =~ /x/) {
  56             # Calendar change can have multiple comma-separated values
  57             $self->{_mfhdc_PATTERN}->{x} = [split /,/, $val];
  58         } elsif ($key eq 'y') {
  59             $self->{_mfhdc_PATTERN}->{y} = []
  60               unless exists $self->{_mfhdc_PATTERN}->{y};
  61             push @{$self->{_mfhdc_PATTERN}->{y}}, $val;
  62         } elsif ($key eq 'o') {
  63             # Type of unit
  64             $self->{_mfhdc_UNIT} = $val;
  65         } elsif ($key eq 't') {
  66             $self->{_mfhdc_COPY} = $val;
  67         } else {
  68             carp "Unknown caption subfield '$key'";
  69         }
  70     }
  71
  72     # subsequent levels of enumeration (primary and alternate)
  73     # If an enumeration level doesn't document the number
  74     # of "issues" per "volume", or whether numbering of issues
  75     # restarts, then we can't compress.
  76     foreach my $key ('b', 'c', 'd', 'e', 'f', 'h') {
  77         if (exists $self->{_mfhdc_ENUMS}->{$key}) {
  78             my $pattern = $self->{_mfhdc_ENUMS}->{$key};
  79             if (!$pattern->{RESTART} || !$pattern->{COUNT}
  80                 || ($pattern->{COUNT} eq 'var')
  81                 || ($pattern->{COUNT} eq 'und')) {
  82                 $self->{_mfhdc_COMPRESSIBLE} = 0;
  83                 last;
  84             }
  85         }
  86     }
  87
  88     my $pat = $self->{_mfhdc_PATTERN};
  89
  90     # Sanity check publication frequency vs publication pattern:
  91     # if the frequency is a number, then the pattern better
  92     # have that number of values associated with it.
  93     if (exists($pat->{w}) && ($pat->{w} =~ /^\d+$/)
  94         && ($pat->{w} != scalar(@{$pat->{y}}))) {
  95         carp("Caption::new: publication frequency '$pat->{w}' != publication pattern @{$pat->{y}}");
  96     }
  97
  98
  99     # If there's a $x subfield and a $j, then it's compressible
 100     if (exists $pat->{x} && exists $self->{_mfhdc_CHRONS}->{'j'}) {
 101         $self->{_mfhdc_COMPRESSIBLE} = 1;
 102     }
 103
 104     bless ($self, $class);
 105
 106     if (exists $pat->{y}) {
 107         $self->decode_pattern;
 108     }
 109
 110     return $self;
 111 }
 112
 113 sub decode_pattern {
 114     my $self = shift;
 115     my $pattern = $self->{_mfhdc_PATTERN}->{y};
 116
 117     # XXX WRITE ME (?)
 118 }
 119
 120 sub compressible {
 121     my $self = shift;
 122
 123     return $self->{_mfhdc_COMPRESSIBLE};
 124 }
 125
 126 sub chrons {
 127     my $self = shift;
 128     my $key = shift;
 129
 130     if (exists $self->{_mfhdc_CHRONS}->{$key}) {
 131         return $self->{_mfhdc_CHRONS}->{$key};
 132     } else {
 133         return undef;
 134     }
 135 }
 136
 137 sub capfield {
 138     my $self = shift;
 139     my $key = shift;
 140
 141     if (exists $self->{_mfhdc_ENUMS}->{$key}) {
 142         return $self->{_mfhdc_ENUMS}->{$key};
 143     } elsif (exists $self->{_mfhdc_CHRONS}->{$key}) {
 144         return $self->{_mfhdc_CHRONS}->{$key};
 145     } else {
 146         return undef;
 147     }
 148 }
 149
 150 sub capstr {
 151     my $self = shift;
 152     my $key = shift;
 153     my $val = $self->capfield($key);
 154
 155     if (ref $val) {
 156         return $val->{CAPTION};
 157     } else {
 158         return $val;
 159     }
 160 }
 161
 162 sub calendar_change {
 163     my $self = shift;
 164
 165     return $self->{_mfhdc_PATTERN}->{x};
 166 }
 167
 168 # If items are identified by chronology only, with no separate
 169 # enumeration (eg, a newspaper issue), then the chronology is
 170 # recorded in the enumeration subfields $a - $f.  We can tell
 171 # that this is the case if there are $a - $f subfields and no
 172 # chronology subfields ($i-$k), and none of the $a-$f subfields
 173 # have associated $u or $v subfields, but there's a $w and no $x
 174
 175 sub enumeration_is_chronology {
 176     my $self = shift;
 177
 178     # There is always a '$a' subfield in well-formed fields.
 179     return 0 if exists $self->{_mfhdc_CHRONS}->{i}
 180       || exists $self->{_mfhdc_PATTERN}->{x};
 181
 182     foreach my $key ('a' .. 'f') {
 183         my $enum;
 184
 185         last if !exists $self->{_mfhdc_ENUMS}->{$key};
 186
 187         $enum = $self->{_mfhdc_ENUMS}->{$key};
 188         return 0 if defined $enum->{COUNT} || defined $enum->{RESTART};
 189     }
 190
 191     return (exists $self->{_mfhdc_PATTERN}->{w});
 192 }
 193
 194 my %daynames = (
 195                 'mo' => 1,
 196                 'tu' => 2,
 197                 'we' => 3,
 198                 'th' => 4,
 199                 'fr' => 5,
 200                 'sa' => 6,
 201                 'su' => 7,
 202                );
 203
 204 my $daypat = '(mo|tu|we|th|fr|sa|su)';
 205 my $weekpat = '(99|98|97|00|01|02|03|04|05)';
 206 my $weeknopat;
 207 my $monthpat = '(01|02|03|04|05|06|07|08|09|10|11|12)';
 208 my $seasonpat = '(21|22|23|24)';
 209
 210 # Initialize $weeknopat to be '(01|02|03|...|51|52|53)'
 211 $weeknopat = '(';
 212 foreach my $weekno (1..52) {
 213     $weeknopat .= sprintf('%02d|', $weekno);
 214 }
 215 $weeknopat .= '53)';
 216
 217 sub match_day {
 218     my $pat = shift;
 219     my @date = @_;
 220     # Translate daynames into day of week for DateTime
 221     # also used to check if dayname is valid.
 222
 223     if (exists $daynames{$pat}) {
 224         # dd
 225         # figure out day of week for date and compare
 226         my $dt = DateTime->new(year  => $date[0],
 227                                month => $date[1],
 228                                day   => $date[2]);
 229         return ($dt->day_of_week == $daynames{$pat});
 230     } elsif (length($pat) == 2) {
 231         # MM
 232         return $pat == $date[3];
 233     } elsif (length($pat) == 4) {
 234         # MMDD
 235         my ($mon, $day);
 236         $mon = substr($pat, 0, 2);
 237         $day = substr($pat, 2, 2);
 238
 239         return (($mon == $date[1]) && ($day == $date[2]));
 240     } else {
 241         carp "Invalid day pattern '$pat'";
 242         return 0;
 243     }
 244 }
 245
 246 # Calcuate date of "n"th last "dayname" of month: second last Tuesday
 247 sub last_week_of_month {
 248     my $dt = shift;
 249     my $week = shift;
 250     my $day = shift;
 251     my $end_dt = DateTime->last_day_of_month(year  => $dt->year,
 252                                              month => $dt->month);
 253
 254     $day = $daynames{$day};
 255     while ($end_dt->day_of_week != $day) {
 256         $end_dt->subtract(days => 1);
 257     }
 258
 259     # 99: last week of month, 98: second last, etc.
 260     for (my $i = 99 - $week; $i > 0; $i--) {
 261         $end_dt->subtract(weeks => 1);
 262     }
 263
 264     return $end_dt;
 265 }
 266
 267 sub check_date {
 268     my $dt = shift;
 269     my $month = shift;
 270     my $weekno = shift;
 271     my $day = shift;
 272
 273     if (!defined $day) {
 274         # MMWW
 275         return (($dt->month == $month)
 276                 && (($dt->week_of_month == $weekno)
 277                     || ($dt->week_of_month == last_day_of_month($dt, $weekno, 'th')->week_of_month)));
 278     }
 279
 280     # simple cases first
 281     if ($daynames{$day} != $dt->day_of_week) {
 282         # if it's the wrong day of the week, rest doesn't matter
 283         return 0;
 284     }
 285
 286     if (!defined $month) {
 287         # WWdd
 288         return (($dt->weekday_of_month == $weekno)
 289                 || ($dt->weekday_of_month == last_day_of_month($dt, $weekno, $day)->weekday_of_month));
 290     }
 291
 292     # MMWWdd
 293     if ($month != $dt->month) {
 294         # If it's the wrong month, then we're done
 295         return 0;
 296     }
 297
 298     # It's the right day of the week
 299     # It's the right month
 300
 301     if ($weekno == $dt->weekday_of_month) {
 302         # If this matches, then we're counting from the beginning
 303         # of the month and it matches and we're done.
 304         return 1;
 305     }
 306
 307     # only case left is that the week number is counting from
 308     # the end of the month: eg, second last wednesday
 309     return (last_week_of_month($weekno, $day)->weekday_of_month == $dt->weekday_of_month);
 310 }
 311
 312 sub match_week {
 313     my $pat = shift;
 314     my @date = @_;
 315     my $dt = DateTime->new(year  => $date[0],
 316                            month => $date[1],
 317                            day   => $date[2]);
 318
 319     if ($pat =~ m/^$weekpat$daypat$/) {
 320         # WWdd: 03we = Third Wednesday
 321         return check_date($dt, undef, $1, $2);
 322     } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) {
 323         # MMWWdd: 0599tu Last Tuesday in May XXX WRITE ME
 324         return check_date($dt, $1, $2, $3);
 325     } elsif ($pat =~ m/^$monthpat$weekpat$/) {
 326         # MMWW: 1204: Fourth week in December XXX WRITE ME
 327         return check_date($dt, $1, $2, undef);
 328     } else {
 329         carp "invalid week pattern '$pat'";
 330         return 0;
 331     }
 332 }
 333
 334 sub match_month {
 335     my $pat = shift;
 336     my @date = @_;
 337
 338     return ($pat eq $date[1]);
 339 }
 340
 341 sub match_season {
 342     my $pat = shift;
 343     my @date = @_;
 344
 345     return ($pat eq $date[1]);
 346 }
 347
 348 sub match_year {
 349     my $pat = shift;
 350     my @date = @_;
 351
 352     # XXX WRITE ME
 353     return 0;
 354 }
 355
 356 sub match_issue {
 357     my $pat = shift;
 358     my @date = @_;
 359
 360     # We handle enumeration patterns separately. This just
 361     # ensures that when we're processing chronological patterns
 362     # we don't match an enumeration pattern.
 363     return 0;
 364 }
 365
 366 my %dispatch = (
 367                 'd' => \&match_day,
 368                 'e' => \&match_issue, # not really a "chron" code
 369                 'w' => \&match_week,
 370                 'm' => \&match_month,
 371                 's' => \&match_season,
 372                 'y' => \&match_year,
 373 );
 374
 375 sub regularity_match {
 376     my $self = shift;
 377     my $pubcode = shift;
 378     my @date = @_;
 379
 380     # we can't match something that doesn't exist.
 381     return 0 if !exists $self->{_mfhdc_PATTERN}->{y};
 382
 383     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}}) {
 384         next unless $regularity =~ m/^$pubcode/;
 385
 386         my $chroncode= substr($regularity, 1, 1);
 387         my @pats = split(/,/, substr($regularity, 2));
 388
 389         if (!exists $dispatch{$chroncode}) {
 390             carp "Unrecognized chroncode '$chroncode'";
 391             return 0;
 392         }
 393
 394         # XXX WRITE ME
 395         foreach my $pat (@pats) {
 396             $pat =~ s|/.+||;    # If it's a combined date, match the start
 397             if ($dispatch{$chroncode}->($pat, @date)) {
 398                 return 1;
 399             }
 400         }
 401     }
 402
 403     return 0;
 404 }
 405
 406 sub is_omitted {
 407     my $self = shift;
 408     my @date = @_;
 409
 410     return $self->regularity_match('o', @date);
 411 }
 412
 413 sub is_published {
 414     my $self = shift;
 415     my @date = @_;
 416
 417     return $self->regularity_match('p', @date);
 418 }
 419
 420 sub is_combined {
 421     my $self = shift;
 422     my @date = @_;
 423
 424     return $self->regularity_match('c', @date);
 425 }
 426
 427 sub enum_is_combined {
 428     my $self = shift;
 429     my $subfield = shift;
 430     my $iss = shift;
 431     my $level = ord($subfield) - ord('a') + 1;
 432
 433     return 0 if !exists $self->{_mfhdc_PATTERN}->{y};
 434
 435     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}}) {
 436         next unless $regularity =~ m/^ce$level/o;
 437
 438         my @pats = split(/,/, substr($regularity, 3));
 439
 440         foreach my $pat (@pats) {
 441             $pat =~ s|/.+||;    # if it's a combined issue, match the start
 442             return 1 if ($iss eq $pat);
 443         }
 444     }
 445
 446     return 0;
 447 }
 448
 449
 450 my %increments = (
 451                   a => {years => 1}, # annual
 452                   b => {months => 2}, # bimonthly
 453                   c => {days => 3}, # semiweekly
 454                   d => {days => 1}, # daily
 455                   e => {weeks => 2}, # biweekly
 456                   f => {months => 6}, # semiannual
 457                   g => {years => 2},  # biennial
 458                   h => {years => 3},  # triennial
 459                   i => {days => 2}, # three times / week
 460                   j => {days => 10}, # three times /month
 461                   # k => continuous
 462                   m => {months => 1}, # monthly
 463                   q => {months => 3}, # quarterly
 464                   s => {days => 15},  # semimonthly
 465                   t => {months => 4}, # three times / year
 466                   w => {weeks => 1},  # weekly
 467                   # x => completely irregular
 468 );
 469
 470 sub incr_date {
 471     my $incr = shift;
 472     my @new = @_;
 473
 474     if (scalar(@new) == 1) {
 475         # only a year is specified. Next date is easy
 476         $new[0] += $incr->{years} || 1;
 477     } elsif (scalar(@new) == 2) {
 478         # Year and month or season
 479         if ($new[1] > 20) {
 480             # season
 481             $new[1] += ($incr->{months}/3) || 1;
 482             if ($new[1] > 24) {
 483                 # carry
 484                 $new[0] += 1;
 485                 $new[1] -= 4;   # 25 - 4 == 21 == Spring after Winter
 486             }
 487         } else {
 488             # month
 489             $new[1] += $incr->{months} || 1;
 490             if ($new[1] > 12) {
 491                 # carry
 492                 $new[0] += 1;
 493                 $new[1] -= 12;
 494             }
 495             $new[1] = '0' . $new[1] if ($new[1] < 10);
 496         }
 497     } elsif (scalar(@new) == 3) {
 498         # Year, Month, Day: now it gets complicated.
 499
 500         if ($new[2] =~ /^[0-9]+$/) {
 501             # A single number for the day of month, relatively simple
 502             my $dt = DateTime->new(year => $new[0],
 503                                    month=> $new[1],
 504                                    day  => $new[2]);
 505             $dt->add(%{$incr});
 506             $new[0] = $dt->year;
 507             $new[1] = $dt->month;
 508             $new[2] = $dt->day;
 509         }
 510         $new[1] = '0' . $new[1] if ($new[1] < 10);
 511         $new[2] = '0' . $new[2] if ($new[2] < 10);
 512     } else {
 513         warn("Don't know how to cope with @new");
 514     }
 515
 516     return @new;
 517 }
 518
 519 # Test to see if $m1/$d1 is on or after $m2/$d2
 520 # if $d2 is undefined, test is based on just months
 521 sub on_or_after {
 522     my ($m1, $d1, $m2, $d2) = @_;
 523
 524     return (($m1 > $m2)
 525             || ($m1 == $m2 && ((!defined $d2) || ($d1 >= $d2))));
 526 }
 527
 528 sub calendar_increment {
 529     my $self = shift;
 530     my $cur = shift;
 531     my @new = @_;
 532     my $cal_change = $self->calendar_change;
 533     my $month;
 534     my $day;
 535     my $cur_before;
 536     my $new_on_or_after;
 537
 538     # A calendar change is defined, need to check if it applies
 539     if ((scalar(@new) == 2 && $new[1] > 20) || (scalar(@new) == 1)) {
 540         carp "Can't calculate date change for ", $self->as_string;
 541         return;
 542     }
 543
 544     foreach my $change (@{$cal_change}) {
 545         my $incr;
 546
 547         if (length($change) == 2) {
 548             $month = $change;
 549         } elsif (length($change) == 4) {
 550             ($month, $day) = unpack("a2a2", $change);
 551         }
 552
 553         if ($cur->[0] == $new[0]) {
 554             # Same year, so a 'simple' month/day comparison will be fine
 555             $incr = (!on_or_after($cur->[1], $cur->[2], $month, $day)
 556                      && on_or_after($new[1], $new[2], $month, $day));
 557         } else {
 558             # @cur is in the year before @new. There are
 559             # two possible cases for the calendar change date that
 560             # indicate that it's time to change the volume:
 561             # (1) the change date is AFTER @cur in the year, or
 562             # (2) the change date is BEFORE @new in the year.
 563             #
 564             #  -------|------|------X------|------|
 565             #       @cur    (1)   Jan 1   (2)   @new
 566
 567             $incr = (on_or_after($new[1], $new[2], $month, $day)
 568                      || !on_or_after($cur->[1], $cur->[2], $month, $day));
 569         }
 570         return $incr if $incr;
 571     }
 572 }
 573
 574 sub next_date {
 575     my $self = shift;
 576     my $next = shift;
 577     my $carry = shift;
 578     my @keys = @_;
 579     my @cur;
 580     my @new;
 581     my $incr;
 582
 583     my $reg = $self->{_mfhdc_REGULARITY};
 584     my $pattern = $self->{_mfhdc_PATTERN};
 585     my $freq = $pattern->{w};
 586
 587     foreach my $i (0..$#keys) {
 588         $new[$i] = $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]};
 589     }
 590
 591     # If the current issue has a combined date (eg, May/June)
 592     # get rid of the first date and base the calculation
 593     # on the final date in the combined issue.
 594     $new[-1] =~ s|^[^/]+/||;
 595
 596     # If $frequency is not one of the standard codes defined in %increments
 597     # then there has to be a $yp publication regularity pattern that
 598     # lists the dates of publication. Use that that list to find the next
 599     # date following the current one.
 600     # XXX: the code doesn't handle this case yet.
 601     if (!defined($freq)) {
 602         carp "Undefined frequency in next_date!";
 603     } elsif (!exists $increments{$freq}) {
 604         carp "Don't know how to deal with frequency '$freq'!";
 605     } else {
 606         #
 607         # One of the standard defined issue frequencies
 608         #
 609         @new = incr_date($increments{$freq}, @new);
 610
 611         while ($self->is_omitted(@new)) {
 612             @new = incr_date($increments{$freq}, @new);
 613         }
 614
 615         if ($self->is_combined(@new)) {
 616             my @second_date = incr_date($increments{$freq}, @new);
 617
 618             # I am cheating: This code assumes that only the smallest
 619             # time increment is combined. So, no "Apr 15/May 1" allowed.
 620             $new[-1] = $new[-1] . '/' . $second_date[-1];
 621         }
 622     }
 623
 624     for my $i (0..$#new) {
 625         $next->{$keys[$i]} = $new[$i];
 626     }
 627
 628     # Figure out if we need to adust volume number
 629     # right now just use the $carry that was passed in.
 630     # in long run, need to base this on ($carry or date_change)
 631     if ($carry) {
 632         # if $carry is set, the date doesn't matter: we're not
 633         # going to increment the v. number twice at year-change.
 634         $next->{a} += $carry;
 635     } elsif (defined $self->{_mfhdc_PATTERN}->{x}) {
 636         $next->{a} += $self->calendar_increment(\@cur, @new);
 637     }
 638 }
 639
 640 sub next_alt_enum {
 641     my $self = shift;
 642     my $next = shift;
 643
 644     # First handle any "alternative enumeration", since they're
 645     # a lot simpler, and don't depend on the the calendar
 646     foreach my $key ('h', 'g') {
 647         next if !exists $next->{$key};
 648         if (!$self->capstr($key)) {
 649             warn "Holding data exists for $key, but no caption specified";
 650             $next->{$key} += 1;
 651             last;
 652         }
 653
 654         my $cap = $self->capfield($key);
 655         if ($cap->{RESTART} && $cap->{COUNT}
 656             && ($next->{$key} == $cap->{COUNT})) {
 657             $next->{$key} = 1;
 658         } else {
 659             $next->{$key} += 1;
 660             last;
 661         }
 662     }
 663 }
 664
 665 sub next_enum {
 666     my $self = shift;
 667     my $next = shift;
 668     my $carry;
 669
 670     # $carry keeps track of whether we need to carry into the next
 671     # higher level of enumeration. It's not actually necessary except
 672     # for when the loop ends: if we need to carry from $b into $a
 673     # then $carry will be set when the loop ends.
 674     #
 675     # We need to keep track of this because there are two different
 676     # reasons why we might increment the highest level of enumeration ($a)
 677     # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly)
 678     # 2) it's the right time of the year.
 679     #
 680     $carry = 0;
 681     foreach my $key (reverse('b'..'f')) {
 682         next if !exists $next->{$key};
 683
 684         if (!$self->capstr($key)) {
 685             # Just assume that it increments continuously and give up
 686             warn "Holding data exists for $key, but no caption specified";
 687             $next->{$key} += 1;
 688             $carry = 0;
 689             last;
 690         }
 691
 692         # If the current issue has a combined issue number (eg, 2/3)
 693         # get rid of the first issue number and base the calculation
 694         # on the final issue number in the combined issue.
 695         if ($next->{$key} =~ m|/|) {
 696             $next->{$key} =~ s|^[^/]+/||;
 697         }
 698
 699         my $cap = $self->capfield($key);
 700         if ($cap->{RESTART} && $cap->{COUNT}
 701             && ($next->{$key} eq $cap->{COUNT})) {
 702             $next->{$key} = 1;
 703             $carry = 1;
 704         } else {
 705             # If I don't need to "carry" beyond here, then I just increment
 706             # this level of the enumeration and stop looping, since the
 707             # "next" hash has been initialized with the current values
 708
 709             $next->{$key} += 1;
 710             $carry = 0;
 711         }
 712
 713         # You can't have a combined issue that spans two volumes: no.12/1
 714         # is forbidden
 715         if ($self->enum_is_combined($key, $next->{$key})) {
 716             $next->{$key} .= '/' . ($next->{$key} + 1);
 717         }
 718
 719         last if !$carry;
 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')) {
 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_date($next, $carry, ('i'..'m'));
 735     }
 736 }
 737
 738 sub next {
 739     my $self = shift;
 740     my $holding = shift;
 741     my $next = {};
 742
 743     # Initialize $next with current enumeration & chronology, then
 744     # we can just operate on $next, based on the contents of the caption
 745
 746     if ($self->enumeration_is_chronology) {
 747         foreach my $key ('a' .. 'h') {
 748             $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
 749               if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 750         }
 751         $self->next_date($next, 0, ('a' .. 'h'));
 752
 753         return $next;
 754     }
 755
 756     foreach my $key ('a' .. 'h') {
 757         $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS}
 758           if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 759     }
 760
 761     foreach my $key ('i'..'m') {
 762         $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
 763           if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 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 1;