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 use OpenILS::Utils::MFHD::Date;
  10
  11 use base 'MARC::Field';
  12
  13 sub new
  14 {
  15     my $proto = shift;
  16     my $class = ref($proto) || $proto;
  17     my $self = shift;
  18     my $last_enum = undef;
  19
  20     $self->{_mfhdc_ENUMS} = {};
  21     $self->{_mfhdc_CHRONS} = {};
  22     $self->{_mfhdc_PATTERN} = {};
  23     $self->{_mfhdc_COPY} = undef;
  24     $self->{_mfhdc_UNIT} = undef;
  25     $self->{_mfhdc_COMPRESSIBLE} = 1;   # until proven otherwise
  26
  27     foreach my $subfield ($self->subfields) {
  28         my ($key, $val) = @$subfield;
  29         if ($key eq '8') {
  30             $self->{LINK} = $val;
  31         } elsif ($key =~ /[a-h]/) {
  32             # Enumeration Captions
  33             $self->{_mfhdc_ENUMS}->{$key} = {CAPTION => $val,
  34                                              COUNT => undef,
  35                                              RESTART => undef};
  36             if ($key =~ /[ag]/) {
  37                 $last_enum = undef;
  38             } else {
  39                 $last_enum = $key;
  40             }
  41         } elsif ($key =~ /[i-m]/) {
  42             # Chronology captions
  43             $self->{_mfhdc_CHRONS}->{$key} = $val;
  44         } elsif ($key eq 'u') {
  45             # Bib units per next higher enumeration level
  46             carp('$u specified for top-level enumeration')
  47               unless defined($last_enum);
  48             $self->{_mfhdc_ENUMS}->{$last_enum}->{COUNT} = $val;
  49         } elsif ($key eq 'v') {
  50             carp '$v specified for top-level enumeration'
  51               unless defined($last_enum);
  52             $self->{_mfhdc_ENUMS}->{$last_enum}->{RESTART} = ($val eq 'r');
  53         } elsif ($key =~ /[npwz]/) {
  54             # Publication Pattern info ('o' == type of unit, 'q'..'t' undefined)
  55             $self->{_mfhdc_PATTERN}->{$key} = $val;
  56         } elsif ($key =~ /x/) {
  57             # Calendar change can have multiple comma-separated values
  58             $self->{_mfhdc_PATTERN}->{x} = [split /,/, $val];
  59         } elsif ($key eq 'y') {
  60             $self->{_mfhdc_PATTERN}->{y} = {}
  61               unless exists $self->{_mfhdc_PATTERN}->{y};
  62             update_pattern($self, $val);
  63         } elsif ($key eq 'o') {
  64             # Type of unit
  65             $self->{_mfhdc_UNIT} = $val;
  66         } elsif ($key eq 't') {
  67             $self->{_mfhdc_COPY} = $val;
  68         } else {
  69             carp "Unknown caption subfield '$key'";
  70         }
  71     }
  72
  73     # subsequent levels of enumeration (primary and alternate)
  74     # If an enumeration level doesn't document the number
  75     # of "issues" per "volume", or whether numbering of issues
  76     # restarts, then we can't compress.
  77     foreach my $key ('b', 'c', 'd', 'e', 'f', 'h') {
  78         if (exists $self->{_mfhdc_ENUMS}->{$key}) {
  79             my $pattern = $self->{_mfhdc_ENUMS}->{$key};
  80             if (!$pattern->{RESTART} || !$pattern->{COUNT}
  81                 || ($pattern->{COUNT} eq 'var')
  82                 || ($pattern->{COUNT} eq 'und')) {
  83                 $self->{_mfhdc_COMPRESSIBLE} = 0;
  84                 last;
  85             }
  86         }
  87     }
  88
  89     my $pat = $self->{_mfhdc_PATTERN};
  90
  91     # Sanity check publication frequency vs publication pattern:
  92     # if the frequency is a number, then the pattern better
  93     # have that number of values associated with it.
  94     if (exists($pat->{w}) && ($pat->{w} =~ /^\d+$/)
  95         && ($pat->{w} != scalar(@{$pat->{y}->{p}}))) {
  96         carp("Caption::new: publication frequency '$pat->{w}' != publication pattern @{$pat->{y}->{p}}");
  97     }
  98
  99
 100     # If there's a $x subfield and a $j, then it's compressible
 101     if (exists $pat->{x} && exists $self->{_mfhdc_CHRONS}->{'j'}) {
 102         $self->{_mfhdc_COMPRESSIBLE} = 1;
 103     }
 104
 105     bless ($self, $class);
 106
 107     return $self;
 108 }
 109
 110 sub update_pattern {
 111     my $self = shift;
 112     my $val = shift;
 113     my $pathash = $self->{_mfhdc_PATTERN}->{y};
 114     my ($pubcode, $pat) = unpack("a1a*", $val);
 115
 116     $pathash->{$pubcode} = [] unless exists $pathash->{$pubcode};
 117     push @{$pathash->{$pubcode}}, $pat;
 118 }
 119
 120 sub decode_pattern {
 121     my $self = shift;
 122     my $pattern = $self->{_mfhdc_PATTERN}->{y};
 123
 124     # XXX WRITE ME (?)
 125 }
 126
 127 sub compressible {
 128     my $self = shift;
 129
 130     return $self->{_mfhdc_COMPRESSIBLE};
 131 }
 132
 133 sub chrons {
 134     my $self = shift;
 135     my $key = shift;
 136
 137     if (exists $self->{_mfhdc_CHRONS}->{$key}) {
 138         return $self->{_mfhdc_CHRONS}->{$key};
 139     } else {
 140         return undef;
 141     }
 142 }
 143
 144 sub capfield {
 145     my $self = shift;
 146     my $key = shift;
 147
 148     if (exists $self->{_mfhdc_ENUMS}->{$key}) {
 149         return $self->{_mfhdc_ENUMS}->{$key};
 150     } elsif (exists $self->{_mfhdc_CHRONS}->{$key}) {
 151         return $self->{_mfhdc_CHRONS}->{$key};
 152     } else {
 153         return undef;
 154     }
 155 }
 156
 157 sub capstr {
 158     my $self = shift;
 159     my $key = shift;
 160     my $val = $self->capfield($key);
 161
 162     if (ref $val) {
 163         return $val->{CAPTION};
 164     } else {
 165         return $val;
 166     }
 167 }
 168
 169 sub calendar_change {
 170     my $self = shift;
 171
 172     return $self->{_mfhdc_PATTERN}->{x};
 173 }
 174
 175 # If items are identified by chronology only, with no separate
 176 # enumeration (eg, a newspaper issue), then the chronology is
 177 # recorded in the enumeration subfields $a - $f.  We can tell
 178 # that this is the case if there are $a - $f subfields and no
 179 # chronology subfields ($i-$k), and none of the $a-$f subfields
 180 # have associated $u or $v subfields, but there's a $w and no $x
 181
 182 sub enumeration_is_chronology {
 183     my $self = shift;
 184
 185     # There is always a '$a' subfield in well-formed fields.
 186     return 0 if exists $self->{_mfhdc_CHRONS}->{i}
 187       || exists $self->{_mfhdc_PATTERN}->{x};
 188
 189     foreach my $key ('a' .. 'f') {
 190         my $enum;
 191
 192         last if !exists $self->{_mfhdc_ENUMS}->{$key};
 193
 194         $enum = $self->{_mfhdc_ENUMS}->{$key};
 195         return 0 if defined $enum->{COUNT} || defined $enum->{RESTART};
 196     }
 197
 198     return (exists $self->{_mfhdc_PATTERN}->{w});
 199 }
 200
 201 sub regularity_match {
 202     my $self = shift;
 203     my $pubcode = shift;
 204     my @date = @_;
 205
 206     # we can't match something that doesn't exist.
 207     return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{$pubcode};
 208
 209     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{$pubcode}}) {
 210         my $chroncode= substr($regularity, 0, 1);
 211         my $matchfunc = MFHD::Date::dispatch($chroncode);
 212         my @pats = split(/,/, substr($regularity, 1));
 213
 214         if (!defined $matchfunc) {
 215             carp "Unrecognized chroncode '$chroncode'";
 216             return 0;
 217         }
 218
 219         # XXX WRITE ME
 220         foreach my $pat (@pats) {
 221             $pat =~ s|/.+||;    # If it's a combined date, match the start
 222             if ($matchfunc->($pat, @date)) {
 223                 return 1;
 224             }
 225         }
 226     }
 227
 228     return 0;
 229 }
 230
 231 sub is_omitted {
 232     my $self = shift;
 233     my @date = @_;
 234
 235 #     printf("# is_omitted: testing date %s: %d\n", join('/', @date),
 236 #          $self->regularity_match('o', @date));
 237     return $self->regularity_match('o', @date);
 238 }
 239
 240 sub is_published {
 241     my $self = shift;
 242     my @date = @_;
 243
 244     return $self->regularity_match('p', @date);
 245 }
 246
 247 sub is_combined {
 248     my $self = shift;
 249     my @date = @_;
 250
 251     return $self->regularity_match('c', @date);
 252 }
 253
 254 sub enum_is_combined {
 255     my $self = shift;
 256     my $subfield = shift;
 257     my $iss = shift;
 258     my $level = ord($subfield) - ord('a') + 1;
 259
 260     return 0 if !exists $self->{_mfhdc_PATTERN}->{y}->{c};
 261
 262     foreach my $regularity (@{$self->{_mfhdc_PATTERN}->{y}->{c}}) {
 263         next unless $regularity =~ m/^e$level/o;
 264
 265         my @pats = split(/,/, substr($regularity, 2));
 266
 267         foreach my $pat (@pats) {
 268             $pat =~ s|/.+||;    # if it's a combined issue, match the start
 269             return 1 if ($iss eq $pat);
 270         }
 271     }
 272
 273     return 0;
 274 }
 275
 276
 277 # Test to see if $m1/$d1 is on or after $m2/$d2
 278 # if $d2 is undefined, test is based on just months
 279 sub on_or_after {
 280     my ($m1, $d1, $m2, $d2) = @_;
 281
 282     return (($m1 > $m2)
 283             || ($m1 == $m2 && ((!defined $d2) || ($d1 >= $d2))));
 284 }
 285
 286 sub calendar_increment {
 287     my $self = shift;
 288     my $cur = shift;
 289     my @new = @_;
 290     my $cal_change = $self->calendar_change;
 291     my $month;
 292     my $day;
 293     my $cur_before;
 294     my $new_on_or_after;
 295
 296     # A calendar change is defined, need to check if it applies
 297     if ((scalar(@new) == 2 && $new[1] > 20) || (scalar(@new) == 1)) {
 298         carp "Can't calculate date change for ", $self->as_string;
 299         return;
 300     }
 301
 302     foreach my $change (@{$cal_change}) {
 303         my $incr;
 304
 305         if (length($change) == 2) {
 306             $month = $change;
 307         } elsif (length($change) == 4) {
 308             ($month, $day) = unpack("a2a2", $change);
 309         }
 310
 311         if ($cur->[0] == $new[0]) {
 312             # Same year, so a 'simple' month/day comparison will be fine
 313             $incr = (!on_or_after($cur->[1], $cur->[2], $month, $day)
 314                      && on_or_after($new[1], $new[2], $month, $day));
 315         } else {
 316             # @cur is in the year before @new. There are
 317             # two possible cases for the calendar change date that
 318             # indicate that it's time to change the volume:
 319             # (1) the change date is AFTER @cur in the year, or
 320             # (2) the change date is BEFORE @new in the year.
 321             #
 322             #  -------|------|------X------|------|
 323             #       @cur    (1)   Jan 1   (2)   @new
 324
 325             $incr = (on_or_after($new[1], $new[2], $month, $day)
 326                      || !on_or_after($cur->[1], $cur->[2], $month, $day));
 327         }
 328         return $incr if $incr;
 329     }
 330 }
 331
 332 sub next_date {
 333     my $self = shift;
 334     my $next = shift;
 335     my $carry = shift;
 336     my @keys = @_;
 337     my @cur;
 338     my @new;
 339     my $incr;
 340     my @candidate;
 341
 342     my $reg = $self->{_mfhdc_REGULARITY};
 343     my $pattern = $self->{_mfhdc_PATTERN};
 344     my $freq = $pattern->{w};
 345
 346     foreach my $i (0..$#keys) {
 347         $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]};
 348     }
 349
 350     # If the current issue has a combined date (eg, May/June)
 351     # get rid of the first date and base the calculation
 352     # on the final date in the combined issue.
 353     $cur[-1] =~ s|^[^/]+/||;
 354
 355     if (defined $pattern->{y}->{p}) {
 356         # There is a $y publication pattern defined in the record:
 357         # use it to calculate the next issue date.
 358
 359         # XXX TODO: need to handle combined issues.
 360         foreach my $pubpat (@{$pattern->{y}->{p}}) {
 361             my $chroncode = substr($pubpat, 0, 1);
 362             my $genfunc = MFHD::Date::generator($chroncode);
 363             my @pats = split(/,/, substr($pubpat, 1));
 364
 365             if (!defined $genfunc) {
 366                 carp "Unrecognized chroncode '$chroncode'";
 367                 return undef;
 368             }
 369
 370             foreach my $pat (@pats) {
 371                 @candidate = $genfunc->($pat, @cur);
 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     } else {
 390         # There is no $y publication pattern defined, so use
 391         # the $w frequency to figure out the next date
 392
 393         if (!defined($freq)) {
 394             carp "Undefined frequency in next_date!";
 395         } elsif (!MFHD::Date::can_increment($freq)) {
 396             carp "Don't know how to deal with frequency '$freq'!";
 397         } else {
 398             #
 399             # One of the standard defined issue frequencies
 400             #
 401             @new = MFHD::Date::incr_date($freq, @cur);
 402
 403             while ($self->is_omitted(@new)) {
 404                 @new = MFHD::Date::incr_date($freq, @new);
 405             }
 406
 407             if ($self->is_combined(@new)) {
 408                 my @second_date = MFHD::Date::incr_date($freq, @new);
 409
 410                 # I am cheating: This code assumes that only the smallest
 411                 # time increment is combined. So, no "Apr 15/May 1" allowed.
 412                 $new[-1] = $new[-1] . '/' . $second_date[-1];
 413             }
 414         }
 415     }
 416
 417     for my $i (0..$#new) {
 418         $next->{$keys[$i]} = $new[$i];
 419     }
 420     # Figure out if we need to adust volume number
 421     # right now just use the $carry that was passed in.
 422     # in long run, need to base this on ($carry or date_change)
 423     if ($carry) {
 424         # if $carry is set, the date doesn't matter: we're not
 425         # going to increment the v. number twice at year-change.
 426         $next->{a} += $carry;
 427     } elsif (defined $pattern->{x}) {
 428         $next->{a} += $self->calendar_increment(\@cur, @new);
 429     }
 430 }
 431
 432 sub next_alt_enum {
 433     my $self = shift;
 434     my $next = shift;
 435
 436     # First handle any "alternative enumeration", since they're
 437     # a lot simpler, and don't depend on the the calendar
 438     foreach my $key ('h', 'g') {
 439         next if !exists $next->{$key};
 440         if (!$self->capstr($key)) {
 441             warn "Holding data exists for $key, but no caption specified";
 442             $next->{$key} += 1;
 443             last;
 444         }
 445
 446         my $cap = $self->capfield($key);
 447         if ($cap->{RESTART} && $cap->{COUNT}
 448             && ($next->{$key} == $cap->{COUNT})) {
 449             $next->{$key} = 1;
 450         } else {
 451             $next->{$key} += 1;
 452             last;
 453         }
 454     }
 455 }
 456
 457 sub next_enum {
 458     my $self = shift;
 459     my $next = shift;
 460     my $carry;
 461
 462     # $carry keeps track of whether we need to carry into the next
 463     # higher level of enumeration. It's not actually necessary except
 464     # for when the loop ends: if we need to carry from $b into $a
 465     # then $carry will be set when the loop ends.
 466     #
 467     # We need to keep track of this because there are two different
 468     # reasons why we might increment the highest level of enumeration ($a)
 469     # 1) we hit the correct number of items in $b (ie, 5th iss of quarterly)
 470     # 2) it's the right time of the year.
 471     #
 472     $carry = 0;
 473     foreach my $key (reverse('b'..'f')) {
 474         next if !exists $next->{$key};
 475
 476         if (!$self->capstr($key)) {
 477             # Just assume that it increments continuously and give up
 478             warn "Holding data exists for $key, but no caption specified";
 479             $next->{$key} += 1;
 480             $carry = 0;
 481             last;
 482         }
 483
 484         # If the current issue has a combined issue number (eg, 2/3)
 485         # get rid of the first issue number and base the calculation
 486         # on the final issue number in the combined issue.
 487         if ($next->{$key} =~ m|/|) {
 488             $next->{$key} =~ s|^[^/]+/||;
 489         }
 490
 491         my $cap = $self->capfield($key);
 492         if ($cap->{RESTART} && $cap->{COUNT}
 493             && ($next->{$key} eq $cap->{COUNT})) {
 494             $next->{$key} = 1;
 495             $carry = 1;
 496         } else {
 497             # If I don't need to "carry" beyond here, then I just increment
 498             # this level of the enumeration and stop looping, since the
 499             # "next" hash has been initialized with the current values
 500
 501             $next->{$key} += 1;
 502             $carry = 0;
 503         }
 504
 505         # You can't have a combined issue that spans two volumes: no.12/1
 506         # is forbidden
 507         if ($self->enum_is_combined($key, $next->{$key})) {
 508             $next->{$key} .= '/' . ($next->{$key} + 1);
 509         }
 510
 511         last if !$carry;
 512     }
 513
 514     # The easy part is done. There are two things left to do:
 515     # 1) Calculate the date of the next issue, if necessary
 516     # 2) Increment the highest level of enumeration (either by date
 517     #    or because $carry is set because of the above loop
 518
 519     if (!$self->subfield('i')) {
 520         # The simple case: if there is no chronology specified
 521         # then just check $carry and return
 522         $next->{'a'} += $carry;
 523     } else {
 524         # Figure out date of next issue, then decide if we need
 525         # to adjust top level enumeration based on that
 526         $self->next_date($next, $carry, ('i'..'m'));
 527     }
 528 }
 529
 530 sub next {
 531     my $self = shift;
 532     my $holding = shift;
 533     my $next = {};
 534
 535     # Initialize $next with current enumeration & chronology, then
 536     # we can just operate on $next, based on the contents of the caption
 537
 538     if ($self->enumeration_is_chronology) {
 539         foreach my $key ('a' .. 'h') {
 540             $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
 541               if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 542         }
 543         $self->next_date($next, 0, ('a' .. 'h'));
 544
 545         return $next;
 546     }
 547
 548     foreach my $key ('a' .. 'h') {
 549         $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS}
 550           if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 551     }
 552
 553     foreach my $key ('i'..'m') {
 554         $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
 555           if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
 556     }
 557
 558     if (exists $next->{'h'}) {
 559         $self->next_alt_enum($next);
 560     }
 561
 562     $self->next_enum($next);
 563
 564     return($next);
 565 }
 566
 567 1;