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
15 use base 'MARC::Field';
19 my $class = ref($proto) || $proto;
23 my $last_enum = undef;
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' || $self->indicator(2) eq '2') ? 1 : 0;
35 # TODO: full support for second indicators 2, 3, and 4
36 $self->{_mfhdh_OPEN_ENDED} = 0;
38 foreach my $subfield ($self->subfields) {
39 my ($key, $val) = @$subfield;
41 if ($key =~ /[a-m]/) {
42 if (exists($self->{_mfhdh_FIELDS}->{$key})) {
43 carp("Duplicate, non-repeatable subfield '$key' found, ignoring");
46 if ($self->{_mfhdh_COMPRESSED}) {
47 $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [split(/\-/, $val)];
49 $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [$val];
51 if ($key =~ /[a-h]/) {
52 # Enumeration specific details of holdings
53 $self->{_mfhdh_FIELDS}->{$key}{UNIT} = undef;
56 } elsif ($key eq 'o') {
57 warn '$o specified prior to first enumeration'
58 unless defined($last_enum);
59 $self->{_mfhdh_FIELDS}->{$last_enum}->{UNIT} = $val;
61 } elsif ($key =~ /[npq]/) {
62 $self->{_mfhdh_DESCR}->{$key} = $val;
63 } elsif ($key eq 's') {
64 push @{$self->{_mfhdh_COPYRIGHT}}, $val;
65 } elsif ($key eq 't') {
66 $self->{_mfhdh_COPY} = $val;
67 } elsif ($key eq 'w') {
68 carp "Unrecognized break indicator '$val'"
69 unless $val =~ /^[gn]$/;
70 $self->{_mfhdh_BREAK} = $val;
71 } elsif ($key eq 'x') {
72 push @{$self->{_mfhdh_NOTES}{private}}, $val;
73 } elsif ($key eq 'z') {
74 push @{$self->{_mfhdh_NOTES}{public}}, $val;
78 if ( $self->{_mfhdh_COMPRESSED}
79 && $self->{_mfhdh_FIELDS}{'a'}{HOLDINGS}[1] eq '') {
80 $self->{_mfhdh_OPEN_ENDED} = 1;
87 # accessor to the object's field hash
89 # We are avoiding calling these elements 'subfields' because they are more
90 # than simply the MARC subfields, although in the current implementation they
91 # are indexed on the subfield key
93 # TODO: this accessor should probably be replaced with methods which hide the
94 # underlying structure of {_mfhdh_FIELDS} (see field_values for a start)
99 return $self->{_mfhdh_FIELDS};
103 # Given a field key, returns an array ref of one (for single statements)
104 # or two (for compressed statements) values
106 # TODO: add setter functionality to replace direct {HOLDINGS} access in other
107 # methods. It also makes sense to override some of the MARC::Field setter
108 # methods (such as update()) to accomplish this level of encapsulation.
111 my ($self, $key) = @_;
113 if (exists $self->fields->{$key}) {
114 my @values = @{$self->fields->{$key}{HOLDINGS}};
125 $self->{_mfhdh_SEQNO} = $_[0];
126 $self->update(8 => $self->caption->link_id . '.' . $_[0]);
129 return $self->{_mfhdh_SEQNO};
133 # Optionally accepts a true/false value to set the 'compressed' attribute
134 # Returns 'compressed' attribute
138 my $is_compressed = shift;
140 if (defined($is_compressed)) {
141 if ($is_compressed) {
142 $self->{_mfhdh_COMPRESSED} = 1;
143 $self->update(ind2 => '0');
145 $self->{_mfhdh_COMPRESSED} = 0;
146 $self->update(ind2 => '1');
150 return $self->{_mfhdh_COMPRESSED};
156 return $self->{_mfhdh_OPEN_ENDED};
162 return $self->{_mfhdh_CAPTION};
166 # notes: If called with no arguments, returns the public notes array ref.
167 # If called with a single argument, it returns either 'public' or
168 # 'private' notes based on the passed string.
170 # If called with more than one argument, it sets the proper note field, with
171 # type being the first argument and the note value(s) as the remaining
174 # It is also optional to pass in an array ref of note values as the third
175 # argument rather than a list.
184 } elsif ($type ne 'public' && $type ne 'private') {
185 carp("Notes being applied without specifying type");
186 unshift(@notes, $type);
190 if (ref($notes[0])) {
191 $self->{_mfhdh_NOTES}{$type} = $notes[0];
192 $self->_replace_note_subfields($type, @{$notes[0]});
195 $self->{_mfhdh_NOTES}{$type} = \@notes;
197 $self->{_mfhdh_NOTES}{$type} = [];
199 $self->_replace_note_subfields($type, @notes);
202 return $self->{_mfhdh_NOTES}{$type};
206 # utility function for 'notes' method
208 sub _replace_note_subfields {
212 my %note_subfield_ids = ('public' => 'z', 'private' => 'x');
214 $self->delete_subfield(code => $note_subfield_ids{$type});
216 foreach my $note (@notes) {
217 $self->add_subfields($note_subfield_ids{$type} => $note);
222 # return a simple subfields list (for easier revivification from database)
228 foreach my $subfield ($self->subfields) {
229 push(@subfields, $subfield->[0], $subfield->[1]);
235 # Called by method 'format_part' for formatting the chronology portion of
236 # the holding statement
240 my $holdings = shift;
241 my $caption = $self->caption;
263 foreach my $i (0..@keys) {
269 last if !defined $caption->capstr($key);
271 $capstr = $caption->capstr($key);
272 if (substr($capstr, 0, 1) eq '(') {
273 # a caption enclosed in parentheses is not displayed
277 # If this is the second level of chronology, then it's
278 # likely to be a month or season, so we should use the
279 # string name rather than the number given.
281 # account for possible combined issue chronology
282 my @chron_parts = split('/', $holdings->{$key});
283 for (my $i = 0; $i < @chron_parts; $i++) {
284 $chron_parts[$i] = $month{$chron_parts[$i]} if exists $month{$chron_parts[$i]};
286 $chron = join('/', @chron_parts);
288 $chron = $holdings->{$key};
291 $str .= (($i == 0 || $str =~ /[. ]$/) ? '' : ':') . $capstr . $chron;
298 # Called by method 'format' for each member of a possibly compressed holding
302 my $holding_values = shift;
303 my $caption = $self->caption;
306 if ($caption->type_of_unit) {
307 $str = $caption->type_of_unit . ' ';
310 if ($caption->enumeration_is_chronology) {
311 # if issues are identified by chronology only, then the
312 # chronology data is stored in the enumeration subfields,
313 # so format those fields as if they were chronological.
314 $str = $self->format_chron($holding_values, 'a'..'f');
316 # OK, there is enumeration data and maybe chronology
317 # data as well, format both parts appropriately
320 foreach my $key ('a'..'f') {
325 last if !defined $caption->capstr($key);
327 $capstr = $caption->capstr($key);
328 if (substr($capstr, 0, 1) eq '(') {
329 # a caption enclosed in parentheses is not displayed
333 ($key eq 'a' ? '' : ':') . $capstr . $holding_values->{$key};
337 if (defined $caption->capstr('i')) {
339 $str .= $self->format_chron($holding_values, 'i'..'l');
343 if ($caption->capstr('g')) {
344 # There's at least one level of alternative enumeration
346 foreach my $key ('g', 'h') {
348 ($key eq 'g' ? '' : ':')
349 . $caption->capstr($key)
350 . $holding_values->{$key};
353 # This assumes that alternative chronology is only ever
354 # provided if there is an alternative enumeration.
355 if ($caption->capstr('m')) {
356 # Alternative Chronology
358 $str .= $caption->capstr('m') . $holding_values->{'m'};
364 # Breaks in the sequence
365 if (defined($self->{_mfhdh_BREAK})) {
366 if ($self->{_mfhdh_BREAK} eq 'n') {
367 $str .= ' non-gap break';
368 } elsif ($self->{_mfhdh_BREAK} eq 'g') {
371 warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'";
379 # Create and return a string which conforms to display standard Z39.71
383 my $subfields = $self->fields;
388 foreach my $key (keys %$subfields) {
389 ($holding_start{$key}, $holding_end{$key}) =
390 @{$self->field_values($key)};
393 if ($self->is_compressed) {
394 # deal with open-ended statements
396 if ($self->is_open_ended) {
399 $formatted_end = $self->format_part(\%holding_end);
402 $self->format_part(\%holding_start) . ' - ' . $formatted_end;
404 $formatted = $self->format_part(\%holding_start);
408 if (@{$self->notes}) {
409 $formatted .= ' -- ' . join(', ', @{$self->notes});
415 # next: Given a holding statement, return a hash containing the
416 # enumeration values for the next issues, whether we hold it or not
417 # Just pass through to Caption::next
421 my $caption = $self->caption;
423 return $caption->next($self);
427 # matches($pat): check to see if $self matches the enumeration hashref passed
428 # in as $pat, as returned by the 'next' method. e.g.:
429 # $holding2->matches($holding1->next) # true if $holding2 directly follows
432 # Always returns false if $self is compressed
438 return 0 if $self->is_compressed;
440 foreach my $key ('a'..'f') {
441 # If a subfield exists in $self but not in $pat, or vice versa
442 # or if the field has different values, then fail
444 defined($self->field_values($key)) != exists($pat->{$key})
445 || (exists $pat->{$key}
446 && ($self->field_values($key)->[0] ne $pat->{$key}))
455 # Check that all the fields in a holdings statement are
456 # included in the corresponding caption.
461 foreach my $key (keys %{$self->fields}) {
462 if (!$self->caption || !$self->caption->capfield($key)) {
470 # Replace a single holding with it's next prediction
476 if ($self->is_open_ended) {
477 carp "Holding is open-ended, cannot increment";
479 } elsif ($self->is_compressed) {
480 carp "Incrementing a compressed holding is deprecated, use extend instead";
481 return $self->extend;
484 my $next = $self->next();
486 foreach my $key (keys %{$next}) {
487 $self->fields->{$key}{HOLDINGS}[0] = $next->{$key};
490 $self->seqno($self->seqno + 1);
491 $self->update(%{$next}); # update underlying subfields
496 # Extends a holding (compressing if needed) to include the next
497 # prediction and returns itself
502 if ($self->is_open_ended) {
503 carp "Holding is open-ended, cannot extend";
507 my $next = $self->next();
509 if (!$self->is_compressed) {
510 $self->is_compressed(1); # add compressed state
513 foreach my $key (keys %{$next}) {
514 my @values = @{$self->field_values($key)};
515 $values[1] = $next->{$key};
516 $self->fields->{$key}{HOLDINGS} = \@values;
517 $next->{$key} = join('-', @values);
520 $self->update(%{$next}); # update underlying subfields
525 # Turns a compressed holding into the singular form of the first member
528 sub compressed_to_first {
531 if (!$self->is_compressed) {
532 carp "Holding not compressed, cannot convert to first member";
537 foreach my $key (keys %{$self->fields}) {
538 my @values = @{$self->field_values($key)};
539 $self->fields->{$key}{HOLDINGS} = [$values[0]];
540 $changes{$key} = $values[0];
543 $self->update(%changes); # update underlying subfields
544 $self->is_compressed(0); # remove compressed state
550 # Turns a compressed holding into the singular form of the last member
553 sub compressed_to_last {
556 if (!$self->is_compressed) {
557 carp "Holding not compressed, cannot convert to last member";
559 } elsif ($self->is_open_ended) {
560 carp "Holding is open-ended, cannot convert to last member";
565 foreach my $key (keys %{$self->fields}) {
566 my @values = @{$self->field_values($key)};
567 $self->fields->{$key}{HOLDINGS} = [$values[1]];
568 $changes{$key} = $values[1];
571 $self->update(%changes); # update underlying subfields
572 $self->is_compressed(0); # remove compressed state
578 # Basic, working, unoptimized clone operation
583 my $clone_field = $self->SUPER::clone();
584 return new MFHD::Holding($self->seqno, $clone_field, $self->caption);
588 # Turn a chronology instance into date(s) in YYYY-MM-DD format
590 # In list context it returns a list of start and (possibly undefined)
593 # In scalar context, it returns a YYYY-MM-DD date string of either the
594 # single date or the (possibly undefined) end date of a compressed holding
598 my $caption = $self->caption;
601 if ($caption->enumeration_is_chronology) {
607 # @chron_start and @chron_end will hold the (year, month, day) values
608 # represented by the start and optional end of the chronology instance.
609 # Default to January 1 with a year of 0 as initial values.
610 my @chron_start = (0, 1, 1);
611 my @chron_end = (0, 1, 1);
612 my @chrons = (\@chron_start, \@chron_end);
613 foreach my $key (@keys) {
614 my $capstr = $caption->capstr($key);
615 last if !defined($capstr);
616 if ($capstr =~ /year/) {
617 ($chron_start[0], $chron_end[0]) = @{$self->field_values($key)};
618 } elsif ($capstr =~ /month/) {
619 ($chron_start[1], $chron_end[1]) = @{$self->field_values($key)};
620 } elsif ($capstr =~ /day/) {
621 ($chron_start[2], $chron_end[2]) = @{$self->field_values($key)};
622 } elsif ($capstr =~ /season/) {
623 # chrons defined as season-only will use the astronomical season
624 # dates as a basic estimate.
625 my @seasons = @{$self->field_values($key)};
626 for (my $i = 0; $i < @seasons; $i++) {
627 $seasons[$i] = &_uncombine($seasons[$i], 0);
628 if ($seasons[$i] == 21) {
629 $chrons[$i]->[1] = 3;
630 $chrons[$i]->[2] = 20;
631 } elsif ($seasons[$i] == 22) {
632 $chrons[$i]->[1] = 6;
633 $chrons[$i]->[2] = 21;
634 } elsif ($seasons[$i] == 23) {
635 $chrons[$i]->[1] = 9;
636 $chrons[$i]->[2] = 22;
637 } elsif ($seasons[$i] == 24) {
638 $chrons[$i]->[1] = 12;
639 $chrons[$i]->[2] = 21;
646 foreach my $chron (@chrons) {
648 if ($chron->[0] != 0) {
650 &_uncombine($chron->[0], 0) . '-'
651 . sprintf('%02d', $chron->[1]) . '-'
652 . sprintf('%02d', $chron->[2]);
659 } elsif ($self->is_compressed) {
667 # utility function for uncombining instance parts
670 my ($combo, $pos) = @_;
673 carp("Function '_uncombine' is not an instance method");
677 my @parts = split('/', $combo);
682 # Overload string comparison operators
684 # We are not overloading '<=>' because '==' is used liberally in MARC::Record
685 # to compare field identity (i.e. is this the same exact Field object?), not value
687 # Other string operators are auto-generated from 'cmp'
689 # Please note that this comparison is based on what the holding represents,
690 # not whether it is strictly identical (e.g. the seqno and link may vary)
692 use overload ('cmp' => \&_compare,
695 my ($holding_1, $holding_2) = @_;
697 # TODO: this needs some more consideration
698 # fall back to 'built-in' comparison
699 if (!UNIVERSAL::isa($holding_2, ref $holding_1)) {
700 if (defined $holding_2) {
701 carp("Use of non-holding in holding comparison operation");
702 return ( "$holding_1" cmp "$holding_2" );
704 carp("Use of undefined value in holding comparison operation");
705 return 1; # similar to built-in, something is "greater than" nothing
709 # special cases for compressed holdings
710 my ($holding_1_first, $holding_1_last, $holding_2_first, $holding_2_last, $found_compressed);
711 # 0 for no compressed, 1 for first compressed, 2 for second compressed, 3 for both compressed
712 $found_compressed = 0;
713 if ($holding_1->is_compressed) {
714 $holding_1_last = $holding_1->clone->compressed_to_last;
715 $found_compressed += 1;
717 $holding_1_first = $holding_1;
718 $holding_1_last = $holding_1;
720 if ($holding_2->is_compressed) {
721 $holding_2_first = $holding_2->clone->compressed_to_first;
722 $found_compressed += 2;
724 $holding_2_first = $holding_2;
725 $holding_2_last = $holding_2;
728 if ($found_compressed) {
729 my $cmp = ($holding_1_last cmp $holding_2_first); # 1 ends before 2 starts
731 return -1; # 1 is fully lt
732 } elsif ($cmp == 0) {
733 carp("Overlapping holdings in comparison, lt and gt based on start value only");
735 } else { # check the opposite, 2 ends before 1 starts
736 # clone is expensive, wait until we need it (here)
737 if (!defined($holding_2_last)) {
738 $holding_2_last = $holding_2->clone->compressed_to_last;
740 if (!defined($holding_1_first)) {
741 $holding_1_first = $holding_1->clone->compressed_to_first;
743 $cmp = ($holding_2_last cmp $holding_1_first);
745 return 1; # 1 is fully gt
746 } elsif ($cmp == 0) {
747 carp("Overlapping holdings in comparison, lt and gt based on start value only");
750 $cmp = ($holding_1_first cmp $holding_2_first);
751 if (!$cmp) { # they are not equal
752 carp("Overlapping holdings in comparison, lt and gt based on start value only");
754 } elsif ($found_compressed == 1) {
755 carp("Compressed holding found with start equal to non-compressed holding");
756 return 1; # compressed (first holding) is 'greater than' non-compressed
757 } elsif ($found_compressed == 2) {
758 carp("Compressed holding found with start equal to non-compressed holding");
759 return -1; # compressed (second holding) is 'greater than' non-compressed
760 } else { # both holdings compressed, check for full equality
761 $cmp = ($holding_1_last cmp $holding_2_last);
762 if (!$cmp) { # they are not equal
763 carp("Compressed holdings in comparison have equal starts, lt and gt based on end value only");
766 return 0; # both are compressed, both ends are equal
773 # start doing the actual comparison
775 foreach my $key ('a'..'f') {
776 if (defined($holding_1->field_values($key))) {
777 if (!defined($holding_2->field_values($key))) {
778 return 1; # more details equals 'greater' (?)
780 $result = $holding_1->field_values($key)->[0] <=> $holding_2->field_values($key)->[0];
782 } elsif (defined($holding_2->field_values($key))) {
783 return -1; # more details equals 'greater' (?)
786 return $result if $result;
789 # got through, return 0 for equal