[open-ils-commits] r20471 - in branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD: . test (dbwells)

svn at svn.open-ils.org svn at svn.open-ils.org
Fri May 13 12:02:21 EDT 2011


Author: dbwells
Date: 2011-05-13 12:02:18 -0400 (Fri, 13 May 2011)
New Revision: 20471

Modified:
   branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm
   branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Date.pm
   branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm
   branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhd.t
   branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhddata.txt
Log:
A bevy of MFHD bug fixes (and test cases)

1) Remove hard-coded 'gap' text from format_part()
2) Honor $ypm## for chron_to_date() for annuals
3) Removed overly simple check on $w as digit
4) Allow for combined chronologies other than 2nd level
5) Make calendar changes trump $u counts
6) Honor issue restarts at calendar changes
7) Rudimentary support of $u counts for non-restarting issue numbering
8) Special interpretation of $yps for early winters (i.e. winter is the first season of the calendar year)
9) Teach chron_to_date() about early winters

The last two points deserve some special attention.  A large number of journals consider 'Winter' to be the first season of the year, so Winter 2011 means (roughly) January 2011, not December 2011.  However, there is no explicit way to indicate this in the standard, and also the code relies in many ways on the fact that 24 (chronology code for winter) is greater than 21 (code for spring).  To work around this, we are interpreting a certain ambiguous pattern in a particular way.  Specifically, if you set $w to a digit, then set $y to 'ps24,21,22,23' (or some variation with '24' as the first value), you will get this winter-first behavior.  Also, the season is treated internally as '20' then converted to '24' when processing is completed.


Modified: branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm
===================================================================
--- branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm	2011-05-13 16:01:04 UTC (rev 20470)
+++ branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Caption.pm	2011-05-13 16:02:18 UTC (rev 20471)
@@ -101,17 +101,6 @@
 
     my $pat = $self->{_mfhdc_PATTERN};
 
-    # Sanity check publication frequency vs publication pattern:
-    # if the frequency is a number, then the pattern better
-    # have that number of values associated with it.
-    if (   exists($pat->{w})
-        && ($pat->{w} =~ /^\d+$/)
-        && ($pat->{w} != scalar(@{$pat->{y}->{p}}))) {
-        carp(
-"Caption::new: publication frequency '$pat->{w}' != publication pattern @{$pat->{y}->{p}}"
-        );
-    }
-
     # If there's a $x subfield and a $j, then it's compressible
     if (exists $pat->{x} && exists $self->{_mfhdc_CHRONS}->{'j'}) {
         $self->{_mfhdc_COMPRESSIBLE} = 1;
@@ -397,14 +386,15 @@
     my $freq    = $pattern->{w};
 
     foreach my $i (0..$#keys) {
-        $cur[$i] = $next->{$keys[$i]} if exists $next->{$keys[$i]};
+        if (exists $next->{$keys[$i]}) {
+            $cur[$i] = $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.
+            $cur[$i] =~ s|^[^/]+/||;
+        }
     }
 
-    # 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.
-    $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.
@@ -434,12 +424,12 @@
                     ($start, $end) = (undef, undef);
                 }
 
-                @candidate = $genfunc->($start || $pat, @cur);
+                @candidate = $genfunc->($start || $pat, \@cur, $self);
 
                 while ($self->is_omitted(@candidate)) {
                     # 		    printf("# pubpat omitting date '%s'\n",
                     # 			   join('/', @candidate));
-                    @candidate = $genfunc->($start || $pat, @candidate);
+                    @candidate = $genfunc->($start || $pat, \@candidate, $self);
                 }
 
                 # 		printf("# testing new candidate '%s' against '%s'\n",
@@ -451,7 +441,7 @@
                     # @candidate is the next issue.
                     @new = @candidate;
                     if (defined $end) {
-                        @newend = $genfunc->($end, @cur);
+                        @newend = $genfunc->($end, \@cur, $self);
                     } else {
                         $newend[0] = undef;
                     }
@@ -461,6 +451,8 @@
             }
         }
 
+        $new[1] = 24 if ($new[1] == 20); # restore fake early winter
+
         if (defined($newend[0])) {
             # The best match was a combined issue
             foreach my $i (0..$#new) {
@@ -488,10 +480,11 @@
 
             if ($self->is_combined(@new)) {
                 my @second_date = MFHD::Date::incr_date($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];
+                foreach my $i (0..$#new) {
+                    # don't combine identical fields
+                    next if $new[$i] eq $second_date[$i];
+                    $new[$i] .= '/' . $second_date[$i];
+                }
             }
         }
     }
@@ -499,18 +492,57 @@
     for my $i (0..$#new) {
         $next->{$keys[$i]} = $new[$i];
     }
