10 use base 'MARC::Field';
15 my $class = ref($proto) || $proto;
17 my $last_enum = undef;
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
26 foreach my $subfield ($self->subfields) {
27 my ($key, $val) = @$subfield;
30 } elsif ($key =~ /[a-h]/) {
31 # Enumeration Captions
32 $self->{_mfhdc_ENUMS}->{$key} = {CAPTION => $val,
40 } elsif ($key =~ /[i-m]/) {
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 update_pattern($self, $val);
62 } elsif ($key eq 'o') {
64 $self->{_mfhdc_UNIT} = $val;
65 } elsif ($key eq 't') {
66 $self->{_mfhdc_COPY} = $val;
68 carp "Unknown caption subfield '$key'";
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;
88 my $pat = $self->{_mfhdc_PATTERN};
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}->{p}}))) {
95 carp("Caption::new: publication frequency '$pat->{w}' != publication pattern @{$pat->{y}->{p}}");
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;
104 bless ($self, $class);
112 my $pathash = $self->{_mfhdc_PATTERN}->{y};
113 my ($pubcode, $pat) = unpack("a1a*", $val);
115 $pathash->{$pubcode} = [] unless exists $pathash->{$pubcode};
116 push @{$pathash->{$pubcode}}, $pat;
121 my $pattern = $self->{_mfhdc_PATTERN}->{y};
129 return $self->{_mfhdc_COMPRESSIBLE};
136 if (exists $self->{_mfhdc_CHRONS}->{$key}) {
137 return $self->{_mfhdc_CHRONS}->{$key};
147 if (exists $self->{_mfhdc_ENUMS}->{$key}) {
148 return $self->{_mfhdc_ENUMS}->{$key};
149 } elsif (exists $self->{_mfhdc_CHRONS}->{$key}) {
150 return $self->{_mfhdc_CHRONS}->{$key};
159 my $val = $self->capfield($key);
162 return $val->{CAPTION};
168 sub calendar_change {
171 return $self->{_mfhdc_PATTERN}->{x};
174 # If items are identified by chronology only, with no separate
175 # enumeration (eg, a newspaper issue), then the chronology is
176 # recorded in the enumeration subfields $a - $f. We can tell
177 # that this is the case if there are $a - $f subfields and no
178 # chronology subfields ($i-$k), and none of the $a-$f subfields
179 # have associated $u or $v subfields, but there's a $w and no $x
181 sub enumeration_is_chronology {
184 # There is always a '$a' subfield in well-formed fields.
185 return 0 if exists $self->{_mfhdc_CHRONS}->{i}
186 || exists $self->{_mfhdc_PATTERN}->{x};
188 foreach my $key ('a' .. 'f') {
191 last if !exists $self->{_mfhdc_ENUMS}->{$key};
193 $enum = $self->{_mfhdc_ENUMS}->{$key};
194 return 0 if defined $enum->{COUNT} || defined $enum->{RESTART};
197 return (exists $self->{_mfhdc_PATTERN}->{w});
210 my $daypat = '(mo|tu|we|th|fr|sa|su)';
211 my $weekpat = '(99|98|97|00|01|02|03|04|05)';
213 my $monthpat = '(01|02|03|04|05|06|07|08|09|10|11|12)';
214 my $seasonpat = '(21|22|23|24)';
216 # Initialize $weeknopat to be '(01|02|03|...|51|52|53)'
218 foreach my $weekno (1..52) {
219 $weeknopat .= sprintf('%02d|', $weekno);
226 # Translate daynames into day of week for DateTime
227 # also used to check if dayname is valid.
229 if (exists $daynames{$pat}) {
231 # figure out day of week for date and compare
232 my $dt = DateTime->new(year => $date[0],
235 return ($dt->day_of_week == $daynames{$pat});
236 } elsif (length($pat) == 2) {
238 return $pat == $date[2];
239 } elsif (length($pat) == 4) {
241 my ($mon, $day) = unpack("a2a2", $pat);
243 return (($mon == $date[1]) && ($day == $date[2]));
245 carp "Invalid day pattern '$pat'";
253 my $dt = DateTime->new(year => $cur[0],
257 if (exists $daynames{$pat}) {
258 # dd: published on the given weekday
259 my $dow = $dt->day_of_week;
260 my $corr = ($dow - $daynames{$pat} + 7) % 7;
262 if ($dow == $daynames{$pat}) {
263 # the next one is one week hence
266 # the next one is later this week,
267 # or it is next week (ie, on or after next Monday)
268 # $corr will take care of it.
269 $dt->add(days => $corr);
271 } elsif (length($pat) == 2) {
272 # DD: published on the give day of every month
273 if ($dt->day >= $pat) {
274 # current date is on or after $pat: next one is next month
275 $dt->set(day => $pat);
276 $dt->add(months => 1);
278 $cur[1] = $dt->month;
281 # current date is before $pat: set day to pattern
284 } elsif (length($pat) == 4) {
285 # MMDD: published on the given day of the given month
286 my ($mon, $day) = unpack("a2a2", $pat);
288 if (on_or_after($mon, $day, $cur[1], $cur[2])) {
289 # Current date is on or after pattern; next one is next year
292 # Year is now right. Either it's next year (because of on_or_after)
293 # or it's this year, because the current date is NOT on or after
294 # the pattern. Just fix the month and day
298 carp "Invalid day pattern '$pat'";
302 foreach my $i (0..$#cur) {
303 $cur[$i] = '0' . (0+$cur[$i]) if $cur[$i] < 10;
310 # Calculate date of 3rd Friday of the month (for example)
311 # 1-5: count from beginning of month
312 # 99-97: count back from end of month
313 sub nth_week_of_month {
317 my ($nth_day, $dow, $day);
319 $day = $daynames{$day};
321 if (0 < $week && $week <= 5) {
322 $nth_day = DateTime->clone($dt)->set(day => 1);
323 } elsif ($week >= 97) {
324 $nth_day = DateTime->last_day_of_month(year => $dt->year,
325 month => $dt->month);
330 $dow = $nth_day->day_of_week();
334 $nth_day->add(days => ($day - $dow + 7) % 7,
338 $nth_day->subtract(days => ($day - $nth_day->day_of_week + 7) % 7);
340 # 99: last week of month, 98: second last, etc.
341 for (my $i = 99 - $week; $i > 0; $i--) {
342 $nth_day->subtract(weeks => 1);
346 # There is no nth "day" in the month!
347 return undef if ($dt->month != $nth_day->month);
353 # Internal utility function to match the various different patterns
354 # of month, week, and day
364 return (($dt->month == $month)
365 && (($dt->week_of_month == $weekno)
367 && ($dt->week_of_month == nth_week_of_month($dt, $weekno, $day)->week_of_month))));
371 if ($daynames{$day} != $dt->day_of_week) {
372 # if it's the wrong day of the week, rest doesn't matter
376 if (!defined $month) {
378 return (($weekno == 0) # Every week
379 || ($dt->weekday_of_month == $weekno) # this week
380 || (($weekno >= 97) && ($dt->weekday_of_month == nth_week_of_month($dt, $weekno, $day)->weekday_of_month)));
384 if ($month != $dt->month) {
385 # If it's the wrong month, then we're done
389 # It's the right day of the week
390 # It's the right month
392 if (($weekno == 0) ||($weekno == $dt->weekday_of_month)) {
393 # If this matches, then we're counting from the beginning
394 # of the month and it matches and we're done.
398 # only case left is that the week number is counting from
399 # the end of the month: eg, second last wednesday
400 return (($weekno >= 97)
401 && (nth_week_of_month($dt, $weekno, $day)->weekday_of_month == $dt->weekday_of_month));
407 my $dt = DateTime->new(year => $date[0],
411 if ($pat =~ m/^$weekpat$daypat$/) {
412 # WWdd: 03we = Third Wednesday
413 return check_date($dt, undef, $1, $2);
414 } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) {
415 # MMWWdd: 0599tu Last Tuesday in May XXX WRITE ME
416 return check_date($dt, $1, $2, $3);
417 } elsif ($pat =~ m/^$monthpat$weekpat$/) {
418 # MMWW: 1204: Fourth week in December XXX WRITE ME
419 return check_date($dt, $1, $2, undef);
421 carp "invalid week pattern '$pat'";
427 # Use $pat to calcuate the date of the issue following $cur
429 sub subsequent_week {
433 my $dt = DateTime->new(year => $cur[0],
437 if ($pat =~ m/^$weekpat$daypat$/) {
438 # WWdd: published on given weekday of given week of every month
439 my ($week, $day) = ($1, $2);
443 $candidate = DateTime->clone($dt);
444 if ($dt->day_of_week == $daynames{$day}) {
445 # Current is right day, next one is a week hence
446 $candidate->add(days => 7);
448 $candidate->add(days => ($dt->day_of_week - $daynames{$day} + 7) % 7);
451 # 3rd Friday of the month (eg)
452 $candidate = nth_week_of_month($dt, $week, $day);
455 if ($candidate < $dt) {
456 # If the n'th week of the month happens before the
457 # current issue, then the next issue is published next
458 # month, otherwise, it's published this month.
459 # This will never happen for the "00: every week" pattern
460 $candidate = DateTime->clone($dt)->add(months => 1)->set(day => 1);
461 $candidate = nth_week_of_month($dt, $week, $day);
463 } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) {
464 # MMWWdd: published on given weekday of given week of given month
465 my ($month, $week, $day) = ($1, $2, $3);
467 $candidate = DateTime->new(year => $dt->year,
470 $candidate = nth_week_of_month($candidate, $week, $day);
471 if ($candidate < $dt) {
472 # We've missed it for this year, next one that matches
474 $candidate->add(years => 1)->set(day => 1);
475 $candidate = nth_week_of_month($candidate, $week, $day);
477 } elsif ($pat =~ m/^$monthpat$weekpat$/) {
478 # MMWW: published during given week of given month
479 my ($month, $week) = ($1, $2);
481 $candidate = nth_week_of_month(DateTime->new(year => $dt->year,
486 if ($candidate < $dt) {
487 # Already past the pattern date this year, move to next year
488 $candidate->add(years => 1)->set(day => 1);
489 $candidate = nth_week_of_month($candidate, $week, 'th');
492 carp "invalid week pattern '$pat'";
496 $cur[0] = $candidate->year;
497 $cur[1] = $candidate->month;
498 $cur[2] = $candidate->day;
500 foreach my $i (0..$#cur) {
501 $cur[$i] = '0' . (0+$cur[$i]) if $cur[$i] < 10;
511 return ($pat eq $date[1]);
518 return ($pat eq $date[1]);
521 sub subsequent_season {
525 if (($pat < 21) || ($pat > 24)) {
526 carp "Unexpected season '$pat'";
530 if ($cur[1] >= $pat) {
531 # current season is on or past pattern season in this year,
532 # advance to next year
535 # Either we've advanced to the next year or the current season
536 # is before the pattern season in the current year. Either way,
537 # all that remains is to set the season properly
551 sub subsequent_year {
563 # We handle enumeration patterns separately. This just
564 # ensures that when we're processing chronological patterns
565 # we don't match an enumeration pattern.
569 sub subsequent_issue {
573 # Issue generation is handled separately
579 e => \&match_issue, # not really a "chron" code
587 d => \&subsequent_day,
588 e => \&subsequent_issue, # not really a "chron" code
589 w => \&subsequent_week,
590 m => \&subsequent_month,
591 s => \&subsequent_season,
592 y => \&subsequent_year,
595 sub regularity_match {
600 # we can't match something that doesn't exist.
601 return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{$pubcode};
603 foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{$pubcode}}) {
604 my $chroncode= substr($regularity, 0, 1);
605 my @pats = split(/,/, substr($regularity, 1));
607 if (!exists $dispatch{$chroncode}) {
608 carp "Unrecognized chroncode '$chroncode'";
613 foreach my $pat (@pats) {
614 $pat =~ s|/.+||; # If it's a combined date, match the start
615 if ($dispatch{$chroncode}->($pat, @date)) {
628 # printf("# is_omitted: testing date %s: %d\n", join('/', @date),
629 # $self->regularity_match('o', @date));
630 return $self->regularity_match('o', @date);
637 return $self->regularity_match('p', @date);
644 return $self->regularity_match('c', @date);
647 sub enum_is_combined {
649 my $subfield = shift;
651 my $level = ord($subfield) - ord('a') + 1;
653 return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{c};
655 foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{c}}) {
656 next unless $regularity =~ m/^e$level/o;
658 my @pats = split(/,/, substr($regularity, 2));
660 foreach my $pat (@pats) {
661 $pat =~ s|/.+||; # if it's a combined issue, match the start
662 return 1 if ($iss eq $pat);
671 a => {years => 1}, # annual
672 b => {months => 2}, # bimonthly
673 c => {days => 3}, # semiweekly
674 d => {days => 1}, # daily
675 e => {weeks => 2}, # biweekly
676 f => {months => 6}, # semiannual
677 g => {years => 2}, # biennial
678 h => {years => 3}, # triennial
679 i => {days => 2}, # three times / week
680 j => {days => 10}, # three times /month
682 m => {months => 1}, # monthly
683 q => {months => 3}, # quarterly
684 s => {days => 15}, # semimonthly
685 t => {months => 4}, # three times / year
686 w => {weeks => 1}, # weekly
687 # x => completely irregular
694 if (scalar(@new) == 1) {
695 # only a year is specified. Next date is easy
696 $new[0] += $incr->{years} || 1;
697 } elsif (scalar(@new) == 2) {
698 # Year and month or season
701 $new[1] += ($incr->{months}/3) || 1;
705 $new[1] -= 4; # 25 - 4 == 21 == Spring after Winter
709 $new[1] += $incr->{months} || 1;
716 } elsif (scalar(@new) == 3) {
717 # Year, Month, Day: now it gets complicated.
719 if ($new[2] =~ /^[0-9]+$/) {
720 # A single number for the day of month, relatively simple
721 my $dt = DateTime->new(year => $new[0],
726 $new[1] = $dt->month;
730 warn("Don't know how to cope with @new");
733 foreach my $i (0..$#new) {
734 $new[$i] = '0' . (0+$new[$i]) if $new[$i] < 10;
740 # Test to see if $m1/$d1 is on or after $m2/$d2
741 # if $d2 is undefined, test is based on just months
743 my ($m1, $d1, $m2, $d2) = @_;
746 || ($m1 == $m2 && ((!defined $d2) || ($d1 >= $d2))));
749 sub calendar_increment {
753 my $cal_change = $self->calendar_change;
759 # A calendar change is defined, need to check if it applies
760 if ((scalar(@new) == 2 && $new[1] > 20) || (scalar(@new) == 1)) {
761 carp "Can't calculate date change for ", $self->as_string;
765 foreach my $change (@{$cal_change}) {
768 if (length($change) == 2) {
770 } elsif (length($change) == 4) {
771 ($month, $day) = unpack("a2a2", $change);
774 if ($cur->[0] == $new[0]) {
775 # Same year, so a 'simple' month/day comparison will be fine
776 $incr = (!on_or_after($cur->[1], $cur->[2], $month, $day)
777 && on_or_after($new[1], $new[2], $month, $day));
779 # @cur is in the year before @new. There are
780 # two possible cases for the calendar change date that
781 # indicate that it's time to change the volume:
782 # (1) the change date is AFTER @cur in the year, or
783 # (2) the change date is BEFORE @new in the year.
785 # -------|------|------X------|------|
786 # @cur (1) Jan 1 (2) @new
788 $incr = (on_or_after($new[1], $new[2], $month, $day)
789 || !on_or_after($cur->[1], $cur->[2], $month, $day));
791 return $incr if $incr;
805 my $reg = $self->{_mfhdc_REGULARITY};
806 my $pattern = $self->{_mfhdc_PATTERN};
807 my $freq = $pattern->{w};
809 foreach my $i (0..$#keys) {
810 $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]};
813 # If the current issue has a combined date (eg, May/June)
814 # get rid of the first date and base the calculation
815 # on the final date in the combined issue.
816 $cur[-1] =~ s|^[^/]+/||;
818 if (defined $pattern->{y}->{p}) {
819 # There is a $y publication pattern defined in the record:
820 # use it to calculate the next issue date.
822 # XXX TODO: need to handle combined and omitted issues.
823 foreach my $pubpat (@{$pattern->{y}->{p}}) {
824 my $chroncode = substr($pubpat, 0, 1);
825 my @pats = split(/,/, substr($pubpat, 1));
827 if (!exists $generators{$chroncode}) {
828 carp "Unrecognized chroncode '$chroncode'";
832 foreach my $pat (@pats) {
833 @candidate = $generators{$chroncode}->($pat, @cur);
834 while ($self->is_omitted(@candidate)) {
835 # printf("# pubpat omitting date '%s'\n",
836 # join('/', @candidate));
837 @candidate = $generators{$chroncode}->($pat, @candidate);
840 # printf("# testing candidate date '%s'\n", join('/', @candidate));
841 if (!defined($new[0])
842 || !on_or_after($candidate[0], $candidate[1], $new[0], $new[1])) {
843 # first time through the loop
844 # or @candidate is before @new => @candidate is the next
847 # printf("# selecting candidate date '%s'\n", join('/', @new));
852 # There is no $y publication pattern defined, so use
853 # the $w frequency to figure out the next date
855 if (!defined($freq)) {
856 carp "Undefined frequency in next_date!";
857 } elsif (!exists $increments{$freq}) {
858 carp "Don't know how to deal with frequency '$freq'!";
861 # One of the standard defined issue frequencies
863 @new = incr_date($increments{$freq}, @cur);
865 while ($self->is_omitted(@new)) {
866 @new = incr_date($increments{$freq}, @new);
869 if ($self->is_combined(@new)) {
870 my @second_date = incr_date($increments{$freq}, @new);
872 # I am cheating: This code assumes that only the smallest
873 # time increment is combined. So, no "Apr 15/May 1" allowed.
874 $new[-1] = $new[-1] . '/' . $second_date[-1];
879 for my $i (0..$#new) {
880 $next->{$keys[$i]} = $new[$i];
882 # Figure out if we need to adust volume number
883 # right now just use the $carry that was passed in.
884 # in long run, need to base this on ($carry or date_change)
886 # if $carry is set, the date doesn't matter: we're not
887 # going to increment the v. number twice at year-change.
888 $next->{a} += $carry;
889 } elsif (defined $pattern->{x}) {
890 $next->{a} += $self->calendar_increment(\@cur, @new);
898 # First handle any "alternative enumeration", since they're
899 # a lot simpler, and don't depend on the the calendar
900 foreach my $key ('h', 'g') {
901 next if !exists $next->{$key};
902 if (!$self->capstr($key)) {
903 warn "Holding data exists for $key, but no caption specified";
908 my $cap = $self->capfield($key);
909 if ($cap->{RESTART} && $cap->{COUNT}
910 && ($next->{$key} == $cap->{COUNT})) {
924 # $carry keeps track of whether we need to carry into the next
925 # higher level of enumeration. It's not actually necessary except
926 # for when the loop ends: if we need to carry from $b into $a
927 # then $carry will be set when the loop ends.
929 # We need to keep track of this because there are two different
930 # reasons why we might increment the highest level of enumeration ($a)
931 # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly)
932 # 2) it's the right time of the year.
935 foreach my $key (reverse('b'..'f')) {
936 next if !exists $next->{$key};
938 if (!$self->capstr($key)) {
939 # Just assume that it increments continuously and give up
940 warn "Holding data exists for $key, but no caption specified";
946 # If the current issue has a combined issue number (eg, 2/3)
947 # get rid of the first issue number and base the calculation
948 # on the final issue number in the combined issue.
949 if ($next->{$key} =~ m|/|) {
950 $next->{$key} =~ s|^[^/]+/||;
953 my $cap = $self->capfield($key);
954 if ($cap->{RESTART} && $cap->{COUNT}
955 && ($next->{$key} eq $cap->{COUNT})) {
959 # If I don't need to "carry" beyond here, then I just increment
960 # this level of the enumeration and stop looping, since the
961 # "next" hash has been initialized with the current values
967 # You can't have a combined issue that spans two volumes: no.12/1
969 if ($self->enum_is_combined($key, $next->{$key})) {
970 $next->{$key} .= '/' . ($next->{$key} + 1);
976 # The easy part is done. There are two things left to do:
977 # 1) Calculate the date of the next issue, if necessary
978 # 2) Increment the highest level of enumeration (either by date
979 # or because $carry is set because of the above loop
981 if (!$self->subfield('i')) {
982 # The simple case: if there is no chronology specified
983 # then just check $carry and return
984 $next->{'a'} += $carry;
986 # Figure out date of next issue, then decide if we need
987 # to adjust top level enumeration based on that
988 $self->next_date($next, $carry, ('i'..'m'));
997 # Initialize $next with current enumeration & chronology, then
998 # we can just operate on $next, based on the contents of the caption
1000 if ($self->enumeration_is_chronology) {
1001 foreach my $key ('a' .. 'h') {
1002 $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
1003 if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
1005 $self->next_date($next, 0, ('a' .. 'h'));
1010 foreach my $key ('a' .. 'h') {
1011 $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS}
1012 if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
1015 foreach my $key ('i'..'m') {
1016 $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
1017 if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
1020 if (exists $next->{'h'}) {
1021 $self->next_alt_enum($next);
1024 $self->next_enum($next);