[open-ils-commits] r14997 - in trunk/Open-ILS/src/perlmods/OpenILS/Utils: . MFHD MFHD/test (djfiander)
svn at svn.open-ils.org
svn at svn.open-ils.org
Sat Nov 21 19:37:43 EST 2009
Author: djfiander
Date: 2009-11-21 19:37:42 -0500 (Sat, 21 Nov 2009)
New Revision: 14997
Modified:
trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm
trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t
trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm
Log:
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 <dbw2 at calvin.edu>
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm 2009-11-20 22:07:26 UTC (rev 14996)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm 2009-11-22 00:37:42 UTC (rev 14997)
@@ -20,12 +20,13 @@
$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 @@
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 @@
return 0;
}
-sub next_date {
+sub next_chron {
my $self = shift;
my $next = shift;
my $carry = shift;
@@ -427,8 +434,7 @@
# 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 @@
# 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 @@
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 @@
} 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 @@
} 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,27 +684,25 @@
# Initialize $next with current enumeration & chronology, then
# we can just operate on $next, based on the contents of the caption
+ 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;
+ }
+ $next->{$key} = ${$holding_values}[$index] if defined $holding_values;
+ }
if ($self->enumeration_is_chronology) {
- foreach my $key ('a'..'h') {
- $next->{$key} = $holding->{_mfhdh_SUBFIELDS}->{$key}
- if defined $holding->{_mfhdh_SUBFIELDS}->{$key};
- }
- $self->next_date($next, 0, ('a'..'h'));
-
+ $self->next_chron($next, 0, ('a'..'h'));
return $next;
}
- 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 (exists $next->{'h'}) {
$self->next_alt_enum($next);
}
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm 2009-11-20 22:07:26 UTC (rev 14996)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Date.pm 2009-11-22 00:37:42 UTC (rev 14997)
@@ -523,6 +523,7 @@
return exists $increments{$freq};
}
+# TODO: add support for weeks as chron level?
sub incr_date {
my $freq = shift;
my $incr = $increments{$freq};
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm 2009-11-20 22:07:26 UTC (rev 14996)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm 2009-11-22 00:37:42 UTC (rev 14997)
@@ -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 DateTime;
-
use Data::Dumper;
use base 'MARC::Field';
@@ -17,32 +22,36 @@
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 @@
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 @@
'24' => 'Winter'
);
- @keys = @_;
foreach my $i (0.. at keys) {
my $key = $keys[$i];
my $capstr;
@@ -115,10 +238,15 @@
# 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 @@
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 @@
# 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 @@
$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 @@
$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 @@
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 @@
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};
+sub matches {
+ my $self = shift;
+ my $pat = shift;
+ return 0 if $self->is_compressed;
+
foreach my $key ('a'..'f') {
- my $nextkey;
-
- ($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});
-
# 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 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;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t 2009-11-20 22:07:26 UTC (rev 14996)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t 2009-11-22 00:37:42 UTC (rev 14997)
@@ -53,7 +53,7 @@
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;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm 2009-11-20 22:07:26 UTC (rev 14996)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD.pm 2009-11-22 00:37:42 UTC (rev 14997)
@@ -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 @@
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 @@
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;
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm 2009-11-20 22:07:26 UTC (rev 14996)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHDParser.pm 2009-11-22 00:37:42 UTC (rev 14997)
@@ -128,7 +128,7 @@
}
}
- 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 @@
}
}
- 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 @@
}
}
- 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) {
More information about the open-ils-commits
mailing list