From: djfiander Date: Tue, 10 Feb 2009 02:52:54 +0000 (+0000) Subject: A bunch of untested code to support serials predictions X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=394a2037d2c813d4b84d1bb3387f79c6f2fc8c88;p=Evergreen.git A bunch of untested code to support serials predictions git-svn-id: svn://svn.open-ils.org/ILS/trunk@12124 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm index b2f52bc584..353e4e2d25 100755 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm @@ -3,6 +3,7 @@ use strict; use integer; use Carp; +use DateTime; use MARC::Record; sub new @@ -97,6 +98,8 @@ sub new sub decode_pattern { my $self = shift; my $pattern = $self->{PATTERN}->{y}; + + # XXX WRITE ME (?) } sub compressible { @@ -149,4 +152,215 @@ sub enumeration_is_chronology { return (exists $self->{PATTERN}->{w} && exists $self->{PATTERN}->{y}); } +my %daynames = ( + 'mo' => 1, + 'tu' => 2, + 'we' => 3, + 'th' => 4, + 'fr' => 5, + 'sa' => 6, + 'su' => 7, + ); + +my $daypat = '(mo|tu|we|th|fr|sa|su)'; +my $weekpat = '(99|98|97|00|01|02|03|04|05)'; +my $weeknopat; +my $monthpat = '(01|02|03|04|05|06|07|08|09|10|11|12)'; +my $seasonpat = '(21|22|23|24)'; + +# Initialize $weeknopat to be '(01|02|03|...|51|52|53)' +$weeknopat = '('; +foreach my $weekno (1..52) { + $weeknopat .= sprintf("%02d|", $weekno); +} +$weeknopat .= '53)'; + +sub match_day { + my $pat = shift; + my @date = @_; + # Translate daynames into day of week for DateTime + # also used to check if dayname is valid. + + if (exists $daynames{$pat}) { + # dd + # figure out day of week for date and compare + my $dt = DateTime->new(year => $date[0], + month => $date[1], + day => $date[2]); + return ($dt->day_of_week == $daynames{$pat}); + } elsif (length($pat) == 2) { + # MM + return $pat == $date[3]; + } elsif (length($pat) == 4) { + # MMDD + my ($mon, $day); + $mon = substr($pat, 0, 2); + $day = substr($pat, 2, 2); + + return (($mon == $date[1]) && ($day == $date[2])); + } else { + carp "Invalid day pattern '$pat'"; + return 0; + } +} + +# Calcuate date of "n"th last "dayname" of month: second last Tuesday +sub last_week_of_month { + my $dt = shift; + my $week = shift; + my $day = shift; + my $end_dt = DateTime->last_day_of_month(year => $dt->year, + month => $dt->month); + + $day = $daynames{$day}; + while ($end_dt->day_of_week != $day) { + $end_dt->subtract(days => 1); + } + + # 99: last week of month, 98: second last, etc. + for (my $i = 99 - $week; $i > 0; $i--) { + $end_dt->subtract(weeks => 1); + } + + return $end_dt; +} + +sub check_date { + my $dt = shift; + my $month = shift; + my $weekno = shift; + my $day = shift; + + if (!defined $day) { + # MMWW + return (($dt->month == $month) + && (($dt->week_of_month == $weekno) + || ($dt->week_of_month == last_day_of_month($dt, $weekno, 'th')->week_of_month))); + } + + # simple cases first + if ($daynames{$day} != $dt->day_of_week) { + # if it's the wrong day of the week, rest doesn't matter + return 0; + } + + if (!defined $month) { + # WWdd + return (($dt->weekday_of_month == $weekno) + || ($dt->weekday_of_month == last_day_of_month($dt, $weekno, $day)->weekday_of_month)); + } + + # MMWWdd + if ($month != $dt->month) { + # If it's the wrong month, then we're done + return 0; + } + + # It's the right day of the week + # It's the right month + + if ($weekno == $dt->weekday_of_month) { + # If this matches, then we're counting from the beginning + # of the month and it matches and we're done. + return 1; + } + + # only case left is that the week number is counting from + # the end of the month: eg, second last wednesday + return (last_week_of_month($weekno, $day)->weekday_of_month == $dt->weekday_of_month); +} + +sub match_week { + my $pat = shift; + my @date = @_; + my $dt = DateTime->new(year => $date[0], + month => $date[1], + day => $date[2]); + + if ($pat =~ m/^$weekpat$daypat$/) { + # WWdd: 03we = Third Wednesday + return check_date($dt, undef, $1, $2); + } elsif ($pat =~ m/^$monthpat$weekpat$daypat$/) { + # MMWWdd: 0599tu Last Tuesday in May XXX WRITE ME + return check_date($dt, $1, $2, $3); + } elsif ($pat =~ m/^$monthpat$weekpat$/) { + # MMWW: 1204: Fourth week in December XXX WRITE ME + return check_date($dt, $1, $2, undef); + } else { + carp "invalid week pattern '$pat'"; + return 0; + } +} + +sub match_month { + my $pat = shift; + my @date = @_; + + return ($pat eq $date[1]); +} + +sub match_season { + my $pat = shift; + my @date = @_; + + return ($pat eq $date[1]); +} + +sub match_year { + my $pat = shift; + my @date = @_; + + # XXX WRITE ME +} + +my %dispatch = ( + 'd' => \&match_day, + 'w' => \&match_week, + 'm' => \&match_month, + 's' => \&match_season, + 'y' => \&match_year, +); +sub regularity_match { + my $self = shift; + my $pubcode = shift; + my @date = @_; + + foreach my $regularity ($self->{PATTERN}->{y}) { + next unless $regularity =~ m/^$pubcode/; + + my $chroncode= substr($regularity, 1, 1); + my @pats = split(/,/, substr($regularity, 2)); + + # XXX WRITE ME + foreach my $pat (@pats) { + if ($dispatch{$chroncode}->($pat, @date)) { + return 1; + } + } + } + + return 0; +} + +sub is_omitted { + my $self = shift; + my @date = @_; + + return $self->regularity_match('o', @date); +} + +sub is_published { + my $self = shift; + my @date = @_; + + return $self->regularity_match('p', @date); +} + +sub is_combined { + my $self = shift; + my @date = @_; + + return $self->regularity_match('c', @date); +} + 1; diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm index 1d3405aa75..f5b37243db 100755 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Holding.pm @@ -197,36 +197,20 @@ my %increments = { # 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); +sub is_combined { + my $str = shift; - foreach my $i (0..@keys) { - $new[$i] = $cur[$i] = $self->{SUBFIELDS}->{$keys[$i]} - if exists $self->{SUBFIELDS}->{$keys[$i]}; - } + return $str =~ m;.+/.+; +} - if (defined $frequency) { - $incr = $increments{$frequency}; - } +sub incr_date { + my $incr = shift; + my @new = @_; - if (scalar(@cur) == 1) { + if (scalar(@new) == 1) { # only a year is specified. Next date is easy $new[0] += $incr->{years} || 1; - } elsif (scalar(@cur) == 2) { + } elsif (scalar(@new) == 2) { # Year and month or season if ($new[1] > 20) { # season @@ -245,7 +229,7 @@ sub next_date { $new[1] -= 12; } } - } elsif (scalar(@cur) == 3) { + } elsif (scalar(@new) == 3) { # Year, Month, Day: now it gets complicated. if ($new[2] =~ /^[0-9]+$/) { @@ -257,20 +241,47 @@ sub next_date { $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]'"; + } + } else { + warn("Don't know how to cope with @new"); + } + + return @new; +} + +sub next_date { + my $self = shift; + my $next = shift; + my @keys = @_; + my @cur; + my @new; + my $incr; + + my $caption = $self->{CAPTION}; + my $reg = $caption->{REGULARITY}; + my $pattern = $caption->{PATTERN}; + my $freq = $pattern->{w}; + + foreach my $i (0..@keys) { + $new[$i] = $cur[$i] = $self->{SUBFIELDS}->{$keys[$i]} + if exists $self->{SUBFIELDS}->{$keys[$i]}; + } + + if (is_combined($new[-1])) { + $new[-1] =~ s/^[^\/]+//; + } + + # If $frequency is not one of the standard codes defined in %increments + # then there has to be a $yp publication regularity pattern that + # lists the dates of publication. Use that that list to find the next + # date following the current one. + # XXX: the code doesn't handle this case yet. + + if (defined $freq && exists $increments{$freq}) { + @new = incr_date($increments{$freq}, @new); + + while ($caption->is_omitted(@new)) { + @new = incr_date($increments{$freq}, @new); } } }