+
     # 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) {
-        # if $carry is set, the date doesn't matter: we're not
-        # going to increment the v. number twice at year-change.
+    #
+    # If we are incrementing based on date, $carry doesn't
+    # matter: we're not going to increment the v. number twice
+    #
+    # It is conceivable that a serial could increment based on date for some
+    # volumes and issue numbering for other volumes, but until a real case
+    # comes up, let's assume that defined calendar changes always trump $u
+    if (defined $pattern->{x}) {
+        my $increment = $self->calendar_increment(\@cur, \@new);
+        # if we hit a calendar change, restart dependant restarters
+        # regardless of whether they thought they should
+        if ($increment) {
+            $next->{a} += $increment;
+            foreach my $key ('b'..'f') {
+                next if !exists $next->{$key};
+                my $cap = $self->capfield($key);
+                if ($cap->{RESTART}) {
+                    $next->{$key} = 1;
+                    if ($self->enum_is_combined($key, $next->{$key})) {
+                        $next->{$key} .= '/' . ($next->{$key} + 1);
+                    }
+                } else {
+                    last; # if we find a non-restarting level, stop
+                }
+            }
+        }
+    } elsif ($carry) {
         $next->{a} += $carry;
-    } elsif (defined $pattern->{x}) {
-        $next->{a} += $self->calendar_increment(\@cur, \@new);
     }
 }
 
+sub winter_starts_year {
+    my $self = shift;
+
+    my $pubpats = $self->{_mfhdc_PATTERN}->{y}->{p};
+    my $freq = $self->{_mfhdc_PATTERN}->{w};
+
+    if ($freq =~ /^\d$/) {
+        foreach my $pubpat (@$pubpats) {
+            my $chroncode = substr($pubpat, 0, 1);
+            if ($chroncode eq 's' and substr($pubpat, 1, 2) == 24) {
+                return 1;        
+            }
+        }
+    }
+    return 0;
+}
+
+
 sub next_alt_enum {
     my $self = shift;
     my $next = shift;
@@ -653,6 +685,15 @@
                 && ($next->{$key} eq $cap->{COUNT})) {
                 $next->{$key} = 1;
                 $carry = 1;
+            } elsif ($cap->{COUNT} > 0 and !($next->{$key} % $cap->{COUNT})) {
+                # If we have a non-restarting enum, but we define a count,
+                # we need to carry to the next level when the current value
+                # divides evenly by the count
+                # XXX: this code naively assumes that there has never been an
+                # issue number anomaly of any kind (like an extra issue), but this
+                # limit is inherent in the standard
+                $next->{$key} += 1;
+                $carry = 1;
             } else {
                 # If I don't need to "carry" beyond here, then I just increment
                 # this level of the enumeration and stop looping, since the

Modified: branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Date.pm
===================================================================
--- branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Date.pm	2011-05-13 16:01:04 UTC (rev 20470)
+++ branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Date.pm	2011-05-13 16:02:18 UTC (rev 20471)
@@ -62,9 +62,13 @@
     }
 }
 
+# TODO: possible support for extraneous $yp information
+# ex. $ypdtu but on a bi-weekly (currently assumes weekly)
 sub subsequent_day {
     my $pat = shift;
-    my @cur = @_;
+    my $cur = shift;
+
+    my @cur = @$cur;
     my $dt  = DateTime->new(
         year  => $cur[0],
         month => $cur[1],
@@ -280,7 +284,9 @@
 #
 sub subsequent_week {
     my $pat = shift;
-    my @cur = @_;
+    my $cur = shift;
+
+    my @cur = @$cur;
     my $candidate;
     my $dt;
 
@@ -388,8 +394,10 @@
 
 sub subsequent_month {
     my $pat = shift;
-    my @cur = @_;
+    my $cur = shift;
 
+    my @cur = @$cur;
+
     if ($cur[1] >= $pat) {
         # Current date is on or after the patter date, so the next
         # occurence is next year
@@ -411,8 +419,11 @@
 
 sub subsequent_season {
     my $pat = shift;
-    my @cur = @_;
+    my $cur = shift;
+    my $caption = shift;
 
+    my @cur = @$cur;
+
 #     printf("# subsequent_season: pat='%s', cur='%s'\n", $pat, join('/', at cur));
 
     if (($pat < 21) || ($pat > 24)) {
@@ -420,6 +431,15 @@
         return undef;
     }
 
+    if ($caption->winter_starts_year()) {
+        if ($pat == 24) {
+            $pat = 20; # fake early winter
+        }
+        if ($cur[1] == 24) {
+            $cur[1] = 20; # fake early winter
+        }
+    }
+
     if ($cur[1] >= $pat) {
         # current season is on or past pattern season in this year,
         # advance to next year
@@ -445,6 +465,8 @@
     my $pat = shift;
     my $cur = shift;
 
+    my @cur = @$cur;
+
     # XXX WRITE ME
     return undef;
 }
@@ -463,6 +485,8 @@
     my $pat = shift;
     my $cur = shift;
 
+    my @cur = @$cur;
+
     # Issue generation is handled separately
     return undef;
 }
@@ -509,6 +533,7 @@
     i => {days   => 2},     # three times / week
     j => {days   => 10},    # three times /month
                             # k => continuous
+#    l => {weeks  => 3},     # triweekly (NON-STANDARD)
     m => {months => 1},     # monthly
     q => {months => 3},     # quarterly
     s => {days   => 15},    # semimonthly

Modified: branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm
===================================================================
--- branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm	2011-05-13 16:01:04 UTC (rev 20470)
+++ branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm	2011-05-13 16:02:18 UTC (rev 20471)
@@ -362,16 +362,19 @@
     }
 
     # Breaks in the sequence
-    if (defined($self->{_mfhdh_BREAK})) {
-        if ($self->{_mfhdh_BREAK} eq 'n') {
-            $str .= ' non-gap break';
-        } elsif ($self->{_mfhdh_BREAK} eq 'g') {
-            $str .= ' gap';
-        } else {
-            warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'";
-        }
-    }
-
+# XXX: this is non-standard and also not the right place for this, since gaps
+# only make sense in the context of multiple holding segments, not a single
+# holding
+#    if (defined($self->{_mfhdh_BREAK})) {
+#        if ($self->{_mfhdh_BREAK} eq 'n') {
+#            $str .= ' non-gap break';
+#        } elsif ($self->{_mfhdh_BREAK} eq 'g') {
+#            $str .= ' gap';
+#        } else {
+#            warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'";
+#        }
+#    }
+#
     return $str;
 }
 
@@ -635,13 +638,28 @@
                     $chrons[$i]->[1] = 9;
                     $chrons[$i]->[2] = 22;
                 } elsif ($seasons[$i] == 24) {
-                    $chrons[$i]->[1] = 12;
-                    $chrons[$i]->[2] = 21;
+                    # "winter" can come at the beginning or end of a year,
+                    if ($self->caption->winter_starts_year()) {
+                        $chrons[$i]->[1] = 1;
+                        $chrons[$i]->[2] = 1;
+                    } else { # default to astronomical
+                        $chrons[$i]->[1] = 12;
+                        $chrons[$i]->[2] = 21;
+                    }
                 }
             }
         }
     }
 
+    # if we have an an annual, set the month to ypm## if available
+    if (exists($self->caption->{_mfhdc_PATTERN}->{y}->{p}) and $self->caption->{_mfhdc_PATTERN}->{w} eq 'a') {
+        my $reg = $self->caption->{_mfhdc_PATTERN}->{y}->{p}->[0];
+        if ($reg =~ /^m(\d+)/) {
+            $chrons[0]->[1] = $1;
+            $chrons[1]->[1] = $1;
+        }
+    }
+
     my @dates;
     foreach my $chron (@chrons) {
         my $date = undef;

Modified: branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhd.t
===================================================================
--- branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhd.t	2011-05-13 16:01:04 UTC (rev 20470)
+++ branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhd.t	2011-05-13 16:02:18 UTC (rev 20471)
@@ -54,6 +54,10 @@
                   if ($field->subfield('z') =~ /^TODO/);
                 is_deeply($field->next, right_answer($field),
                     $field->subfield('8') . ': ' . $field->subfield('z'));
+
+                if ($field->subfield('y')) {
+                    is($field->chron_to_date(), $field->subfield('y'), 'Chron-to-date test');
+                }
             }
         }
     }

Modified: branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhddata.txt
===================================================================
--- branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhddata.txt	2011-05-13 16:01:04 UTC (rev 20470)
+++ branches/rel_2_1/Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/test/mfhddata.txt	2011-05-13 16:02:18 UTC (rev 20471)
@@ -114,7 +114,7 @@
 863 41 $820.3$a1$b5$i1990$j12$x|a2|b1|i1991|j02$zWrap at end of year/vol.
 
 245 00 $aEconomist: pub. w on Sa, except combined iss on last two weeks of year
