From f51b5e11a456bb10fdf306a66b97c376d2495283 Mon Sep 17 00:00:00 2001 From: djfiander Date: Thu, 18 Jun 2009 01:10:16 +0000 Subject: [PATCH] Support for generating predictions based on publication patterns. Still don't support mixing publication patterns and combined dates. git-svn-id: svn://svn.open-ils.org/ILS/trunk@13399 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- .../src/perlmods/OpenILS/Utils/MFHD/Caption.pm | 198 +++++++++++++-------- .../src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t | 8 +- 2 files changed, 123 insertions(+), 83 deletions(-) diff --git a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm index ffae61174d..325d1ee42d 100755 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/Caption.pm @@ -249,10 +249,10 @@ sub match_day { sub subsequent_day { my $pat = shift; - my $cur = shift; - my $dt = DateTime->new(year => $cur->[0], - month => $cur->[1], - day => $cur->[2]); + my @cur = @_; + my $dt = DateTime->new(year => $cur[0], + month => $cur[1], + day => $cur[2]); if (exists $daynames{$pat}) { # dd: published on the given weekday @@ -274,32 +274,36 @@ sub subsequent_day { # current date is on or after $pat: next one is next month $dt->set(day => $pat); $dt->add(months => 1); - $cur->[0] = $dt->year; - $cur->[1] = $dt->month; - $cur->[2] = $dt->day; + $cur[0] = $dt->year; + $cur[1] = $dt->month; + $cur[2] = $dt->day; + } else { + # current date is before $pat: set day to pattern + $cur[2] = $pat; } - # current date is before $pat: set month to pattern - # or we've adjusted the year to next year, now fix the month - $cur->[1] = $pat; } elsif (length($pat) == 4) { # MMDD: published on the given day of the given month my ($mon, $day) = unpack("a2a2", $pat); - if (on_or_after($mon, $day, $cur->[1], $cur->[2])) { + if (on_or_after($mon, $day, $cur[1], $cur[2])) { # Current date is on or after pattern; next one is next year - $cur->[0] += 1; + $cur[0] += 1; } - # Year is now right. Either it's next year (because of on_or_before) + # Year is now right. Either it's next year (because of on_or_after) # or it's this year, because the current date is NOT on or after # the pattern. Just fix the month and day - $cur->[1] = $mon; - $cur->[2] = $day; + $cur[1] = $mon; + $cur[2] = $day; } else { carp "Invalid day pattern '$pat'"; return undef; } - return $cur; + foreach my $i (0..$#cur) { + $cur[$i] = '0' . (0+$cur[$i]) if $cur[$i] < 10; + } + + return @cur; } @@ -424,11 +428,11 @@ sub match_week { # sub subsequent_week { my $pat = shift; - my $cur = shift; + my @cur = @_; my $candidate; - my $dt = DateTime->new(year => $cur->[0], - month=> $cur->[1], - day => $cur->[2]); + my $dt = DateTime->new(year => $cur[0], + month=> $cur[1], + day => $cur[2]); if ($pat =~ m/^$weekpat$daypat$/) { # WWdd: published on given weekday of given week of every month @@ -489,11 +493,15 @@ sub subsequent_week { return undef; } - $cur->[0] = $candidate->year; - $cur->[1] = $candidate->month; - $cur->[2] = $candidate->day; + $cur[0] = $candidate->year; + $cur[1] = $candidate->month; + $cur[2] = $candidate->day; + + foreach my $i (0..$#cur) { + $cur[$i] = '0' . (0+$cur[$i]) if $cur[$i] < 10; + } - return $cur; + return @cur; } sub match_month { @@ -512,21 +520,24 @@ sub match_season { sub subsequent_season { my $pat = shift; - my $cur = shift; + my @cur = @_; - return undef if (($pat < 21) || ($pat > 24)); + if (($pat < 21) || ($pat > 24)) { + carp "Unexpected season '$pat'"; + return undef; + } - if ($cur->[1] >= $pat) { + if ($cur[1] >= $pat) { # current season is on or past pattern season in this year, # advance to next year - $cur->[0] += 1; + $cur[0] += 1; } # Either we've advanced to the next year or the current season # is before the pattern season in the current year. Either way, # all that remains is to set the season properly - $cur->[1] = $pat; + $cur[1] = $pat; - return $cur; + return @cur; } sub match_year { @@ -564,12 +575,21 @@ sub subsequent_issue { } my %dispatch = ( - 'd' => \&match_day, - 'e' => \&match_issue, # not really a "chron" code - 'w' => \&match_week, - 'm' => \&match_month, - 's' => \&match_season, - 'y' => \&match_year, + d => \&match_day, + e => \&match_issue, # not really a "chron" code + w => \&match_week, + m => \&match_month, + s => \&match_season, + y => \&match_year, +); + +my %generators = ( + d => \&subsequent_day, + e => \&subsequent_issue, # not really a "chron" code + w => \&subsequent_week, + m => \&subsequent_month, + s => \&subsequent_season, + y => \&subsequent_year, ); sub regularity_match { @@ -605,6 +625,8 @@ sub is_omitted { my $self = shift; my @date = @_; +# printf("# is_omitted: testing date %s: %d\n", join('/', @date), +# $self->regularity_match('o', @date)); return $self->regularity_match('o', @date); } @@ -690,7 +712,6 @@ sub incr_date { $new[0] += 1; $new[1] -= 12; } - $new[1] = '0' . $new[1] if ($new[1] < 10); } } elsif (scalar(@new) == 3) { # Year, Month, Day: now it gets complicated. @@ -705,12 +726,14 @@ sub incr_date { $new[1] = $dt->month; $new[2] = $dt->day; } - $new[1] = '0' . $new[1] if ($new[1] < 10); - $new[2] = '0' . $new[2] if ($new[2] < 10); } else { warn("Don't know how to cope with @new"); } + foreach my $i (0..$#new) { + $new[$i] = '0' . (0+$new[$i]) if $new[$i] < 10; + } + return @new; } @@ -769,15 +792,6 @@ sub calendar_increment { } } -my %generators = ( - 'd' => \&subsequent_day, - 'e' => \&subsequent_issue, # not a chron code - 'w' => \&subsequent_week, - 'm' => \&subsequent_month, - 's' => \&subsequent_season, - 'y' => \&subsequent_year, -); - sub next_date { my $self = shift; my $next = shift; @@ -793,52 +807,78 @@ sub next_date { my $freq = $pattern->{w}; foreach my $i (0..$#keys) { - $new[$i] = $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]}; + $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]}; } # If the current issue has a combined date (eg, May/June) # get rid of the first date and base the calculation # on the final date in the combined issue. - $new[-1] =~ s|^[^/]+/||; - - # XXX Insert new date generation code in here that uses publication - # patterns. - -### -### Old code: only works for simple cases -### - # 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)) { - carp "Undefined frequency in next_date!"; - } elsif (!exists $increments{$freq}) { - carp "Don't know how to deal with frequency '$freq'!"; - } else { - # - # One of the standard defined issue frequencies - # - @new = incr_date($increments{$freq}, @new); + $cur[-1] =~ s|^[^/]+/||; + + if (defined $pattern->{y}->{p}) { + # There is a $y publication pattern defined in the record: + # use it to calculate the next issue date. - while ($self->is_omitted(@new)) { - @new = incr_date($increments{$freq}, @new); + # XXX TODO: need to handle combined and omitted issues. + foreach my $pubpat (@{$pattern->{y}->{p}}) { + my $chroncode = substr($pubpat, 0, 1); + my @pats = split(/,/, substr($pubpat, 1)); + + if (!exists $generators{$chroncode}) { + carp "Unrecognized chroncode '$chroncode'"; + return undef; + } + + foreach my $pat (@pats) { + @candidate = $generators{$chroncode}->($pat, @cur); + while ($self->is_omitted(@candidate)) { +# printf("# pubpat omitting date '%s'\n", +# join('/', @candidate)); + @candidate = $generators{$chroncode}->($pat, @candidate); + } + +# printf("# testing candidate date '%s'\n", join('/', @candidate)); + if (!defined($new[0]) + || !on_or_after($candidate[0], $candidate[1], $new[0], $new[1])) { + # first time through the loop + # or @candidate is before @new => @candidate is the next + # issue. + @new = @candidate; +# printf("# selecting candidate date '%s'\n", join('/', @new)); + } + } } + } else { + # There is no $y publication pattern defined, so use + # the $w frequency to figure out the next date + + if (!defined($freq)) { + carp "Undefined frequency in next_date!"; + } elsif (!exists $increments{$freq}) { + carp "Don't know how to deal with frequency '$freq'!"; + } else { + # + # One of the standard defined issue frequencies + # + @new = incr_date($increments{$freq}, @cur); - if ($self->is_combined(@new)) { - my @second_date = incr_date($increments{$freq}, @new); + while ($self->is_omitted(@new)) { + @new = incr_date($increments{$freq}, @new); + } - # I am cheating: This code assumes that only the smallest - # time increment is combined. So, no "Apr 15/May 1" allowed. - $new[-1] = $new[-1] . '/' . $second_date[-1]; + if ($self->is_combined(@new)) { + my @second_date = incr_date($increments{$freq}, @new); + + # I am cheating: This code assumes that only the smallest + # time increment is combined. So, no "Apr 15/May 1" allowed. + $new[-1] = $new[-1] . '/' . $second_date[-1]; + } } } for my $i (0..$#new) { $next->{$keys[$i]} = $new[$i]; } - # Figure out if we need to adust volume number # right now just use the $carry that was passed in. # in long run, need to base this on ($carry or date_change) 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 b9da10883b..0b80543d39 100644 --- a/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t +++ b/Open-ILS/src/perlmods/OpenILS/Utils/MFHD/test/mfhd.t @@ -200,7 +200,7 @@ __END__ 245 00 $aLibrary Journal: 20 times a year, semimonthly except Jan, Jul, Aug, Dec 853 20 $818$av.$bno.$u20$vr$i(year)$j(month)$k(day)$ws$x01$ypd01,15$yod0115,0715,0815,1215 -863 41 $818.1$a132$b20$i2007$j12$k1$x|a133|b1|i2008|j01|k01$zTODO Skipping over missed date to beginning of next year/volume. -863 41 $818.2$a133$b1$i2008$j01$k01$x|a133|b2|i2008|j02|k01$zTODO Skipping over missed date at beginning of year -863 41 $818.3$a133$b2$i2008$j02$k01$x|a133|b3|i2008|j02|k15$zTODO Published semimonthly, going from 1st to 15th -863 41 $818.4$a133$b3$i2008$j02$k15$x|a133|b4|i2008|j03|k01$zTODO Published semimonthly, going from 15th to 1st +863 41 $818.1$a132$b20$i2007$j12$k1$x|a133|b1|i2008|j01|k01$zSkipping over missed date to beginning of next year/volume. +863 41 $818.2$a133$b1$i2008$j01$k01$x|a133|b2|i2008|j02|k01$zSkipping over missed date at beginning of year +863 41 $818.3$a133$b2$i2008$j02$k01$x|a133|b3|i2008|j02|k15$zPublished semimonthly, going from 1st to 15th +863 41 $818.4$a133$b3$i2008$j02$k15$x|a133|b4|i2008|j03|k01$zPublished semimonthly, going from 15th to 1st -- 2.11.0