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 OpenILS::Utils::MFHD::Date;
   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             update_pattern($self, $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}->{p}}))) {
  95         carp("Caption::new: publication frequency '$pat->{w}' != publication pattern @{$pat->{y}->{p}}");
  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     return $self;
 107 }
 108
 109 sub update_pattern {
 110     my $self = shift;
 111     my $val = shift;
 112     my $pathash = $self->{_mfhdc_PATTERN}->{y};
 113     my ($pubcode, $pat) = unpack("a1a*", $val);
 114
 115     $pathash->{$pubcode} = [] unless exists $pathash->{$pubcode};
 116     push @{$pathash->{$pubcode}}, $pat;
 117 }
 118
 119 sub decode_pattern {
 120     my $self = shift;
 121     my $pattern = $self->{_mfhdc_PATTERN}->{y};
 122
 123     # XXX WRITE ME (?)
 124 }
 125
 126 sub compressible {
 127     my $self = shift;
 128
 129     return $self->{_mfhdc_COMPRESSIBLE};
 130 }
 131
 132 sub chrons {
 133     my $self = shift;
 134     my $key = shift;
 135
 136     if (exists $self->{_mfhdc_CHRONS}->{$key}) {
 137         return $self->{_mfhdc_CHRONS}->{$key};
 138     } else {
 139         return undef;
 140     }
 141 }
 142
 143 sub capfield {
 144     my $self = shift;
 145     my $key = shift;
 146
 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};
 151     } else {
 152         return undef;
 153     }
 154 }
 155
 156 sub capstr {
 157     my $self = shift;
 158     my $key = shift;
 159     my $val = $self->capfield($key);
 160
 161     if (ref $val) {
 162         return $val->{CAPTION};
 163     } else {
 164         return $val;
 165     }
 166 }
 167
 168 sub calendar_change {
 169     my $self = shift;
 170
 171     return $self->{_mfhdc_PATTERN}->{x};
 172 }
 173
 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
 180
 181 sub enumeration_is_chronology {
 182     my $self = shift;
 183
 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};
 187
 188     foreach my $key ('a' .. 'f') {
 189         my $enum;
 190
 191         last if !exists $self->{_mfhdc_ENUMS}->{$key};
 192
 193         $enum = $self->{_mfhdc_ENUMS}->{$key};
 194         return 0 if defined $enum->{COUNT} || defined $enum->{RESTART};
 195     }
 196
 197     return (exists $self->{_mfhdc_PATTERN}->{w});
 198 }
 199
 200 sub regularity_match {
 201     my $self = shift;
 202     my $pubcode = shift;
 203     my @date = @_;
 204
 205     # we can't match something that doesn't exist.
 206     return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{$pubcode};
 207
 208     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{$pubcode}}) {
 209         my $chroncode= substr($regularity, 0, 1);
 210         my $matchfunc = MFHD::Date::dispatch($chroncode);
 211         my @pats = split(/,/, substr($regularity, 1));
 212
 213         if (!defined $matchfunc) {
 214             carp "Unrecognized chroncode '$chroncode'";
 215             return 0;
 216         }
 217
 218         # XXX WRITE ME
 219         foreach my $pat (@pats) {
 220             $pat =~ s|/.+||;    # If it's a combined date, match the start
 221             if ($matchfunc->($pat, @date)) {
 222                 return 1;
 223             }
 224         }
 225     }
 226
 227     return 0;
 228 }
 229
 230 sub is_omitted {
 231     my $self = shift;
 232     my @date = @_;
 233
 234 #     printf("# is_omitted: testing date %s: %d\n", join('/', @date),
 235 #          $self->regularity_match('o', @date));
 236     return $self->regularity_match('o', @date);
 237 }
 238
 239 sub is_published {
 240     my $self = shift;
 241     my @date = @_;
 242
 243     return $self->regularity_match('p', @date);
 244 }
 245
 246 sub is_combined {
 247     my $self = shift;
 248     my @date = @_;
 249
 250     return $self->regularity_match('c', @date);
 251 }
 252
 253 sub enum_is_combined {
 254     my $self = shift;
 255     my $subfield = shift;
 256     my $iss = shift;
 257     my $level = ord($subfield) - ord('a') + 1;
 258
 259     return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{c};
 260
 261     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{c}}) {
 262         next unless $regularity =~ m/^e$level/o;
 263
 264         my @pats = split(/,/, substr($regularity, 2));
 265
 266         foreach my $pat (@pats) {
 267             $pat =~ s|/.+||;    # if it's a combined issue, match the start
 268             return 1 if ($iss eq $pat);
 269         }
 270     }
 271
 272     return 0;
 273 }
 274
 275
 276 # Test to see if $m1/$d1 is on or after $m2/$d2
 277 # if $d2 is undefined, test is based on just months
 278 sub on_or_after {
 279     my ($m1, $d1, $m2, $d2) = @_;
 280
 281     return (($m1 > $m2)
 282             || ($m1 == $m2 && ((!defined $d2) || ($d1 >= $d2))));
 283 }
 284
 285 sub calendar_increment {
 286     my $self = shift;
 287     my $cur = shift;
 288     my @new = @_;
 289     my $cal_change = $self->calendar_change;
 290     my $month;
 291     my $day;
 292     my $cur_before;
 293     my $new_on_or_after;
 294
 295     # A calendar change is defined, need to check if it applies
 296     if ((scalar(@new) == 2 && $new[1] > 20) || (scalar(@new) == 1)) {
 297         carp "Can't calculate date change for ", $self->as_string;
 298         return;
 299     }
 300
 301     foreach my $change (@{$cal_change}) {
 302         my $incr;
 303
 304         if (length($change) == 2) {
 305             $month = $change;
 306         } elsif (length($change) == 4) {
 307             ($month, $day) = unpack("a2a2", $change);
 308         }
 309
 310         if ($cur->[0] == $new[0]) {
 311             # Same year, so a 'simple' month/day comparison will be fine
 312             $incr = (!on_or_after($cur->[1], $cur->[2], $month, $day)
 313                      && on_or_after($new[1], $new[2], $month, $day));
 314         } else {
 315             # @cur is in the year before @new. There are
 316             # two possible cases for the calendar change date that
 317             # indicate that it's time to change the volume:
 318             # (1) the change date is AFTER @cur in the year, or
 319             # (2) the change date is BEFORE @new in the year.
 320             #
 321             #  -------|------|------X------|------|
 322             #       @cur    (1)   Jan 1   (2)   @new
 323
 324             $incr = (on_or_after($new[1], $new[2], $month, $day)
 325                      || !on_or_after($cur->[1], $cur->[2], $month, $day));
 326         }
 327         return $incr if $incr;
 328     }
 329 }
 330
 331 sub next_date {
 332     my $self = shift;
 333     my $next = shift;
 334     my $carry = shift;
 335     my @keys = @_;
 336     my @cur;
 337     my @new;
 338     my @newend; # only used for combined issues
 339     my $incr;
 340
 341     my $reg = $self->{_mfhdc_REGULARITY};
 342     my $pattern = $self->{_mfhdc_PATTERN};
 343     my $freq = $pattern->{w};
 344
 345     foreach my $i (0..$#keys) {
 346         $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]};
 347     }
 348
 349     # If the current issue has a combined date (eg, May/June)
 350     # get rid of the first date and base the calculation
 351     # on the final date in the combined issue.
 352     $cur[-1] =~ s|^[^/]+/||;
 353
 354     if (defined $pattern->{y}->{p}) {
 355         # There is a $y publication pattern defined in the record:
 356         # use it to calculate the next issue date.
 357
 358         # XXX TODO: need to handle combined issues.
 359         foreach my $pubpat (@{$pattern->{y}->{p}}) {
 360             my $chroncode = substr($pubpat, 0, 1);
 361             my $genfunc = MFHD::Date::generator($chroncode);
 362             my @pats = split(/,/, substr($pubpat, 1));
 363
 364             if (!defined $genfunc) {
 365                 carp "Unrecognized chroncode '$chroncode'";
 366                 return undef;
 367             }
 368
 369             foreach my $pat (@pats) {
 370                 my @candidate = $genfunc->($pat, @cur);
 371
 372                 while ($self->is_omitted(@candidate)) {
 373 #                   printf("# pubpat omitting date '%s'\n",
 374 #                          join('/', @candidate));
 375                     @candidate = $genfunc->($pat, @candidate);
 376                 }
 377
 378 #               printf("# testing candidate date '%s'\n", join('/', @candidate));
 379                 if (!defined($new[0])
 380                     || !on_or_after($candidate[0], $candidate[1], $new[0], $new[1])) {
 381                     # first time through the loop
 382                     # or @candidate is before @new => @candidate is the next
 383                     # issue.
 384                     @new = @candidate;
 385 #                   printf("# selecting candidate date '%s'\n", join('/', @new));
 386                 }
 387             }
 388         }
 389
 390         # Now check for combined issues, like "May/June"
 391         foreach my $combpat (@{$pattern->{y}->{c}}) {
 392             my $chroncode = substr($combpat, 0, 1);
 393             my $genfunc = MFHD::Date::generator($chroncode);
 394             my @pats = split(/,/, substr($combpat, 1));
 395
 396             foreach my $combined (@pats) {
 397                 my ($start, $end) = split('/', $combined, 2);
 398                 my @candidate = $genfunc->($start, @cur);
 399
 400                 # We don't need to check for omitted issues because
 401                 # combined issues are always published. OR ARE THEY????
 402                 if (!defined($new[0])
 403                     || !on_or_after($candidate[0], $candidate[1], $new[0], $new[1])) {
 404                     # Haven't found a next issue at all yet, or
 405                     # this one is before the best guess so far
 406                     @new = @candidate;
 407                     @newend = $genfunc->($end, @cur);
 408                 }
 409             }
 410         }
 411
 412         if (defined($newend[0])) {
 413             # The best match was a combined issue
 414             foreach my $i (0..$#new) {
 415                 # don't combine identical fields
 416                 next if $new[$i] eq $newend[$i];
 417                 $new[$i] .= '/' . $newend[$i];
 418             }
 419         }
 420     } else {
 421         # There is no $y publication pattern defined, so use
 422         # the $w frequency to figure out the next date
 423
 424         if (!defined($freq)) {
 425             carp "Undefined frequency in next_date!";
 426         } elsif (!MFHD::Date::can_increment($freq)) {
 427             carp "Don't know how to deal with frequency '$freq'!";
 428         } else {
 429             #
 430             # One of the standard defined issue frequencies
 431             #
 432             @new = MFHD::Date::incr_date($freq, @cur);
 433
 434             while ($self->is_omitted(@new)) {
 435                 @new = MFHD::Date::incr_date($freq, @new);
 436             }
 437
 438             if ($self->is_combined(@new)) {
 439                 my @second_date = MFHD::Date::incr_date($freq, @new);
 440
 441                 # I am cheating: This code assumes that only the smallest
 442                 # time increment is combined. So, no "Apr 15/May 1" allowed.
 443                 $new[-1] = $new[-1] . '/' . $second_date[-1];
 444             }
 445         }
 446     }
 447
 448     for my $i (0..$#new) {
 449         $next->{$keys[$i]} = $new[$i];
 450     }
 451     # Figure out if we need to adust volume number
 452     # right now just use the $carry that was passed in.
 453     # in long run, need to base this on ($carry or date_change)
 454     if ($carry) {
 455         # if $carry is set, the date doesn't matter: we're not
 456         # going to increment the v. number twice at year-change.
 457         $next->{a} += $carry;
 458     } elsif (defined $pattern->{x}) {
 459         $next->{a} += $self->calendar_increment(\@cur, @new);
 460     }
 461 }
 462
 463 sub next_alt_enum {
 464     my $self = shift;
 465     my $next = shift;
 466
 467     # First handle any "alternative enumeration", since they're
 468     # a lot simpler, and don't depend on the the calendar
 469     foreach my $key ('h', 'g') {
 470         next if !exists $next->{$key};
 471         if (!$self->capstr($key)) {
 472             warn "Holding data exists for $key, but no caption specified";
 473             $next->{$key} += 1;
 474             last;
 475         }
 476
 477         my $cap = $self->capfield($key);
 478         if ($cap->{RESTART} && $cap->{COUNT}
 479             && ($next->{$key} == $cap->{COUNT})) {
 480             $next->{$key} = 1;
 481         } else {
 482             $next->{$key} += 1;
 483             last;
 484         }
 485     }
 486 }
 487
 488 sub next_enum {
 489     my $self = shift;
 490     my $next = shift;
 491     my $carry;
 492
 493     # $carry keeps track of whether we need to carry into the next
 494     # higher level of enumeration. It's not actually necessary except
 495     # for when the loop ends: if we need to carry from $b into $a
 496     # then $carry will be set when the loop ends.
 497     #
 498     # We need to keep track of this because there are two different
 499     # reasons why we might increment the highest level of enumeration ($a)
 500     # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly)
 501     # 2) it's the right time of the year.
 502     #
 503     $carry = 0;
 504     foreach my $key (reverse('b'..'f')) {
 505         next if !exists $next->{$key};
 506
 507         if (!$self->capstr($key)) {
 508             # Just assume that it increments continuously and give up
 509             warn "Holding data exists for $key, but no caption specified";
 510             $next->{$key} += 1;
 511             $carry = 0;
 512             last;
 513         }
 514
 515         # If the current issue has a combined issue number (eg, 2/3)
 516         # get rid of the first issue number and base the calculation
 517         # on the final issue number in the combined issue.
 518         if ($next->{$key} =~ m|/|) {
 519             $next->{$key} =~ s|^[^/]+/||;
 520         }
 521
 522         my $cap = $self->capfield($key);
 523         if ($cap->{RESTART} && $cap->{COUNT}
 524             && ($next->{$key} eq $cap->{COUNT})) {
 525             $next->{$key} = 1;
 526             $carry = 1;
 527         } else {
 528             # If I don't need to "carry" beyond here, then I just increment
 529             # this level of the enumeration and stop looping, since the
 530             # "next" hash has been initialized with the current values
 531
 532             $next->{$key} += 1;
 533             $carry = 0;
 534         }
 535
 536         # You can't have a combined issue that spans two volumes: no.12/1
 537         # is forbidden
 538         if ($self->enum_is_combined($key, $next->{$key})) {
 539             $next->{$key} .= '/' . ($next->{$key} + 1);
 540         }
 541
 542         last if !$carry;
 543     }
 544
 545     # The easy part is done. There are two things left to do:
 546     # 1) Calculate the date of the next issue, if necessary
 547     # 2) Increment the highest level of enumeration (either by date
 548     #    or because $carry is set because of the above loop
 549
 550     if (!$self->subfield('i')) {
 551         # The simple case: if there is no chronology specified
 552         # then just check $carry and return
 553         $next->{'a'} += $carry;
 554     } else {
 555         # Figure out date of next issue, then decide if we need
 556         # to adjust top level enumeration based on that
 557         $self->next_date($next, $carry, ('i'..'m'));
 558     }
 559 }
 560
 561 sub next {
 562     my $self = shift;
 563     my $holding = shift;
 564     my $next = {};
 565
 566     # Initialize $next with current enumeration & chronology, then
 567     # we can just operate on $next, based on the contents of the caption
 568
 569     if ($self->enumeration_is_chronology) {
 570         foreach my $key ('a' .. 'h') {
 571             $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
 572               if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 573         }
 574         $self->next_date($next, 0, ('a' .. 'h'));
 575
 576         return $next;
 577     }
 578
 579     foreach my $key ('a' .. 'h') {
 580         $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS}
 581           if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 582     }
 583
 584     foreach my $key ('i'..'m') {
 585         $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
 586           if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 587     }
 588
 589     if (exists $next->{'h'}) {
 590         $self->next_alt_enum($next);
 591     }
 592
 593     $self->next_enum($next);
 594
 595     return($next);
 596 }
 597
 598 1;