-853 20 $821$av.$bno.$u12$vc$i(year)$j(month)$k(day)$ww$x01,04,07,10$ypdsa$yow1299
+853 20 $821$av.$bno.$vc$i(year)$j(month)$k(day)$ww$x01,04,07,10$ypdsa$yow1299
 863 41 $821.1$a100$b1200$i2008$j12$k06$x|a100|b1201|i2008|j12|k13$zwithin vol.
 863 41 $821.2$a100$b1201$i2008$j12$k13$x|a100|b1202|i2008|j12|k20$zwithin vol. combined iss.
 863 41 $821.3$a100$b1202$i2008$j12$k20$x|a101|b1203|i2009|j01|k03$zvolume change over omitted iss.
@@ -127,7 +127,7 @@
 863 41 $822.4$a2$b4$i2013$j04$k11$x|a2|b5|i2013|j05|k01$zpublished on Wed May 1st
 
 245 00 $aMFHD example: pub. every Mon, Thu, except on New Years, July 4, Labor Day, Thanksgiving, Christmas
-853 20 $823$av.$bno.$uvar$vr$i(year)$j(month)$k(day)$wc$x07$ypw00mo,00th$yod0101,0704,1225$yow0901mo,1104th
+853 20 $823$av.$bno.$uvar$i(year)$j(month)$k(day)$wc$x07$ypw00mo,00th$yod0101,0704,1225$yow0901mo,1104th
 863 41 $823.1$a1$b100$i2009$j02$k02$x|a1|b101|i2009|j02|k05$znormal: Mon to Thu
 863 41 $823.2$a1$b101$i2009$j02$k05$x|a1|b102|i2009|j02|k09$znormal: Thu to Mon
 863 41 $823.3$a1$b150$i2009$j06$k29$x|a2|b151|i2009|j07|k02$znormal: calendar change
@@ -164,3 +164,38 @@
 863 41 $826.1$a1$b1$i1990$j01$x|a1|b2|i1990|j02$znormal issue
 864 41 $827.1$a1$i1990$j09$x|a2|i1991|j09$zAnnual supplement
 865 41 $828.1$a1$i1990$j02$x|a2|i1991|j02$zAnnual Index
+
+# Issue numbering restarts at the calendar change
+245 00 $aIssue No. restarts at calendar change
+853 20 $829$av.$bno.$uvar$vr$i(year)$j(month)$k(day)$wd$x0101,0701
+863 41 $829.1$a1$b181$i2011$j06$k30$x|a2|b1|i2011|j07|k01$zJune 30 to July 1
+
+# Winter starts the calendar year
+# Requires a hacky use of MARC due to limitations in MARC standard
+245 00 $aWinter starts the calendar year
+853 20 $830$av.$bno.$u4$vr$i(year)$j(season)$w4$yps24,21,22,23
+863 41 $830.1$a1$b4$i2010$j23$x|a2|b1|i2011|j24$zAutumn 2010 to Winter 2011
+863 41 $830.2$a2$b1$i2011$j24$x|a2|b2|i2011|j21$y2011-01-01$zWinter 2011 to Spring 2011
+
+# Combined seasons
+245 00 $aCombined seasons, and Winter starts the calendar year
+853 20 $831$av.$bno.$u4$vr$i(year)$j(season)$w4$yps24/21,22,23
+863 41 $831.1$a1$b4$i2010$j23$x|a2|b1|i2011|j24/21$zAutumn 2010 to combined Winter/Spring 2011
+
+# Combined seasons, variation
+245 00 $aCombined seasons variation, and Winter starts the calendar year
+853 20 $832$av.$bno.$u4$vr$i(year)$j(season)$w4$yps24,21/22,23
+863 41 $832.1$a1$b4$i2011$j24$x|a2|b1|i2011|j21/22$zWinter 2011 to combined Spring/Summer 2011
+863 41 $832.2$a1$b4$i2011$j21/22$x|a2|b1|i2011|j23$zSpring/Summer 2011 to Autumn 2011
+
+# Defined unit count, non-restarting
+245 00 $aDefined unit count, non-restarting
+853 20 $833$av.$bno.$u4$vc$i(year)$j(month)$wf
+863 41 $833.1$a24$b95$i2011$j01$x|a24|b96|i2011|j07$z3rd Issue to 4th Issue in Volume
+863 41 $833.2$a24$b96$i2011$j07$x|a25|b97|i2012|j01$z4th Issue to 1st Issue in next Volume
+
+# Combined months to end the year
+245 00 $aCombined months to end the year
+853 20 $834$av.$bno.$u12$vr$i(year)$j(month)$wm$ycm12/01$yce22/3
+863 41 $834.1$a24$b1$i2011$j11$x|a24|b2/3|i2011/2012|j12/01$zNov. to Combined Dec./Jan.
+863 41 $834.2$a24$b2/3$i2011/2012$j12/1$x|a24|b4|i2012|j02$zCombined Dec./Jan. to Feb.



More information about the open-ils-commits mailing list