From: dbs Date: Sun, 25 Oct 2009 20:49:08 +0000 (+0000) Subject: Backport MFHD from trunk X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=245884ad14e8fa0bb299299909a4047e59862caf;p=working%2FEvergreen.git Backport MFHD from trunk djfiander was horrified to hear that 1.6.0.0 might be rolled with an arbitrary cut of his MFHD code from when that tag was originally created git-svn-id: svn://svn.open-ils.org/ILS/branches/rel_1_6@14597 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm index ffae61174d..646992a13f 100755 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm @@ -5,7 +5,7 @@ use Carp; use Data::Dumper; -use DateTime; +use OpenILS::Utils::MFHD::Date; use base 'MARC::Field'; @@ -197,381 +197,6 @@ sub enumeration_is_chronology { return (exists $self->{_mfhdc_PATTERN}->{w}); } -my %daynames = ( - 'mo' => 1, - 'tu' => 2, - 'we' => 3, - 'th' => 4, - 'fr' => 5, - 'sa' => 6, - 'su' => 7, - ); - -my $daypat = '(mo|tu|we|th|fr|sa|su)'; -my $weekpat = '(99|98|97|00|01|02|03|04|05)'; -my $weeknopat; -my $monthpat = '(01|02|03|04|05|06|07|08|09|10|11|12)'; -my $seasonpat = '(21|22|23|24)'; - -# Initialize $weeknopat to be '(01|02|03|...|51|52|53)' -$weeknopat = '('; -foreach my $weekno (1..52) { - $weeknopat .= sprintf('%02d|', $weekno); -} -$weeknopat .= '53)'; - -sub match_day { - my $pat = shift; - my @date = @_; - # Translate daynames into day of week for DateTime - # also used to check if dayname is valid. - - if (exists $daynames{$pat}) { - # dd - # figure out day of week for date and compare - my $dt = DateTime->new(year => $date[0], - month => $date[1], - day => $date[2]); - return ($dt->day_of_week == $daynames{$pat}); - } elsif (length($pat) == 2) { - # DD - return $pat == $date[2]; - } elsif (length($pat) == 4) { - # MMDD - my ($mon, $day) = unpack("a2a2", $pat); - - return (($mon == $date[1]) && ($day == $date[2])); - } else { - carp "Invalid day pattern '$pat'"; - return 0; - } -} - -sub subsequent_day { - my $pat = shift; - my $cur = shift; - my $dt = DateTime->new(year => $cur->[0], - month => $cur->[1], - day => $cur->[2]); - - if (exists $daynames{$pat}) { - # dd: published on the given weekday - my $dow = $dt->day_of_week; - my $corr = ($dow - $daynames{$pat} + 7) % 7; - - if ($dow == $daynames{$pat}) { - # the next one is one week hence - $dt->add(days => 7); - } else { - # the next one is later this week, - # or it is next week (ie, on or after next Monday) - # $corr will take care of it. - $dt->add(days => $corr); - } - } elsif (length($pat) == 2) { - # DD: published on the give day of every month - if ($dt->day >= $pat) { - # current date is on or after $pat: next one is next month - $dt->set(day => $pat); - $dt->add(months => 1); - $cur->[0] = $dt->year; - $cur->[1] = $dt->month; - $cur->[2] = $dt->day; - } - # current date is before $pat: set month to pattern - # or we've adjusted the year to next year, now fix the month - $cur->[1] = $pat; - } elsif (length($pat) == 4) { - # MMDD: published on the given day of the given month - my ($mon, $day) = unpack("a2a2", $pat); - - if (on_or_after($mon, $day, $cur->[1], $cur->[2])) { - # Current date is on or after pattern; next one is next year - $cur->[0] += 1; - } - # Year is now right. Either it's next year (because of on_or_before) - # or it's this year, because the current date is NOT on or after - # the pattern. Just fix the month and day - $cur->[1] = $mon; - $cur->[2] = $day; - } else { - carp "Invalid day pattern '$pat'"; - return undef; - } - - return $cur; -} - - -# Calculate date of 3rd Friday of the month (for example) -# 1-5: count from beginning of month -# 99-97: count back from end of month -sub nth_week_of_month { - my $dt = shift; - my $week = shift; - my $day = shift; - my ($nth_day, $dow, $day); - - $day = $daynames{$day}; - - if (0 < $week && $week <= 5) { - $nth_day = DateTime->clone($dt)->set(day => 1); - } elsif ($week >= 97) { - $nth_day = DateTime->last_day_of_month(year => $dt->year, - month => $dt->month); - } else { - return undef; - } - - $dow = $nth_day->day_of_week(); - - if ($week <= 5) { - # count forwards - $nth_day->add(days => ($day - $dow + 7) % 7, - weeks=> $week - 1); - } else { - # count backwards - $nth_day->subtract(days => ($day - $nth_day->day_of_week + 7) % 7); - - # 99: last week of month, 98: second last, etc. - for (my $i = 99 - $week; $i > 0; $i--) { - $nth_day->subtract(weeks => 1); - } - } - - # There is no nth "day" in the month! - return undef if ($dt->month != $nth_day->month); - - return $nth_day; -} - -# -# Internal utility function to match the various different patterns -# of month, week, and day -# -sub check_date { - my $dt = shift; - my $month = shift; - my $weekno = shift; - my $day = shift; - - if (!defined $day) { - # MMWW - return (($dt->month == $month) - && (($dt->week_of_month == $weekno) - || ($weekno >= 97 - && ($dt->week_of_month == nth_week_of_month($dt, $weekno, $day)->week_of_month)))); - } - - # simple cases first - if ($daynames{$day} != $dt->day_of_week) { - # if it's the wrong day of the week, rest doesn't matter - return 0; - } - - if (!defined $month) { - # WWdd - return (($weekno == 0) # Every week - || ($dt->weekday_of_month == $weekno) # this week - || (($weekno >= 97) && ($dt->weekday_of_month == nth_week_of_month($dt, $weekno, $day)->weekday_of_month))); - } - - # MMWWdd - if ($month != $dt->month) { - # If it's the wrong month, then we're done - return 0; - } - - # It's the right day of the week - # It's the right month - - if (($weekno == 0) ||($weekno == $dt->weekday_of_month)) { - # If this matches, then we're counting from the beginning - # of the month and it matches and we're done. - return 1; - } - - # only case left is that the week number is counting from - # the end of the month: eg, second last wednesday - return (($weekno >= 97) - && (nth_week_of_month($dt, $weekno, $day)->weekday_of_month == $dt->weekday_of_month)); -} - -sub match_week { - my $pat = shift; - my @date = @_; - my $dt = DateTime->new(year => $date[0], - month => $date[1], - day => $date[2]); - - if ($pat =~ m/^$weekpat$daypat$/) { - # WWdd: 03we = Third Wednesday - return check_date($dt, undef, $1, $2); - } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) { - # MMWWdd: 0599tu Last Tuesday in May XXX WRITE ME - return check_date($dt, $1, $2, $3); - } elsif ($pat =~ m/^$monthpat$weekpat$/) { - # MMWW: 1204: Fourth week in December XXX WRITE ME - return check_date($dt, $1, $2, undef); - } else { - carp "invalid week pattern '$pat'"; - return 0; - } -} - -# -# Use $pat to calcuate the date of the issue following $cur -# -sub subsequent_week { - my $pat = shift; - my $cur = shift; - my $candidate; - my $dt = DateTime->new(year => $cur->[0], - month=> $cur->[1], - day => $cur->[2]); - - if ($pat =~ m/^$weekpat$daypat$/) { - # WWdd: published on given weekday of given week of every month - my ($week, $day) = ($1, $2); - - if ($week eq '00') { - # Every week - $candidate = DateTime->clone($dt); - if ($dt->day_of_week == $daynames{$day}) { - # Current is right day, next one is a week hence - $candidate->add(days => 7); - } else { - $candidate->add(days => ($dt->day_of_week - $daynames{$day} + 7) % 7); - } - } else { - # 3rd Friday of the month (eg) - $candidate = nth_week_of_month($dt, $week, $day); - } - - if ($candidate < $dt) { - # If the n'th week of the month happens before the - # current issue, then the next issue is published next - # month, otherwise, it's published this month. - # This will never happen for the "00: every week" pattern - $candidate = DateTime->clone($dt)->add(months => 1)->set(day => 1); - $candidate = nth_week_of_month($dt, $week, $day); - } - } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) { - # MMWWdd: published on given weekday of given week of given month - my ($month, $week, $day) = ($1, $2, $3); - - $candidate = DateTime->new(year => $dt->year, - month=> $month, - day => 1); - $candidate = nth_week_of_month($candidate, $week, $day); - if ($candidate < $dt) { - # We've missed it for this year, next one that matches - # will be next year - $candidate->add(years => 1)->set(day => 1); - $candidate = nth_week_of_month($candidate, $week, $day); - } - } elsif ($pat =~ m/^$monthpat$weekpat$/) { - # MMWW: published during given week of given month - my ($month, $week) = ($1, $2); - - $candidate = nth_week_of_month(DateTime->new(year => $dt->year, - month=> $month, - day => 1), - $week, - 'th'); - if ($candidate < $dt) { - # Already past the pattern date this year, move to next year - $candidate->add(years => 1)->set(day => 1); - $candidate = nth_week_of_month($candidate, $week, 'th'); - } - } else { - carp "invalid week pattern '$pat'"; - return undef; - } - - $cur->[0] = $candidate->year; - $cur->[1] = $candidate->month; - $cur->[2] = $candidate->day; - - return $cur; -} - -sub match_month { - my $pat = shift; - my @date = @_; - - return ($pat eq $date[1]); -} - -sub match_season { - my $pat = shift; - my @date = @_; - - return ($pat eq $date[1]); -} - -sub subsequent_season { - my $pat = shift; - my $cur = shift; - - return undef if (($pat < 21) || ($pat > 24)); - - if ($cur->[1] >= $pat) { - # current season is on or past pattern season in this year, - # advance to next year - $cur->[0] += 1; - } - # Either we've advanced to the next year or the current season - # is before the pattern season in the current year. Either way, - # all that remains is to set the season properly - $cur->[1] = $pat; - - return $cur; -} - -sub match_year { - my $pat = shift; - my @date = @_; - - # XXX WRITE ME - return 0; -} - -sub subsequent_year { - my $pat = shift; - my $cur = shift; - - # XXX WRITE ME - return undef; -} - -sub match_issue { - my $pat = shift; - my @date = @_; - - # We handle enumeration patterns separately. This just - # ensures that when we're processing chronological patterns - # we don't match an enumeration pattern. - return 0; -} - -sub subsequent_issue { - my $pat = shift; - my $cur = shift; - - # Issue generation is handled separately - return undef; -} - -my %dispatch = ( - 'd' => \&match_day, - 'e' => \&match_issue, # not really a "chron" code - 'w' => \&match_week, - 'm' => \&match_month, - 's' => \&match_season, - 'y' => \&match_year, -); - sub regularity_match { my $self = shift; my $pubcode = shift; @@ -582,9 +207,10 @@ sub regularity_match { foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{$pubcode}}) { my $chroncode= substr($regularity, 0, 1); + my $matchfunc = MFHD::Date::dispatch($chroncode); my @pats = split(/,/, substr($regularity, 1)); - if (!exists $dispatch{$chroncode}) { + if (!defined $matchfunc) { carp "Unrecognized chroncode '$chroncode'"; return 0; } @@ -592,7 +218,7 @@ sub regularity_match { # XXX WRITE ME foreach my $pat (@pats) { $pat =~ s|/.+||; # If it's a combined date, match the start - if ($dispatch{$chroncode}->($pat, @date)) { + if ($matchfunc->($pat, @date)) { return 1; } } @@ -605,6 +231,8 @@ sub is_omitted { my $self = shift; my @date = @_; +# printf("# is_omitted: testing date %s: %d\n", join('/', @date), +# $self->regularity_match('o', @date)); return $self->regularity_match('o', @date); } @@ -645,88 +273,37 @@ sub enum_is_combined { } -my %increments = ( - a => {years => 1}, # annual - b => {months => 2}, # bimonthly - c => {days => 3}, # semiweekly - d => {days => 1}, # daily - e => {weeks => 2}, # biweekly - f => {months => 6}, # semiannual - g => {years => 2}, # biennial - h => {years => 3}, # triennial - i => {days => 2}, # three times / week - j => {days => 10}, # three times /month - # k => continuous - m => {months => 1}, # monthly - q => {months => 3}, # quarterly - s => {days => 15}, # semimonthly - t => {months => 4}, # three times / year - w => {weeks => 1}, # weekly - # x => completely irregular -); - -sub incr_date { - my $incr = shift; - my @new = @_; - - if (scalar(@new) == 1) { - # only a year is specified. Next date is easy - $new[0] += $incr->{years} || 1; - } elsif (scalar(@new) == 2) { - # Year and month or season - if ($new[1] > 20) { - # season - $new[1] += ($incr->{months}/3) || 1; - if ($new[1] > 24) { - # carry - $new[0] += 1; - $new[1] -= 4; # 25 - 4 == 21 == Spring after Winter - } - } else { - # month - $new[1] += $incr->{months} || 1; - if ($new[1] > 12) { - # carry - $new[0] += 1; - $new[1] -= 12; - } - $new[1] = '0' . $new[1] if ($new[1] < 10); - } - } elsif (scalar(@new) == 3) { - # Year, Month, Day: now it gets complicated. - - if ($new[2] =~ /^[0-9]+$/) { - # A single number for the day of month, relatively simple - my $dt = DateTime->new(year => $new[0], - month=> $new[1], - day => $new[2]); - $dt->add(%{$incr}); - $new[0] = $dt->year; - $new[1] = $dt->month; - $new[2] = $dt->day; +# Test to see if $dt1 is on or after $dt2 +# if length(@{$dt2} == 2, then just month/day are compared +# if length(@{$dt2} == 1, then just the months are compared +sub on_or_after { + my $dt1 = shift; + my $dt2 = shift; + +# printf("# on_or_after(%s, %s): ", join('/', @{$dt1}), join('/', @{$dt2})); + + foreach my $i (0..(scalar(@{$dt2})-1)) { + if ($dt1->[$i] > $dt2->[$i]) { +# printf("after - pass\n"); + # $dt1 occurs AFTER $dt2 + return 1; + } elsif ($dt1->[$i] < $dt2->[$i]) { +# printf("before - fail\n"); + # $dt1 occurs BEFORE $dt2 + return 0; } - $new[1] = '0' . $new[1] if ($new[1] < 10); - $new[2] = '0' . $new[2] if ($new[2] < 10); - } else { - warn("Don't know how to cope with @new"); + # both are still equal, keep going } - return @new; -} - -# Test to see if $m1/$d1 is on or after $m2/$d2 -# if $d2 is undefined, test is based on just months -sub on_or_after { - my ($m1, $d1, $m2, $d2) = @_; - - return (($m1 > $m2) - || ($m1 == $m2 && ((!defined $d2) || ($d1 >= $d2)))); + # We fell out of the loop with them being equal, so it's 'on' +# printf("on - pass\n"); + return 1; } sub calendar_increment { my $self = shift; my $cur = shift; - my @new = @_; + my $new = shift; my $cal_change = $self->calendar_change; my $month; my $day; @@ -734,9 +311,9 @@ sub calendar_increment { my $new_on_or_after; # A calendar change is defined, need to check if it applies - if ((scalar(@new) == 2 && $new[1] > 20) || (scalar(@new) == 1)) { + if (scalar(@{$new}) == 1) { carp "Can't calculate date change for ", $self->as_string; - return; + return 0; } foreach my $change (@{$cal_change}) { @@ -748,10 +325,14 @@ sub calendar_increment { ($month, $day) = unpack("a2a2", $change); } - if ($cur->[0] == $new[0]) { +# printf("# calendar_increment('%s', '%s'): change on '%s/%s'\n", +# join('/', @{$cur}), join('/', @{$new}), +# $month, defined($day) ? $day : 'UNDEF'); + + if ($cur->[0] == $new->[0]) { # Same year, so a 'simple' month/day comparison will be fine - $incr = (!on_or_after($cur->[1], $cur->[2], $month, $day) - && on_or_after($new[1], $new[2], $month, $day)); + $incr = (!on_or_after([$cur->[1], $cur->[2]], [$month, $day]) + && on_or_after([$new->[1], $new->[2]], [$month, $day])); } else { # @cur is in the year before @new. There are # two possible cases for the calendar change date that @@ -762,21 +343,14 @@ sub calendar_increment { # -------|------|------X------|------| # @cur (1) Jan 1 (2) @new - $incr = (on_or_after($new[1], $new[2], $month, $day) - || !on_or_after($cur->[1], $cur->[2], $month, $day)); + $incr = (on_or_after([$new->[1], $new->[2]], [$month, $day]) + || !on_or_after([$cur->[1], $cur->[2]], [$month, $day])); } return $incr if $incr; } -} -my %generators = ( - 'd' => \&subsequent_day, - 'e' => \&subsequent_issue, # not a chron code - 'w' => \&subsequent_week, - 'm' => \&subsequent_month, - 's' => \&subsequent_season, - 'y' => \&subsequent_year, -); + return 0; +} sub next_date { my $self = shift; @@ -785,60 +359,119 @@ sub next_date { my @keys = @_; my @cur; my @new; + my @newend; # only used for combined issues my $incr; - my @candidate; my $reg = $self->{_mfhdc_REGULARITY}; my $pattern = $self->{_mfhdc_PATTERN}; my $freq = $pattern->{w}; foreach my $i (0..$#keys) { - $new[$i] = $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]}; + $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]}; } # If the current issue has a combined date (eg, May/June) # get rid of the first date and base the calculation # on the final date in the combined issue. - $new[-1] =~ s|^[^/]+/||; - - # XXX Insert new date generation code in here that uses publication - # patterns. - -### -### Old code: only works for simple cases -### - # If $frequency is not one of the standard codes defined in %increments - # then there has to be a $yp publication regularity pattern that - # lists the dates of publication. Use that that list to find the next - # date following the current one. - # XXX: the code doesn't handle this case yet. - if (!defined($freq)) { - carp "Undefined frequency in next_date!"; - } elsif (!exists $increments{$freq}) { - carp "Don't know how to deal with frequency '$freq'!"; - } else { - # - # One of the standard defined issue frequencies - # - @new = incr_date($increments{$freq}, @new); + $cur[-1] =~ s|^[^/]+/||; - while ($self->is_omitted(@new)) { - @new = incr_date($increments{$freq}, @new); + if (defined $pattern->{y}->{p}) { + # There is a $y publication pattern defined in the record: + # use it to calculate the next issue date. + + foreach my $pubpat (@{$pattern->{y}->{p}}, @{$pattern->{y}->{c}}) { + my $chroncode = substr($pubpat, 0, 1); + my $genfunc = MFHD::Date::generator($chroncode); + my @pats = split(/,/, substr($pubpat, 1)); + + next if $chroncode eq 'e'; + + if (!defined $genfunc) { + carp "Unrecognized chroncode '$chroncode'"; + return undef; + } + + foreach my $pat (@pats) { + my $combined = $pat =~ m|/|; + my ($start, $end); + my @candidate; + +# printf("# next_date: generating with pattern '%s'\n", $pat); + + if ($combined) { + ($start, $end) = split('/', $pat, 2); + } else { + ($start, $end) = (undef, undef); + } + + @candidate = $genfunc->($start || $pat, @cur); + + while ($self->is_omitted(@candidate)) { +# printf("# pubpat omitting date '%s'\n", +# join('/', @candidate)); + @candidate = $genfunc->($start || $pat, @candidate); + } + +# printf("# testing new candidate '%s' against '%s'\n", +# join('/', @candidate), join('/', @new)); + + if (!defined($new[0]) + || !on_or_after(\@candidate, \@new)) { + # first time through the loop + # or @candidate is before @new => + # @candidate is the next issue. + @new = @candidate; + if (defined $end) { + @newend = $genfunc->($end, @cur); + } else { + $newend[0] = undef; + } + +# printf("# selecting candidate date '%s'\n", join('/', @new)); + } + } } - if ($self->is_combined(@new)) { - my @second_date = incr_date($increments{$freq}, @new); + if (defined($newend[0])) { + # The best match was a combined issue + foreach my $i (0..$#new) { + # don't combine identical fields + next if $new[$i] eq $newend[$i]; + $new[$i] .= '/' . $newend[$i]; + } + } + } + + if (scalar @new == 0) { + # There was no suitable publication pattern defined, + # so use the $w frequency to figure out the next date + if (!defined($freq)) { + carp "Undefined frequency in next_date!"; + } elsif (!MFHD::Date::can_increment($freq)) { + carp "Don't know how to deal with frequency '$freq'!"; + } else { + # + # One of the standard defined issue frequencies + # + @new = MFHD::Date::incr_date($freq, @cur); + + while ($self->is_omitted(@new)) { + @new = MFHD::Date::incr_date($freq, @new); + } + + if ($self->is_combined(@new)) { + my @second_date = MFHD::Date::incr_date($freq, @new); - # I am cheating: This code assumes that only the smallest - # time increment is combined. So, no "Apr 15/May 1" allowed. - $new[-1] = $new[-1] . '/' . $second_date[-1]; + # I am cheating: This code assumes that only the smallest + # time increment is combined. So, no "Apr 15/May 1" allowed. + $new[-1] = $new[-1] . '/' . $second_date[-1]; + } } } for my $i (0..$#new) { $next->{$keys[$i]} = $new[$i]; } - # Figure out if we need to adust volume number # right now just use the $carry that was passed in. # in long run, need to base this on ($carry or date_change) @@ -847,7 +480,7 @@ sub next_date { # going to increment the v. number twice at year-change. $next->{a} += $carry; } elsif (defined $pattern->{x}) { - $next->{a} += $self->calendar_increment(\@cur, @new); + $next->{a} += $self->calendar_increment(\@cur, \@new); } } @@ -876,6 +509,23 @@ sub next_alt_enum { } } +# Check caption for $ype subfield, specifying that there's a +# particular publication pattern for the given level of enumeration +# returns the pattern string or undef +sub enum_pubpat { + my $self = shift; + my $level = shift; + + return undef if !exists $self->{_mfhdc_PATTERN}->{y}->{p}; + + foreach my $reg (@{$self->{_mfhdc_PATTERN}->{y}->{p}}) { + if ($reg =~ m/^e$level/o) { + return substr($reg, 2); + } + } + return undef; +} + sub next_enum { my $self = shift; my $next = shift; @@ -891,17 +541,20 @@ sub next_enum { # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly) # 2) it's the right time of the year. # - $carry = 0; + + # If there's a subfield b, then we will go through the loop at + # least once. If there's no subfield b, then there's only a single + # level of enumeration, so we just add one to it and we're done. + if (exists $next->{b}) { + $carry = 0; + } else { + $carry = 1; + } foreach my $key (reverse('b'..'f')) { - next if !exists $next->{$key}; + my $level; + my $pubpat; - if (!$self->capstr($key)) { - # Just assume that it increments continuously and give up - warn "Holding data exists for $key, but no caption specified"; - $next->{$key} += 1; - $carry = 0; - last; - } + next if !exists $next->{$key}; # If the current issue has a combined issue number (eg, 2/3) # get rid of the first issue number and base the calculation @@ -910,27 +563,84 @@ sub next_enum { $next->{$key} =~ s|^[^/]+/||; } - my $cap = $self->capfield($key); - if ($cap->{RESTART} && $cap->{COUNT} - && ($next->{$key} eq $cap->{COUNT})) { - $next->{$key} = 1; + $level = ord($key) - ord('a') + 1; # enumeration level + + $pubpat = $self->enum_pubpat($level); + + if ($pubpat) { +# printf("# next_enum: found pubpat '%s' for subfield '%s'\n", +# $pubpat, $key); + my @pats = split(/,/, $pubpat); + + # If we fall out the bottom of the loop, then $carry + # will still be 1, and we will reset the current + # level to the first value in @pats and increment + # then next higher level. $carry = 1; + + foreach my $pat (@pats) { + my $combined = $pat =~ m|/|; + my $end; + +# printf("# next_enum: checking current '%s' against pat '%s'\n", +# $next->{$key}, $pat); + + if ($combined) { + ($pat, $end) = split('/', $pat, 2); + } else { + $end = undef; + } + + if ($pat > $next->{$key}) { + $carry = 0; + $next->{$key} = $pat; + $next->{$key} .= '/' . $end if $end; +# printf("# next_enum: selecting new issue no. %s\n", $next->{$key}); + last; # We've found the correct next issue number + } + } + if ($carry) { + $next->{$key} = $pats[0]; + } else { + last; # exit the top level loop because we're done + } + } else { - # If I don't need to "carry" beyond here, then I just increment - # this level of the enumeration and stop looping, since the - # "next" hash has been initialized with the current values + # No enumeration publication pattern specified for this level, + # just keed adding one. + + if (!$self->capstr($key)) { + # Just assume that it increments continuously and give up + warn "Holding data exists for $key, but no caption specified"; + $next->{$key} += 1; + $carry = 0; + last; + } - $next->{$key} += 1; - $carry = 0; - } +# printf("# next_enum: no publication pattern, using frequency\n"); - # You can't have a combined issue that spans two volumes: no.12/1 - # is forbidden - if ($self->enum_is_combined($key, $next->{$key})) { - $next->{$key} .= '/' . ($next->{$key} + 1); - } + my $cap = $self->capfield($key); + if ($cap->{RESTART} && $cap->{COUNT} + && ($next->{$key} eq $cap->{COUNT})) { + $next->{$key} = 1; + $carry = 1; + } else { + # If I don't need to "carry" beyond here, then I just increment + # this level of the enumeration and stop looping, since the + # "next" hash has been initialized with the current values - last if !$carry; + $next->{$key} += 1; + $carry = 0; + } + + # You can't have a combined issue that spans two volumes: no.12/1 + # is forbidden + if ($self->enum_is_combined($key, $next->{$key})) { + $next->{$key} .= '/' . ($next->{$key} + 1); + } + + last if !$carry; + } } # The easy part is done. There are two things left to do: