Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm

   1 # MFHD::Holding provides some additional holdings logic to a MARC::Field
   2 # object.  In its current state it is primarily read-only, as direct changes
   3 # to the underlying MARC::Field are not reflected in the MFHD logic layer, and
   4 # only the 'increment', 'notes', and 'seqno' methods do updates to the
   5 # MARC::Field layer.
   6
   7 package MFHD::Holding;
   8 use strict;
   9 use integer;
  10
  11 use Carp;
  12 use DateTime;
  13 use Data::Dumper;
  14
  15 use base 'MARC::Field';
  16
  17 sub new {
  18     my $proto     = shift;
  19     my $class     = ref($proto) || $proto;
  20     my $seqno     = shift;
  21     my $self      = shift;
  22     my $caption   = shift;
  23     my $last_enum = undef;
  24
  25     $self->{_mfhdh_SEQNO}          = $seqno;
  26     $self->{_mfhdh_CAPTION}        = $caption;
  27     $self->{_mfhdh_DESCR}          = {};
  28     $self->{_mfhdh_COPY}           = undef;
  29     $self->{_mfhdh_BREAK}          = undef;
  30     $self->{_mfhdh_NOTES}          = {};
  31     $self->{_mfhdh_NOTES}{public}  = [];
  32     $self->{_mfhdh_NOTES}{private} = [];
  33     $self->{_mfhdh_COPYRIGHT}      = [];
  34     $self->{_mfhdh_COMPRESSED}     = $self->indicator(2) eq '0' ? 1 : 0;
  35     $self->{_mfhdh_OPEN_ENDED}     = 0;
  36
  37     foreach my $subfield ($self->subfields) {
  38         my ($key, $val) = @$subfield;
  39
  40         if ($key =~ /[a-m]/) {
  41             if ($self->{_mfhdh_COMPRESSED}) {
  42                 $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [split(/\-/, $val)];
  43             } else {
  44                 $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [$val];
  45             }
  46             if ($key =~ /[a-h]/) {
  47                 # Enumeration specific details of holdings
  48                 $self->{_mfhdh_FIELDS}->{$key}{UNIT} = undef;
  49                 $last_enum = $key;
  50             }
  51         } elsif ($key eq 'o') {
  52             warn '$o specified prior to first enumeration'
  53               unless defined($last_enum);
  54             $self->{_mfhdh_FIELDS}->{$last_enum}->{UNIT} = $val;
  55             $last_enum = undef;
  56         } elsif ($key =~ /[npq]/) {
  57             $self->{_mfhdh_DESCR}->{$key} = $val;
  58         } elsif ($key eq 's') {
  59             push @{$self->{_mfhdh_COPYRIGHT}}, $val;
  60         } elsif ($key eq 't') {
  61             $self->{_mfhdh_COPY} = $val;
  62         } elsif ($key eq 'w') {
  63             carp "Unrecognized break indicator '$val'"
  64               unless $val =~ /^[gn]$/;
  65             $self->{_mfhdh_BREAK} = $val;
  66         } elsif ($key eq 'x') {
  67             push @{$self->{_mfhdh_NOTES}{private}}, $val;
  68         } elsif ($key eq 'z') {
  69             push @{$self->{_mfhdh_NOTES}{public}}, $val;
  70         }
  71     }
  72
  73     if (   $self->{_mfhdh_COMPRESSED}
  74         && $self->{_mfhdh_FIELDS}{'a'}{HOLDINGS}[1] eq '') {
  75         $self->{_mfhdh_OPEN_ENDED} = 1;
  76     }
  77     bless($self, $class);
  78     return $self;
  79 }
  80
  81 #
  82 # accessor to the object's field hash
  83 #
  84 # We are avoiding calling these elements 'subfields' because they are more
  85 # than simply the MARC subfields, although in the current implementation they
  86 # are indexed on the subfield key
  87 #
  88 sub fields {
  89     my $self = shift;
  90
  91     return $self->{_mfhdh_FIELDS};
  92 }
  93
  94 #
  95 # Given a field key, returns an array ref of one (for single statements)
  96 # or two (for compressed statements) values
  97 #
  98 sub field_values {
  99     my ($self, $key) = @_;
 100
 101     if (exists $self->fields->{$key}) {
 102         my @values = @{$self->fields->{$key}{HOLDINGS}};
 103         return \@values;
 104     } else {
 105         return undef;
 106     }
 107 }
 108
 109 sub seqno {
 110     my $self = shift;
 111
 112     if (@_) {
 113         $self->{_mfhdh_SEQNO} = $_[0];
 114         $self->update(8 => $self->caption->link_id . '.' . $_[0]);
 115     }
 116
 117     return $self->{_mfhdh_SEQNO};
 118 }
 119
 120 sub is_compressed {
 121     my $self = shift;
 122
 123     return $self->{_mfhdh_COMPRESSED};
 124 }
 125
 126 sub is_open_ended {
 127     my $self = shift;
 128
 129     return $self->{_mfhdh_OPEN_ENDED};
 130 }
 131
 132 sub caption {
 133     my $self = shift;
 134
 135     return $self->{_mfhdh_CAPTION};
 136 }
 137
 138 sub notes {
 139     my $self  = shift;
 140     my $type  = shift;
 141     my @notes = @_;
 142
 143     if (!$type) {
 144         $type = 'public';
 145     } elsif ($type ne 'public' && $type ne 'private') {
 146         carp("Notes being applied without specifiying type");
 147         unshift(@notes, $type);
 148         $type = 'public';
 149     }
 150
 151     if (ref($notes[0])) {
 152         $self->{_mfhdh_NOTES}{$type} = $notes[0];
 153         $self->_replace_note_subfields($type, @{$notes[0]});
 154     } elsif (@notes) {
 155         if ($notes[0]) {
 156             $self->{_mfhdh_NOTES}{$type} = \@notes;
 157         } else {
 158             $self->{_mfhdh_NOTES}{$type} = [];
 159         }
 160         $self->_replace_note_subfields($type, @notes);
 161     }
 162
 163     return $self->{_mfhdh_NOTES}{$type};
 164 }
 165
 166 #
 167 # utility function for 'notes' method
 168 #
 169 sub _replace_note_subfields {
 170     my $self              = shift;
 171     my $type              = shift;
 172     my @notes             = @_;
 173     my %note_subfield_ids = ('public' => 'z', 'private' => 'x');
 174
 175     $self->delete_subfield(code => $note_subfield_ids{$type});
 176
 177     foreach my $note (@notes) {
 178         $self->add_subfields($note_subfield_ids{$type} => $note);
 179     }
 180 }
 181
 182 #
 183 # return a simple subfields list (for easier revivification from database)
 184 #
 185 sub subfields_list {
 186     my $self = shift;
 187     my @subfields;
 188
 189     foreach my $subfield ($self->subfields) {
 190         push(@subfields, $subfield->[0], $subfield->[1]);
 191     }
 192     return @subfields;
 193 }
 194
 195 #
 196 # Called by method 'format_part' for formatting the chronology portion of
 197 # the holding statement
 198 #
 199 sub format_chron {
 200     my $self     = shift;
 201     my $holdings = shift;
 202     my $caption  = $self->caption;
 203     my @keys     = @_;
 204     my $str      = '';
 205     my %month    = (
 206         '01' => 'Jan.',
 207         '02' => 'Feb.',
 208         '03' => 'Mar.',
 209         '04' => 'Apr.',
 210         '05' => 'May ',
 211         '06' => 'Jun.',
 212         '07' => 'Jul.',
 213         '08' => 'Aug.',
 214         '09' => 'Sep.',
 215         '10' => 'Oct.',
 216         '11' => 'Nov.',
 217         '12' => 'Dec.',
 218         '21' => 'Spring',
 219         '22' => 'Summer',
 220         '23' => 'Autumn',
 221         '24' => 'Winter'
 222     );
 223
 224     foreach my $i (0..@keys) {
 225         my $key = $keys[$i];
 226         my $capstr;
 227         my $chron;
 228         my $sep;
 229
 230         last if !defined $caption->capstr($key);
 231
 232         $capstr = $caption->capstr($key);
 233         if (substr($capstr, 0, 1) eq '(') {
 234             # a caption enclosed in parentheses is not displayed
 235             $capstr = '';
 236         }
 237
 238         # If this is the second level of chronology, then it's
 239         # likely to be a month or season, so we should use the
 240         # string name rather than the number given.
 241         if (($i == 1)) {
 242             # account for possible combined issue chronology
 243             my @chron_parts = split('/', $holdings->{$key});
 244             for (my $i = 0; $i < @chron_parts; $i++) {
 245                 $chron_parts[$i] = $month{$chron_parts[$i]};
 246             }
 247             $chron = join('/', @chron_parts);
 248         } else {
 249             $chron = $holdings->{$key};
 250         }
 251
 252         $str .= (($i == 0 || $str =~ /[. ]$/) ? '' : ':') . $capstr . $chron;
 253     }
 254
 255     return $str;
 256 }
 257
 258 #
 259 # Called by method 'format' for each member of a possibly compressed holding
 260 #
 261 sub format_part {
 262     my $self           = shift;
 263     my $holding_values = shift;
 264     my $caption        = $self->caption;
 265     my $str            = '';
 266
 267     if ($caption->type_of_unit) {
 268         $str = $caption->type_of_unit . ' ';
 269     }
 270
 271     if ($caption->enumeration_is_chronology) {
 272         # if issues are identified by chronology only, then the
 273         # chronology data is stored in the enumeration subfields,
 274         # so format those fields as if they were chronological.
 275         $str = $self->format_chron($holding_values, 'a'..'f');
 276     } else {
 277         # OK, there is enumeration data and maybe chronology
 278         # data as well, format both parts appropriately
 279
 280         # Enumerations
 281         foreach my $key ('a'..'f') {
 282             my $capstr;
 283             my $chron;
 284             my $sep;
 285
 286             last if !defined $caption->capstr($key);
 287
 288             $capstr = $caption->capstr($key);
 289             if (substr($capstr, 0, 1) eq '(') {
 290                 # a caption enclosed in parentheses is not displayed
 291                 $capstr = '';
 292             }
 293             $str .=
 294               ($key eq 'a' ? '' : ':') . $capstr . $holding_values->{$key};
 295         }
 296
 297         # Chronology
 298         if (defined $caption->capstr('i')) {
 299             $str .= '(';
 300             $str .= $self->format_chron($holding_values, 'i'..'l');
 301             $str .= ')';
 302         }
 303
 304         if ($caption->capstr('g')) {
 305             # There's at least one level of alternative enumeration
 306             $str .= '=';
 307             foreach my $key ('g', 'h') {
 308                 $str .=
 309                     ($key eq 'g' ? '' : ':')
 310                   . $caption->capstr($key)
 311                   . $holding_values->{$key};
 312             }
 313
 314             # This assumes that alternative chronology is only ever
 315             # provided if there is an alternative enumeration.
 316             if ($caption->capstr('m')) {
 317                 # Alternative Chronology
 318                 $str .= '(';
 319                 $str .= $caption->capstr('m') . $holding_values->{'m'};
 320                 $str .= ')';
 321             }
 322         }
 323     }
 324
 325     # Breaks in the sequence
 326     if (defined($self->{_mfhdh_BREAK})) {
 327         if ($self->{_mfhdh_BREAK} eq 'n') {
 328             $str .= ' non-gap break';
 329         } elsif ($self->{_mfhdh_BREAK} eq 'g') {
 330             $str .= ' gap';
 331         } else {
 332             warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'";
 333         }
 334     }
 335
 336     return $str;
 337 }
 338
 339 #
 340 # Create and return a string which conforms to display standard Z39.71
 341 #
 342 sub format {
 343     my $self      = shift;
 344     my $subfields = $self->fields;
 345     my %holding_start;
 346     my %holding_end;
 347     my $formatted;
 348
 349     foreach my $key (keys %$subfields) {
 350         ($holding_start{$key}, $holding_end{$key}) =
 351           @{$self->field_values($key)};
 352     }
 353
 354     if ($self->is_compressed) {
 355         # deal with open-ended statements
 356         my $formatted_end;
 357         if ($self->is_open_ended) {
 358             $formatted_end = '';
 359         } else {
 360             $formatted_end = $self->format_part(\%holding_end);
 361         }
 362         $formatted =
 363           $self->format_part(\%holding_start) . ' - ' . $formatted_end;
 364     } else {
 365         $formatted = $self->format_part(\%holding_start);
 366     }
 367
 368     # Public Note
 369     if (@{$self->notes}) {
 370         $formatted .= ' Note: ' . join(', ', @{$self->notes});
 371     }
 372
 373     return $formatted;
 374 }
 375
 376 # next: Given a holding statement, return a hash containing the
 377 # enumeration values for the next issues, whether we hold it or not
 378 # Just pass through to Caption::next
 379 #
 380 sub next {
 381     my $self    = shift;
 382     my $caption = $self->caption;
 383
 384     return $caption->next($self);
 385 }
 386
 387 #
 388 # matches($pat): check to see if $self matches the enumeration hashref passed
 389 # in as $pat, as returned by the 'next' method. e.g.:
 390 # $holding2->matches($holding1->next) # true if $holding2 directly follows
 391 # $holding1
 392 #
 393 # Always returns false if $self is compressed
 394 #
 395 sub matches {
 396     my $self = shift;
 397     my $pat  = shift;
 398
 399     return 0 if $self->is_compressed;
 400
 401     foreach my $key ('a'..'f') {
 402         # If a subfield exists in $self but not in $pat, or vice versa
 403         # or if the field has different values, then fail
 404         if (
 405             defined($self->field_values($key)) != exists($pat->{$key})
 406             || (exists $pat->{$key}
 407                 && ($self->field_values($key)->[0] ne $pat->{$key}))
 408           ) {
 409             return 0;
 410         }
 411     }
 412     return 1;
 413 }
 414
 415 #
 416 # Check that all the fields in a holdings statement are
 417 # included in the corresponding caption.
 418 #
 419 sub validate {
 420     my $self = shift;
 421
 422     foreach my $key (keys %{$self->fields}) {
 423         if (!$self->caption || !$self->caption->capfield($key)) {
 424             return 0;
 425         }
 426     }
 427     return 1;
 428 }
 429
 430 #
 431 # Replace a single holding with it's next prediction
 432 # and return itself
 433 #
 434 # If the holding is compressed, the range is expanded
 435 #
 436 sub increment {
 437     my $self = shift;
 438
 439     my $next = $self->next();
 440
 441     if ($self->is_compressed) {    # expand range
 442         foreach my $key (keys %{$next}) {
 443             my @values = @{$self->field_values($key)};
 444             $values[1] = $next->{$key};
 445             $self->fields->{$key}{HOLDINGS} = \@values;
 446             $next->{$key} = join('-', @values);
 447         }
 448     } else {
 449         foreach my $key (keys %{$next}) {
 450             $self->fields->{$key}{HOLDINGS}[0] = $next->{$key};
 451         }
 452     }
 453
 454     $self->seqno($self->seqno + 1);
 455     $self->update(%{$next});    # update underlying subfields
 456     return $self;
 457 }
 458
 459 #
 460 # Basic, working, unoptimized clone operation
 461 #
 462 sub clone {
 463     my $self = shift;
 464
 465     my $clone_field = $self->SUPER::clone();
 466     return new MFHD::Holding($self->seqno, $clone_field, $self->caption);
 467 }
 468
 469 #
 470 # Turn a chronology instance into date(s) in YYYY-MM-DD format
 471 #
 472 # In list context it returns a list of start and (possibly undefined)
 473 # end dates
 474 #
 475 # In scalar context, it returns a YYYY-MM-DD date string of either the
 476 # single date or the (possibly undefined) end date of a compressed holding
 477 #
 478 sub chron_to_date {
 479     my $self    = shift;
 480     my $caption = $self->caption;
 481
 482     my @keys;
 483     if ($caption->enumeration_is_chronology) {
 484         @keys = ('a'..'f');
 485     } else {
 486         @keys = ('i'..'m');
 487     }
 488
 489     my @chron_start = (0, 1, 1);
 490     my @chron_end   = (0, 1, 1);
 491     my @chrons = (\@chron_start, \@chron_end);
 492     foreach my $key (@keys) {
 493         my $capstr = $caption->capstr($key);
 494         last if !defined($capstr);
 495         if ($capstr =~ /year/) {
 496             ($chron_start[0], $chron_end[0]) = @{$self->field_values($key)};
 497         } elsif ($capstr =~ /month/) {
 498             ($chron_start[1], $chron_end[1]) = @{$self->field_values($key)};
 499         } elsif ($capstr =~ /day/) {
 500             ($chron_start[2], $chron_end[2]) = @{$self->field_values($key)};
 501         } elsif ($capstr =~ /season/) {
 502             my @seasons = @{$self->field_values($key)};
 503             for (my $i = 0; $i < @seasons; $i++) {
 504                 $seasons[$i] = &_uncombine($seasons[$i], 0);
 505                 if ($seasons[$i] == 21) {
 506                     $chrons[$i]->[1] = 3;
 507                     $chrons[$i]->[2] = 20;
 508                 } elsif ($seasons[$i] == 22) {
 509                     $chrons[$i]->[1] = 6;
 510                     $chrons[$i]->[2] = 21;
 511                 } elsif ($seasons[$i] == 23) {
 512                     $chrons[$i]->[1] = 9;
 513                     $chrons[$i]->[2] = 22;
 514                 } elsif ($seasons[$i] == 24) {
 515                     $chrons[$i]->[1] = 12;
 516                     $chrons[$i]->[2] = 21;
 517                 }
 518             }
 519         }
 520     }
 521
 522     my @dates;
 523     foreach my $chron (@chrons) {
 524         my $date = undef;
 525         if ($chron->[0] != 0) {
 526             $date =
 527                 &_uncombine($chron->[0], 0) . '-'
 528               . sprintf('%02d', $chron->[1]) . '-'
 529               . sprintf('%02d', $chron->[2]);
 530         }
 531         push(@dates, $date);
 532     }
 533
 534     if (wantarray()) {
 535         return @dates;
 536     } elsif ($self->is_compressed) {
 537         return $dates[1];
 538     } else {
 539         return $dates[0];
 540     }
 541 }
 542
 543 #
 544 # utility function for uncombining instance parts
 545 #
 546 sub _uncombine {
 547     my ($combo, $pos) = @_;
 548
 549     if (ref($combo)) {
 550         carp("Function 'uncombine' is not an instance method");
 551         return;
 552     }
 553
 554     my @parts = split('/', $combo);
 555     return $parts[$pos];
 556 }
 557 1;