From 0cf78d716fd2a0affec424f65c29e7fa07b5b4a0 Mon Sep 17 00:00:00 2001 From: djfiander Date: Sun, 22 Nov 2009 00:37:42 +0000 Subject: [PATCH] CHANGES . Added support for compressed 863 holdings, including both structure and function . Added function to turn 863 chronologies into ISO datestrings (YYYY-MM-DD) . Employed the existing prediction logic to generate full prediction lists by way of an 863 increment method . Added necessary accessor and setter methods to reduce direct object attribute access . Renamed a few methods to better fit the expanded object interfaces . Cleaned up a few commented-out print-type debug statements . Other minor changes TODO . Switch to full POD-style inline documentation . Address various XXX and TODO comments here and there as needed . Further flesh out object interfaces as needed Developer's Certificate of Origin 1.1 By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the open source license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an appropriate open source license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same open source license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the open source license(s) involved. Signed-off-by: Dan Wells git-svn-id: svn://svn.open-ils.org/ILS/trunk@14997 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm | 90 ++++- .../src/perlmods/OpenILS/Utils/MFHD/Caption.pm | 54 +-- Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm | 1 + .../src/perlmods/OpenILS/Utils/MFHD/Holding.pm | 421 +++++++++++++++++---- .../src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t | 2 +- Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm | 6 +- 6 files changed, 473 insertions(+), 101 deletions(-) diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm index f329d7baf7..cf74a6171d 100755 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm @@ -1,11 +1,14 @@ package MFHD; use strict; +use warnings; use integer; use Carp; +use DateTime::Format::Strptime; use Data::Dumper; use base 'MARC::Record'; +# use OpenSRF::Utils::JSON; use OpenILS::Utils::MFHD::Caption; use OpenILS::Utils::MFHD::Holding; @@ -75,13 +78,48 @@ sub compressible { return $self->{_mfhd_COMPRESSIBLE}; } -sub captions { +sub caption_link_ids { my $self = shift; my $field = shift; return sort keys %{$self->{_mfhd_CAPTIONS}->{$field}}; } +sub captions { + my $self = shift; + my $field = shift; + + # TODO: add support for caption types as argument? (base, index, supplement) + my @captions; + my @sorted_ids = $self->caption_link_ids($field); + + foreach my $link_id (@sorted_ids) { + push(@captions, $self->{_mfhd_CAPTIONS}{$field}{$link_id}); + } + + return @captions; +} + +sub active_captions { + my $self = shift; + my $field = shift; + + # TODO: add support for caption types as argument? (base, index, supplement) + my @captions; + my @active_captions; + + @captions = $self->captions($field); + + # TODO: for now, we will assume the last 85X field is active + # and the rest are historical. The standard is hazy about + # how multiple active patterns of the same 85X type should be + # handled. We will, however, return as an array for future + # use. + push(@active_captions, $captions[-1]); + + return @active_captions; +} + sub holdings { my $self = shift; my $field = shift; @@ -92,4 +130,54 @@ sub holdings { values %{$self->{_mfhd_HOLDINGS}->{$field}->{$capid}}; } +sub generate_predictions { + my ($self, $options) = @_; + my $field = $options->{field}; + my $num_to_predict = $options->{num_to_predict}; + my $last_rec_date = + $options->{last_rec_date}; # expected or actual, according to preference + + # TODO: add support for predicting serials with no chronology by passing in + # a last_pub_date option? + + my $strp = new DateTime::Format::Strptime(pattern => '%F'); + + my $receival_date = $strp->parse_datetime($last_rec_date); + + my @active_captions = $self->active_captions($field); + + my @predictions; + foreach my $caption (@active_captions) { + my $htag = $caption->tag; + my $link_id = $caption->link_id; + $htag =~ s/^85/86/; + my @holdings = $self->holdings($htag, $link_id); + my $last_holding = $holdings[-1]; + + my $pub_date = $strp->parse_datetime($last_holding->chron_to_date); + my $date_diff = $receival_date - $pub_date; + + $last_holding->notes('public', []); + $last_holding->notes('private', ['AUTOGEN']); + + for (my $i = 0; $i < $num_to_predict; $i++) { + $last_holding->increment; + $pub_date = $strp->parse_datetime($last_holding->chron_to_date); + $pub_date = $pub_date + $date_diff; + push( + @predictions, + [ + $link_id, + $last_holding->format, + $pub_date->strftime('%F'), +# OpenSRF::Utils::JSON->perl2JSON( +# [$last_holding->subfields_list] +# ) + ] + ); + } + } + return @predictions; +} + 1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm index c7cbb26353..5255c0da78 100755 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm @@ -20,12 +20,13 @@ sub new { $self->{_mfhdc_PATTERN} = {}; $self->{_mfhdc_COPY} = undef; $self->{_mfhdc_UNIT} = undef; + $self->{_mfhdc_LINK_ID} = undef; $self->{_mfhdc_COMPRESSIBLE} = 1; # until proven otherwise foreach my $subfield ($self->subfields) { my ($key, $val) = @$subfield; if ($key eq '8') { - $self->{LINK} = $val; + $self->{_mfhdc_LINK_ID} = $val; } elsif ($key =~ /[a-h]/) { # Enumeration Captions $self->{_mfhdc_ENUMS}->{$key} = { @@ -175,6 +176,12 @@ sub type_of_unit { return $self->{_mfhdc_UNIT}; } +sub link_id { + my $self = shift; + + return $self->{_mfhdc_LINK_ID}; +} + sub calendar_change { my $self = shift; @@ -364,7 +371,7 @@ sub calendar_increment { return 0; } -sub next_date { +sub next_chron { my $self = shift; my $next = shift; my $carry = shift; @@ -427,8 +434,7 @@ sub next_date { # printf("# testing new candidate '%s' against '%s'\n", # join('/', @candidate), join('/', @new)); - if ( !defined($new[0]) - || !on_or_after(\@candidate, \@new)) { + if (!defined($new[0]) || !on_or_after(\@candidate, \@new)) { # first time through the loop # or @candidate is before @new => # @candidate is the next issue. @@ -458,13 +464,11 @@ sub next_date { # There was no suitable publication pattern defined, # so use the $w frequency to figure out the next date if (!defined($freq)) { - carp "Undefined frequency in next_date!"; + carp "Undefined frequency in next_chron!"; } elsif (!MFHD::Date::can_increment($freq)) { carp "Don't know how to deal with frequency '$freq'!"; } else { - # # One of the standard defined issue frequencies - # @new = MFHD::Date::incr_date($freq, @cur); while ($self->is_omitted(@new)) { @@ -484,7 +488,7 @@ sub next_date { for my $i (0..$#new) { $next->{$keys[$i]} = $new[$i]; } - # Figure out if we need to adust volume number + # Figure out if we need to adjust volume number # right now just use the $carry that was passed in. # in long run, need to base this on ($carry or date_change) if ($carry) { @@ -620,7 +624,7 @@ sub next_enum { } else { # No enumeration publication pattern specified for this level, - # just keed adding one. + # just keep adding one. if (!$self->capstr($key)) { # Just assume that it increments continuously and give up @@ -669,7 +673,7 @@ sub next_enum { } else { # Figure out date of next issue, then decide if we need # to adjust top level enumeration based on that - $self->next_date($next, $carry, ('i'..'m')); + $self->next_chron($next, $carry, ('i'..'m')); } } @@ -680,25 +684,23 @@ sub next { # Initialize $next with current enumeration & chronology, then # we can just operate on $next, based on the contents of the caption - - if ($self->enumeration_is_chronology) { - foreach my $key ('a'..'h') { - $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key} - if defined $holding->{_mfhdh_SUBFIELDS}->{$key}; + foreach my $key ('a'..'m') { + my $holding_values = $holding->field_values($key); + my $index; + if ($holding->is_compressed) { + return undef + if $holding->is_open_ended; + # TODO: error on next for open-ended holdings? + $index = 1; + } else { + $index = 0; } - $self->next_date($next, 0, ('a'..'h')); - - return $next; + $next->{$key} = ${$holding_values}[$index] if defined $holding_values; } - foreach my $key ('a'..'h') { - $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS} - if defined $holding->{_mfhdh_SUBFIELDS}->{$key}; - } - - foreach my $key ('i'..'m') { - $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key} - if defined $holding->{_mfhdh_SUBFIELDS}->{$key}; + if ($self->enumeration_is_chronology) { + $self->next_chron($next, 0, ('a'..'h')); + return $next; } if (exists $next->{'h'}) { diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm index 65b9695f96..34c85d9691 100644 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm @@ -523,6 +523,7 @@ sub can_increment { return exists $increments{$freq}; } +# TODO: add support for weeks as chron level? sub incr_date { my $freq = shift; my $incr = $increments{$freq}; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm index 4d6f61e75a..9405d20d6d 100755 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm @@ -1,10 +1,15 @@ +# MFHD::Holding provides some additional holdings logic to a MARC::Field +# object. In its current state it is primarily read-only, as direct changes +# to the underlying MARC::Field are not reflected in the MFHD logic layer, and +# only the 'increment', 'notes', and 'seqno' methods do updates to the +# MARC::Field layer. + package MFHD::Holding; use strict; use integer; -use Carp; +use Carp; use DateTime; - use Data::Dumper; use base 'MARC::Field'; @@ -17,32 +22,36 @@ sub new { my $caption = shift; my $last_enum = undef; - $self->{_mfhdh_SEQNO} = $seqno; - $self->{_mfhdh_CAPTION} = $caption; - $self->{_mfhdh_DESCR} = {}; - $self->{_mfhdh_COPY} = undef; - $self->{_mfhdh_BREAK} = undef; - $self->{_mfhdh_NOTES} = {}; - $self->{_mfhdh_COPYRIGHT} = []; + $self->{_mfhdh_SEQNO} = $seqno; + $self->{_mfhdh_CAPTION} = $caption; + $self->{_mfhdh_DESCR} = {}; + $self->{_mfhdh_COPY} = undef; + $self->{_mfhdh_BREAK} = undef; + $self->{_mfhdh_NOTES} = {}; + $self->{_mfhdh_NOTES}{public} = []; + $self->{_mfhdh_NOTES}{private} = []; + $self->{_mfhdh_COPYRIGHT} = []; + $self->{_mfhdh_COMPRESSED} = $self->indicator(2) eq '0' ? 1 : 0; + $self->{_mfhdh_OPEN_ENDED} = 0; foreach my $subfield ($self->subfields) { my ($key, $val) = @$subfield; - if (($caption && $caption->enumeration_is_chronology && $key =~ /[a-h]/) - || $key =~ /[i-m]/) { - # Chronology - $self->{_mfhdh_SUBFIELDS}->{$key} = $val; - } elsif ($key =~ /[a-h]/) { - # Enumeration details of holdings - $self->{_mfhdh_SUBFIELDS}->{$key} = { - HOLDINGS => $val, - UNIT => undef, - }; - $last_enum = $key; + if ($key =~ /[a-m]/) { + if ($self->{_mfhdh_COMPRESSED}) { + $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [split(/\-/, $val)]; + } else { + $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [$val]; + } + if ($key =~ /[a-h]/) { + # Enumeration specific details of holdings + $self->{_mfhdh_FIELDS}->{$key}{UNIT} = undef; + $last_enum = $key; + } } elsif ($key eq 'o') { warn '$o specified prior to first enumeration' unless defined($last_enum); - $self->{_mfhdh_SUBFIELDS}->{$last_enum}->{UNIT} = $val; + $self->{_mfhdh_FIELDS}->{$last_enum}->{UNIT} = $val; $last_enum = undef; } elsif ($key =~ /[npq]/) { $self->{_mfhdh_DESCR}->{$key} = $val; @@ -54,31 +63,146 @@ sub new { carp "Unrecognized break indicator '$val'" unless $val =~ /^[gn]$/; $self->{_mfhdh_BREAK} = $val; + } elsif ($key eq 'x') { + push @{$self->{_mfhdh_NOTES}{private}}, $val; + } elsif ($key eq 'z') { + push @{$self->{_mfhdh_NOTES}{public}}, $val; } } + if ( $self->{_mfhdh_COMPRESSED} + && $self->{_mfhdh_FIELDS}{'a'}{HOLDINGS}[1] eq '') { + $self->{_mfhdh_OPEN_ENDED} = 1; + } bless($self, $class); return $self; } +# +# accessor to the object's field hash +# +# We are avoiding calling these elements 'subfields' because they are more +# than simply the MARC subfields, although in the current implementation they +# are indexed on the subfield key +# +sub fields { + my $self = shift; + + return $self->{_mfhdh_FIELDS}; +} + +# +# Given a field key, returns an array ref of one (for single statements) +# or two (for compressed statements) values +# +sub field_values { + my ($self, $key) = @_; + + if (exists $self->fields->{$key}) { + my @values = @{$self->fields->{$key}{HOLDINGS}}; + return \@values; + } else { + return undef; + } +} + sub seqno { my $self = shift; + if (@_) { + $self->{_mfhdh_SEQNO} = $_[0]; + $self->update(8 => $self->caption->link_id . '.' . $_[0]); + } + return $self->{_mfhdh_SEQNO}; } +sub is_compressed { + my $self = shift; + + return $self->{_mfhdh_COMPRESSED}; +} + +sub is_open_ended { + my $self = shift; + + return $self->{_mfhdh_OPEN_ENDED}; +} + sub caption { my $self = shift; return $self->{_mfhdh_CAPTION}; } +sub notes { + my $self = shift; + my $type = shift; + my @notes = @_; + + if (!$type) { + $type = 'public'; + } elsif ($type ne 'public' && $type ne 'private') { + carp("Notes being applied without specifiying type"); + unshift(@notes, $type); + $type = 'public'; + } + + if (ref($notes[0])) { + $self->{_mfhdh_NOTES}{$type} = $notes[0]; + $self->_replace_note_subfields($type, @{$notes[0]}); + } elsif (@notes) { + if ($notes[0]) { + $self->{_mfhdh_NOTES}{$type} = \@notes; + } else { + $self->{_mfhdh_NOTES}{$type} = []; + } + $self->_replace_note_subfields($type, @notes); + } + + return $self->{_mfhdh_NOTES}{$type}; +} + +# +# utility function for 'notes' method +# +sub _replace_note_subfields { + my $self = shift; + my $type = shift; + my @notes = @_; + my %note_subfield_ids = ('public' => 'z', 'private' => 'x'); + + $self->delete_subfield(code => $note_subfield_ids{$type}); + + foreach my $note (@notes) { + $self->add_subfields($note_subfield_ids{$type} => $note); + } +} + +# +# return a simple subfields list (for easier revivification from database) +# +sub subfields_list { + my $self = shift; + my @subfields; + + foreach my $subfield ($self->subfields) { + push(@subfields, $subfield->[0], $subfield->[1]); + } + return @subfields; +} + +# +# Called by method 'format_part' for formatting the chronology portion of +# the holding statement +# sub format_chron { - my $self = shift; - my $caption = $self->{_mfhdh_CAPTION}; - my @keys; - my $str = ''; - my %month = ( + my $self = shift; + my $holdings = shift; + my $caption = $self->caption; + my @keys = @_; + my $str = ''; + my %month = ( '01' => 'Jan.', '02' => 'Feb.', '03' => 'Mar.', @@ -97,7 +221,6 @@ sub format_chron { '24' => 'Winter' ); - @keys = @_; foreach my $i (0..@keys) { my $key = $keys[$i]; my $capstr; @@ -115,10 +238,15 @@ sub format_chron { # If this is the second level of chronology, then it's # likely to be a month or season, so we should use the # string name rather than the number given. - if (($i == 1) && exists $month{$self->{_mfhdh_SUBFIELDS}->{$key}}) { - $chron = $month{$self->{_mfhdh_SUBFIELDS}->{$key}}; + if (($i == 1)) { + # account for possible combined issue chronology + my @chron_parts = split('/', $holdings->{$key}); + for (my $i = 0; $i < @chron_parts; $i++) { + $chron_parts[$i] = $month{$chron_parts[$i]}; + } + $chron = join('/', @chron_parts); } else { - $chron = $self->{_mfhdh_SUBFIELDS}->{$key}; + $chron = $holdings->{$key}; } $str .= (($i == 0 || $str =~ /[. ]$/) ? '' : ':') . $capstr . $chron; @@ -127,10 +255,14 @@ sub format_chron { return $str; } -sub format { - my $self = shift; - my $caption = $self->{_mfhdh_CAPTION}; - my $str = ''; +# +# Called by method 'format' for each member of a possibly compressed holding +# +sub format_part { + my $self = shift; + my $holding_values = shift; + my $caption = $self->caption; + my $str = ''; if ($caption->type_of_unit) { $str = $caption->type_of_unit . ' '; @@ -140,7 +272,7 @@ sub format { # if issues are identified by chronology only, then the # chronology data is stored in the enumeration subfields, # so format those fields as if they were chronological. - $str = $self->format_chron('a'..'f'); + $str = $self->format_chron($holding_values, 'a'..'f'); } else { # OK, there is enumeration data and maybe chronology # data as well, format both parts appropriately @@ -159,15 +291,13 @@ sub format { $capstr = ''; } $str .= - ($key eq 'a' ? '' : ':') - . $capstr - . $self->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS}; + ($key eq 'a' ? '' : ':') . $capstr . $holding_values->{$key}; } # Chronology if (defined $caption->capstr('i')) { $str .= '('; - $str .= $self->format_chron('i'..'l'); + $str .= $self->format_chron($holding_values, 'i'..'l'); $str .= ')'; } @@ -178,7 +308,7 @@ sub format { $str .= ($key eq 'g' ? '' : ':') . $caption->capstr($key) - . $self->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS}; + . $holding_values->{$key}; } # This assumes that alternative chronology is only ever @@ -186,17 +316,12 @@ sub format { if ($caption->capstr('m')) { # Alternative Chronology $str .= '('; - $str .= - $caption->capstr('m') - . $self->{_mfhdh_SUBFIELDS}->{m}->{HOLDINGS}; + $str .= $caption->capstr('m') . $holding_values->{'m'}; $str .= ')'; } } } - # Public Note - $str .= ' ' . $caption->capstr('z') if (defined $caption->capstr('z')); - # Breaks in the sequence if (defined($self->{_mfhdh_BREAK})) { if ($self->{_mfhdh_BREAK} eq 'n') { @@ -211,46 +336,75 @@ sub format { return $str; } +# +# Create and return a string which conforms to display standard Z39.71 +# +sub format { + my $self = shift; + my $subfields = $self->fields; + my %holding_start; + my %holding_end; + my $formatted; + + foreach my $key (keys %$subfields) { + ($holding_start{$key}, $holding_end{$key}) = + @{$self->field_values($key)}; + } + + if ($self->is_compressed) { + # deal with open-ended statements + my $formatted_end; + if ($self->is_open_ended) { + $formatted_end = ''; + } else { + $formatted_end = $self->format_part(\%holding_end); + } + $formatted = + $self->format_part(\%holding_start) . ' - ' . $formatted_end; + } else { + $formatted = $self->format_part(\%holding_start); + } + + # Public Note + if (@{$self->notes}) { + $formatted .= ' Note: ' . join(', ', @{$self->notes}); + } + + return $formatted; +} + # next: Given a holding statement, return a hash containing the # enumeration values for the next issues, whether we hold it or not # Just pass through to Caption::next # sub next { my $self = shift; - my $caption = $self->{_mfhdh_CAPTION}; + my $caption = $self->caption; return $caption->next($self); } -# match($pat): check to see if $self matches the enumeration passed -# in as $pat. This is expected to be used in conjunction with the next() -# function defined above. # +# matches($pat): check to see if $self matches the enumeration hashref passed +# in as $pat, as returned by the 'next' method. e.g.: +# $holding2->matches($holding1->next) # true if $holding2 directly follows +# $holding1 # +# Always returns false if $self is compressed # -sub match { - my $self = shift; - my $pat = shift; - my $caption = $self->{_mfhdh_CAPTION}; - - foreach my $key ('a'..'f') { - my $nextkey; +sub matches { + my $self = shift; + my $pat = shift; - ($nextkey = $key)++; - # If the next smaller enumeration exists, and is numbered - # continuously, then we don't need to check this one, because - # gaps in issue numbering matter, not changes in volume numbering - next - if (exists $self->{_mfhdh_SUBFIELDS}->{$nextkey} - && !$caption->capfield($nextkey)->{RESTART}); + return 0 if $self->is_compressed; + foreach my $key ('a'..'f') { # If a subfield exists in $self but not in $pat, or vice versa # or if the field has different values, then fail if ( - exists($self->{_mfhdh_SUBFIELDS}->{$key}) != exists($pat->{$key}) + defined($self->field_values($key)) != exists($pat->{$key}) || (exists $pat->{$key} - && ($self->{_mfhdh_SUBFIELDS}->{$key}->{HOLDINGS} ne - $pat->{$key})) + && ($self->field_values($key)->[0] ne $pat->{$key})) ) { return 0; } @@ -265,12 +419,139 @@ sub match { sub validate { my $self = shift; - foreach my $key (keys %{$self->{_mfhdh_SUBFIELDS}}) { - if ( !$self->{_mfhdh_CAPTION} - || !$self->{_mfhdh_CAPTION}->capfield($key)) { + foreach my $key (keys %{$self->fields}) { + if (!$self->caption || !$self->caption->capfield($key)) { return 0; } } return 1; } + +# +# Replace a single holding with it's next prediction +# and return itself +# +# If the holding is compressed, the range is expanded +# +sub increment { + my $self = shift; + + my $next = $self->next(); + + if ($self->is_compressed) { # expand range + foreach my $key (keys %{$next}) { + my @values = @{$self->field_values($key)}; + $values[1] = $next->{$key}; + $self->fields->{$key}{HOLDINGS} = \@values; + $next->{$key} = join('-', @values); + } + } else { + foreach my $key (keys %{$next}) { + $self->fields->{$key}{HOLDINGS}[0] = $next->{$key}; + } + } + + $self->seqno($self->seqno + 1); + $self->update(%{$next}); # update underlying subfields + return $self; +} + +# +# Basic, working, unoptimized clone operation +# +sub clone { + my $self = shift; + + my $clone_field = $self->SUPER::clone(); + return new MFHD::Holding($self->seqno, $clone_field, $self->caption); +} + +# +# Turn a chronology instance into date(s) in YYYY-MM-DD format +# +# In list context it returns a list of start and (possibly undefined) +# end dates +# +# In scalar context, it returns a YYYY-MM-DD date string of either the +# single date or the (possibly undefined) end date of a compressed holding +# +sub chron_to_date { + my $self = shift; + my $caption = $self->caption; + + my @keys; + if ($caption->enumeration_is_chronology) { + @keys = ('a'..'f'); + } else { + @keys = ('i'..'m'); + } + + my @chron_start = (0, 1, 1); + my @chron_end = (0, 1, 1); + my @chrons = (\@chron_start, \@chron_end); + foreach my $key (@keys) { + my $capstr = $caption->capstr($key); + last if !defined($capstr); + if ($capstr =~ /year/) { + ($chron_start[0], $chron_end[0]) = @{$self->field_values($key)}; + } elsif ($capstr =~ /month/) { + ($chron_start[1], $chron_end[1]) = @{$self->field_values($key)}; + } elsif ($capstr =~ /day/) { + ($chron_start[2], $chron_end[2]) = @{$self->field_values($key)}; + } elsif ($capstr =~ /season/) { + my @seasons = @{$self->field_values($key)}; + for (my $i = 0; $i < @seasons; $i++) { + $seasons[$i] = &_uncombine($seasons[$i], 0); + if ($seasons[$i] == 21) { + $chrons[$i]->[1] = 3; + $chrons[$i]->[2] = 20; + } elsif ($seasons[$i] == 22) { + $chrons[$i]->[1] = 6; + $chrons[$i]->[2] = 21; + } elsif ($seasons[$i] == 23) { + $chrons[$i]->[1] = 9; + $chrons[$i]->[2] = 22; + } elsif ($seasons[$i] == 24) { + $chrons[$i]->[1] = 12; + $chrons[$i]->[2] = 21; + } + } + } + } + + my @dates; + foreach my $chron (@chrons) { + my $date = undef; + if ($chron->[0] != 0) { + $date = + &_uncombine($chron->[0], 0) . '-' + . sprintf('%02d', $chron->[1]) . '-' + . sprintf('%02d', $chron->[2]); + } + push(@dates, $date); + } + + if (wantarray()) { + return @dates; + } elsif ($self->is_compressed) { + return $dates[1]; + } else { + return $dates[0]; + } +} + +# +# utility function for uncombining instance parts +# +sub _uncombine { + my ($combo, $pos) = @_; + + if (ref($combo)) { + carp("Function 'uncombine' is not an instance method"); + return; + } + + my @parts = split('/', $combo); + return $parts[$pos]; +} 1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t index 8bbf93dd62..2d5ebe63b1 100644 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t @@ -53,7 +53,7 @@ sub load_MARC_rec { return $marc if $line =~ /^\s*$/; my ($fieldno, $indicators, $rest) = split(/ /, $line, 3); - my @inds = unpack('cc', $indicators); + my @inds = unpack('aa', $indicators); my $field; my @subfields; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm index 374a85ebaf..32957eefb9 100644 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm @@ -128,7 +128,7 @@ sub mfhd_to_hash { } } - foreach my $cap_id ($mfhd->captions('853')) { + foreach my $cap_id ($mfhd->caption_link_ids('853')) { my @curr_holdings = $mfhd->holdings('863', $cap_id); next unless scalar @curr_holdings; foreach (@curr_holdings) { @@ -136,7 +136,7 @@ sub mfhd_to_hash { } } - foreach my $cap_id ($mfhd->captions('854')) { + foreach my $cap_id ($mfhd->caption_link_ids('854')) { my @curr_supplements = $mfhd->holdings('864', $cap_id); next unless scalar @curr_supplements; foreach (@curr_supplements) { @@ -144,7 +144,7 @@ sub mfhd_to_hash { } } - foreach my $cap_id ($mfhd->captions('855')) { + foreach my $cap_id ($mfhd->caption_link_ids('855')) { my @curr_indexes = $mfhd->holdings('865', $cap_id); next unless scalar @curr_indexes; foreach (@curr_indexes) { -- 2.11.0