[open-ils-commits] r11732 - trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD
svn at svn.open-ils.org
svn at svn.open-ils.org
Fri Jan 2 15:51:36 EST 2009
Author: djfiander
Date: 2009-01-02 15:51:33 -0500 (Fri, 02 Jan 2009)
New Revision: 11732
Modified:
trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm
Log:
Beginnings of calculating date of next issue.
Modified: trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm
===================================================================
--- trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm 2009-01-02 20:38:51 UTC (rev 11731)
+++ trunk/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm 2009-01-02 20:51:33 UTC (rev 11732)
@@ -3,6 +3,8 @@
use integer;
use Carp;
+use DateTime;
+
use Data::Dumper;
use MARC::Record;
@@ -19,8 +21,7 @@
$self->{SEQNO} = $seqno;
$self->{HOLDING} = $holding;
$self->{CAPTION} = $caption;
- $self->{ENUMS} = {};
- $self->{CHRON} = {};
+ $self->{SUBFIELDS} = {};
$self->{DESCR} = {};
$self->{COPY} = undef;
$self->{BREAK} = undef;
@@ -31,18 +32,18 @@
my ($key, $val) = @$subfield;
if ($key =~ /[a-h]/) {
# Enumeration details of holdings
- $self->{ENUMS}->{$key} = {HOLDINGS => $val,
+ $self->{SUBFIELDS}->{$key} = {HOLDINGS => $val,
UNIT => undef,};
$last_enum = $key;
} elsif ($key =~ /[i-m]/) {
- $self->{CHRON}->{$key} = $val;
+ $self->{SUBFIELDS}->{$key} = $val;
if (!exists $caption->{CHRONS}->{$key}) {
warn "Holding '$seqno' specified enumeration level '$key' not included in caption $caption->{LINK}";
}
} elsif ($key eq 'o') {
warn '$o specified prior to first enumeration'
unless defined($last_enum);
- $self->{ENUMS}->{$last_enum}->{UNIT} = $val;
+ $self->{SUBFIELDS}->{$last_enum}->{UNIT} = $val;
$last_enum = undef;
} elsif ($key =~ /[npq]/) {
$self->{DESCR}->{$key} = $val;
@@ -72,6 +73,12 @@
'10' => 'Oct.', '11' => 'Nov.', '12' => 'Dec.',
'21' => 'Spring', '22' => 'Summer',
'23' => 'Autumn', '24' => 'Winter' );
+ my %month = ( '01' => 'Jan.', '02' => 'Feb.', '03' => 'Mar.',
+ '04' => 'Apr.', '05' => 'May ', '06' => 'Jun.',
+ '07' => 'Jul.', '08' => 'Aug.', '09' => 'Sep.',
+ '10' => 'Oct.', '11' => 'Nov.', '12' => 'Dec.',
+ '21' => 'Spring', '22' => 'Summer',
+ '23' => 'Autumn', '24' => 'Winter' );
@keys = @_;
foreach my $i (0 .. @keys) {
@@ -91,10 +98,10 @@
# 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->{CHRON}->{$key}}) {
- $chron = $month{$self->{CHRON}->{$key}};
+ if (($i == 1) && exists $month{$self->{SUBFIELDS}->{$key}}) {
+ $chron = $month{$self->{SUBFIELDS}->{$key}};
} else {
- $chron = $self->{CHRON}->{$key};
+ $chron = $self->{SUBFIELDS}->{$key};
}
@@ -121,6 +128,8 @@
# Enumerations
foreach my $key ('a'..'f') {
my $capstr;
+ my $chron;
+ my $sep;
last if !defined $caption->caption($key);
@@ -131,7 +140,7 @@
# a caption enclosed in parentheses is not displayed
$capstr = '';
}
- $str .= ($key eq 'a' ? "" : ':') . $capstr . $self->{ENUMS}->{$key}->{HOLDINGS};
+ $str .= ($key eq 'a' ? "" : ':') . $capstr . $self->{SUBFIELDS}->{$key}->{HOLDINGS};
}
# Chronology
@@ -145,7 +154,7 @@
# There's at least one level of alternative enumeration
$str .= '=';
foreach my $key ('g', 'h') {
- $str .= ($key eq 'g' ? '' : ':') . $caption->caption($key) . $self->{ENUMS}->{$key}->{HOLDINGS};
+ $str .= ($key eq 'g' ? '' : ':') . $caption->caption($key) . $self->{SUBFIELDS}->{$key}->{HOLDINGS};
}
# This assumes that alternative chronology is only ever
@@ -153,7 +162,7 @@
if (exists $caption->{CHRONS}->{m}) {
# Alternative Chronology
$str .= '(';
- $str .= $caption->caption('m') . $self->{ENUMS}->{m}->{HOLDINGS};
+ $str .= $caption->caption('m') . $self->{SUBFIELDS}->{m}->{HOLDINGS};
$str .= ')';
}
}
@@ -174,12 +183,102 @@
return $str;
}
+my %increments = {
+ a => {years => 1}, # annual
+ b => {months => 2}, # bimonthly
+ c => {days => 3}, # semiweekly
+ d => {days => 1}, # daily
+ e => {weeks => 2}, # biweekly
+ f => {months => 6}, # semiannual
+ g => {years => 2}, # biennial
+ h => {years => 3}, # triennial
+ i => {days => 2}, # three times / week
+ j => {days => 10}, # three times /month
+ # k => continuous
+ m => {months => 1}, # monthly
+ q => {months => 3}, # quarterly
+ s => {days => 15}, # semimonthly
+ t => {months => 4}, # three times / year
+ w => {weeks => 1}, # weekly
+ # x => completely irregular
+};
+
sub next_date {
my $self = shift;
my $next = shift;
my @keys = @_;
+ my @cur;
+ my @new;
+ my $incr;
my $caption = $self->{CAPTION};
+ my $pattern = $caption->{PATTERN};
+ my $frequency = $pattern->{w};
+
+ warn "I can't deal with publication patterns yet!" if exists $pattern->{y};
+
+# print Dumper(@keys);
+# print Dumper($self);
+
+ foreach my $i (0.. at keys) {
+ $new[$i] = $cur[$i] = $self->{SUBFIELDS}->{$keys[$i]}
+ if exists $self->{SUBFIELDS}->{$keys[$i]};
+ }
+
+ if (defined $frequency) {
+ $incr = $increments{$frequency};
+ }
+
+ if (scalar(@cur) == 1) {
+ # only a year is specified. Next date is easy
+ $new[0] += $incr->{years} || 1;
+ } elsif (scalar(@cur) == 2) {
+ # Year and month or season
+ if ($new[1] > 20) {
+ # season
+ $new[1] += ($incr->{months}/3) || 1;
+ if ($new[1] > 24) {
+ # carry
+ $new[0] += 1;
+ $new[1] -= 24;
+ }
+ } else {
+ # month
+ $new[1] += $incr->{months} || 1;
+ if ($new[1] > 12) {
+ # carry
+ $new[0] += 1;
+ $new[1] -= 12;
+ }
+ }
+ } elsif (scalar(@cur) == 3) {
+ # Year, Month, Day: now it gets complicated.
+
+ if ($new[2] =~ /^[0-9]+$/) {
+ # A single number for the day of month, relatively simple
+ my $dt = DateTime->new(year => $new[0],
+ month=> $new[1],
+ day => $new[2]);
+ $dt->add(%{$incr});
+ $new[0] = $dt->year;
+ $new[1] = $dt->month;
+ $new[2] = $dt->day;
+ } elsif ($new[2] =~ /^([0-9]+)\/([0-9]+)/) {
+ my $sdt = DateTime->new(year => $new[0],
+ month=> $new[1],
+ day => $1);
+ my $edt = DateTime->new(year => $new[0],
+ month=> $new[1],
+ day => $2);
+ $sdt->add(%{$incr});
+ $edt->add(%{$incr});
+ $new[0] = $sdt->year;
+ $new[1] = $sdt->month;
+ $new[2] = $sdt->day . '/' . $edt->day;
+ } else {
+ warn "I don't know how to deal with '$new[2]'";
+ }
+ }
}
@@ -195,17 +294,17 @@
# Initialize $next with current enumeration & chronology, then
# we can just operate on $next, based on the contents of the caption
foreach my $key ('a' .. 'h') {
- $next->{$key} = $self->{ENUMS}->{$key}->{HOLDINGS}
- if exists $self->{ENUMS}->{$key};
+ $next->{$key} = $self->{SUBFIELDS}->{$key}->{HOLDINGS}
+ if exists $self->{SUBFIELDS}->{$key};
}
foreach my $key ('i'..'m') {
- $next->{$key} = $self->{CHRON}->{$key}
- if exists $self->{CHRON}->{$key};
+ $next->{$key} = $self->{SUBFIELDS}->{$key}
+ if exists $self->{SUBFIELDS}->{$key};
}
if ($caption->enumeration_is_chronology) {
- $self->next_date($caption, $next, ('a'..'h'));
+ $self->next_date($next, ('a'..'h'));
} else {
# First handle any "alternative enumeration", since they're
# a lot simpler, and don't depend on the the calendar
@@ -278,10 +377,23 @@
} else {
# Figure out date of next issue, then decide if we need
# to adjust top level enumeration based on that
- $self->next_date($caption, $next, ('i'..'m'));
+ $self->next_date($next, ('i'..'m'));
}
}
+ # The easy part is done. There are two things left to do:
+ # 1) Calculate the date of the next issue, if necessary
+ # 2) Increment the highest level of enumeration (either by date
+ # or because $carry is set because of the above loop
+
+ if (!%{$caption->{CHRONS}}) {
+ # The simple case: if there is no chronology specified
+ # then just check $carry and return
+ $next->{'a'} += $carry;
+ } else {
+ # Complicated: figure out date of next issue
+ }
+
return($next);
}
@@ -303,14 +415,14 @@
# 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->{ENUMS}->{$nextkey}
+ next if (exists $self->{SUBFIELDS}->{$nextkey}
&& !$caption->{ENUMS}->{$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->{ENUMS}->{$key}) != exists($pat->{$key})
+ if (exists($self->{SUBFIELDS}->{$key}) != exists($pat->{$key})
|| (exists $pat->{$key}
- && ($self->{ENUMS}->{$key}->{HOLDINGS} ne $pat->{$key}))) {
+ && ($self->{SUBFIELDS}->{$key}->{HOLDINGS} ne $pat->{$key}))) {
return 0;
}
}
@@ -324,7 +436,7 @@
sub validate {
my $self = shift;
- foreach my $key (keys %{$self->{ENUMS}}) {
+ foreach my $key (keys %{$self->{SUBFIELDS}}) {
if (!exists $self->{CAPTION}->{ENUMS}->{$key}) {
return 0;
}
More information about the open-ils-commits
mailing list