]> git.evergreen-ils.org Git - working/Evergreen.git/blob - Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD.pm
LP #1075167: Serials: Avoid infinite loop in holdings summarization
[working/Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Utils / MFHD.pm
1 package MFHD;
2 use strict;
3 use warnings;
4 use integer;
5 use Carp;
6 use DateTime::Format::Strptime;
7 use Data::Dumper;
8
9 # for inherited methods to work properly, we need to force a
10 # MARC::Record version greater than 2.0.0
11 use MARC::Record "2.0.1";
12 use base 'MARC::Record';
13
14 use OpenILS::Utils::MFHD::Caption;
15 use OpenILS::Utils::MFHD::Holding;
16
17 sub new {
18     my $proto = shift;
19     my $class = ref($proto) || $proto;
20     my $self  = shift;
21
22     $self->{_strp_date} = new DateTime::Format::Strptime(pattern => '%F');
23
24     $self->{_mfhd_CAPTIONS} = {};
25     $self->{_mfhd_COMPRESSIBLE} = (substr($self->leader, 17, 1) =~ /[45]/);
26
27     foreach my $field ('853', '854', '855') {
28         my $captions = {};
29         foreach my $caption ($self->field($field)) {
30             my $cap_id;
31
32             $cap_id = $caption->subfield('8') || '0';
33
34             if (exists $captions->{$cap_id}) {
35                 carp "Multiple MFHD captions with label '$cap_id'";
36             }
37
38             $captions->{$cap_id} = new MFHD::Caption($caption);
39             if ($self->{_mfhd_COMPRESSIBLE}) {
40                 $self->{_mfhd_COMPRESSIBLE} &&=
41                   $captions->{$cap_id}->compressible;
42             }
43         }
44         $self->{_mfhd_CAPTIONS}->{$field} = $captions;
45     }
46
47     foreach my $field ('863', '864', '865') {
48         my $holdings = {};
49         my $cap_field;
50
51         ($cap_field = $field) =~ s/6/5/;
52
53         foreach my $hfield ($self->field($field)) {
54             my ($linkage, $link_id, $seqno);
55             my $holding;
56
57             $linkage = $hfield->subfield('8');
58             ($link_id, $seqno) = split(/\./, $linkage);
59
60             if (!exists $holdings->{$link_id}) {
61                 $holdings->{$link_id} = {};
62             }
63             $holding =
64               new MFHD::Holding($seqno, $hfield,
65                 $self->{_mfhd_CAPTIONS}->{$cap_field}->{$link_id});
66             $holdings->{$link_id}->{$seqno} = $holding;
67
68             if ($self->{_mfhd_COMPRESSIBLE}) {
69                 $self->{_mfhd_COMPRESSIBLE} &&= $holding->validate;
70             }
71         }
72         $self->{_mfhd_HOLDINGS}->{$field} = $holdings;
73     }
74
75     bless($self, $class);
76     return $self;
77 }
78
79 sub compressible {
80     my $self = shift;
81
82     return $self->{_mfhd_COMPRESSIBLE};
83 }
84
85 sub caption_link_ids {
86     my $self  = shift;
87     my $field = shift;
88
89     return sort keys %{$self->{_mfhd_CAPTIONS}->{$field}};
90 }
91
92 # optional argument to get back a 'hashref' or an 'array' (default)
93 sub captions {
94     my $self  = shift;
95     my $tag = shift;
96     my $return_type = shift;
97
98     # TODO: add support for caption types as argument? (base, index, supplement)
99     my @sorted_ids = $self->caption_link_ids($tag);
100
101     if (defined($return_type) and $return_type eq 'hashref') {
102         my %captions;
103         foreach my $link_id (@sorted_ids) {
104             $captions{$link_id} = $self->{_mfhd_CAPTIONS}{$tag}{$link_id};
105         }
106         return \%captions;
107     } else {
108         my @captions;
109         foreach my $link_id (@sorted_ids) {
110             push(@captions, $self->{_mfhd_CAPTIONS}{$tag}{$link_id});
111         }
112         return @captions;
113     }
114 }
115
116 sub append_fields {
117     my $self = shift;
118
119     my $field_count = $self->SUPER::append_fields(@_);
120     if ($field_count) {
121         foreach my $field (@_) {
122             $self->_avoid_link_collision($field);
123             my $field_type = ref $field;
124             if ($field_type eq 'MFHD::Holding') {
125                 $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
126             } elsif ($field_type eq 'MFHD::Caption') {
127                 $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
128             }
129         }
130         return $field_count;
131     } else {
132         return;
133     }   
134 }
135
136 sub delete_field {
137     my $self = shift;
138     my $field = shift;
139
140     my $field_count = $self->SUPER::delete_field($field);
141     if ($field_count) {
142         my $field_type = ref($field);
143         if ($field_type eq 'MFHD::Holding') {
144             delete($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno});
145         } elsif ($field_type eq 'MFHD::Caption') {
146             delete($self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id});
147         }
148         return $field_count;
149     } else {
150         return;
151     }
152 }
153
154 sub insert_fields_before {
155     my $self = shift;
156     my $before = shift;
157
158     my $field_count = $self->SUPER::insert_fields_before($before, @_);
159     if ($field_count) {
160         foreach my $field (@_) {
161             $self->_avoid_link_collision($field);
162             my $field_type = ref $field;
163             if ($field_type eq 'MFHD::Holding') {
164                 $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
165             } elsif ($field_type eq 'MFHD::Caption') {
166                 $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
167             }
168         }
169         return $field_count;
170     } else {
171         return;
172     }
173 }
174
175 sub insert_fields_after {
176     my $self = shift;
177     my $after = shift;
178
179     my $field_count = $self->SUPER::insert_fields_after($after, @_);
180     if ($field_count) {
181         foreach my $field (@_) {
182             $self->_avoid_link_collision($field);
183             my $field_type = ref $field;
184             if ($field_type eq 'MFHD::Holding') {
185                 $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
186             } elsif ($field_type eq 'MFHD::Caption') {
187                 $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
188             }
189         }
190         return $field_count;
191     } else {
192         return;
193     }
194 }
195
196 sub _avoid_link_collision {
197     my $self = shift;
198     my $field = shift;
199
200     my $fieldref = ref($field);
201     if ($fieldref eq 'MFHD::Holding') {
202         my $seqno = $field->seqno;
203         my $changed_seqno = 0;
204         if (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno})) {
205             $changed_seqno = 1;
206             do {
207                 $seqno++;
208             } while (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno}));
209         }
210         $field->seqno($seqno) if $changed_seqno;
211     } elsif ($fieldref eq 'MFHD::Caption') {
212         my $link_id = $field->link_id;
213         my $changed_link_id = 0;
214         if (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id})) {
215             $link_id++;
216             $changed_link_id = 1;
217             do {
218                 $link_id++;
219             } while (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id}));
220         }
221         $field->link_id($link_id) if $changed_link_id;
222     }
223 }
224
225 sub active_captions {
226     my $self  = shift;
227     my $tag = shift;
228
229     # TODO: add support for caption types as argument? (basic, index, supplement)
230     my @captions;
231     my @active_captions;
232
233     @captions = $self->captions($tag);
234
235     # TODO: for now, we will assume the last 85X field is active
236     # and the rest are historical.  The standard is hazy about
237     # how multiple active patterns of the same 85X type should be
238     # handled.  We will, however, return as an array for future
239     # use.
240     push(@active_captions, $captions[-1]);
241
242     return @active_captions;
243 }
244
245 sub holdings {
246     my $self  = shift;
247     my $field = shift;
248     my $capid = shift;
249
250     return
251       sort { $a->seqno <=> $b->seqno }
252       values %{$self->{_mfhd_HOLDINGS}->{$field}->{$capid}};
253 }
254
255 sub holdings_by_caption {
256     my $self  = shift;
257     my $caption = shift;
258
259     my $htag    = $caption->tag;
260     my $link_id = $caption->link_id;
261     $htag =~ s/^85/86/;
262     return $self->holdings($htag, $link_id);
263 }
264
265 sub _holding_date {
266     my $self = shift;
267     my $holding = shift;
268
269     return $self->{_strp_date}->parse_datetime($holding->chron_to_date);
270 }
271
272 #
273 # generate_predictions()
274 # Accepts a hash ref of options initially defined as:
275 # base_holding : reference to the holding field to predict from
276 # num_to_predict : the number of issues you wish to predict
277 # OR
278 # end_holding : holding field ref, keep predicting until you meet or exceed it
279 # OR
280 # end_date : keep predicting until you exceed this
281 #
282 # The basic method is to first convert to a single holding if compressed, then
283 # increment the holding and save the resulting values to @predictions.
284
285 # returns @predictions, an array of holding field refs (including end_holding
286 # if applicable but NOT base_holding)
287
288 sub generate_predictions {
289     my ($self, $options) = @_;
290
291     my $base_holding   = $options->{base_holding};
292     my $num_to_predict = $options->{num_to_predict};
293     my $end_holding    = $options->{end_holding};
294     my $end_date       = $options->{end_date};
295     my $max_to_predict = $options->{max_to_predict} || 10000; # fail-safe
296
297     if (!defined($base_holding)) {
298         carp("Base holding not defined in generate_predictions, returning empty set");
299         return ();
300     }
301     if ($base_holding->is_compressed) {
302         carp("Ambiguous compressed base holding in generate_predictions, returning empty set");
303         return ();
304     }
305     my $curr_holding = $base_holding->clone; # prevent side-effects
306     
307     my @predictions;
308         
309     if ($num_to_predict) {
310         for (my $i = 0; $i < $num_to_predict; $i++) {
311             push(@predictions, $curr_holding->increment->clone);
312         }
313     } elsif (defined($end_holding)) {
314         $end_holding = $end_holding->clone; # prevent side-effects
315         my $next_holding = $curr_holding->increment->clone;
316         my $num_predicted = 0;
317         while ($next_holding le $end_holding) {
318             push(@predictions, $next_holding);
319             $num_predicted++;
320             if ($num_predicted >= $max_to_predict) {
321                 carp("Maximum prediction count exceeded");
322                 last;
323             }
324             $next_holding = $curr_holding->increment->clone;
325         }
326     } elsif (defined($end_date)) {
327         my $next_holding = $curr_holding->increment->clone;
328         my $num_predicted = 0;
329         while ($self->_holding_date($next_holding) <= $end_date) {
330             push(@predictions, $next_holding);
331             $num_predicted++;
332             if ($num_predicted >= $max_to_predict) {
333                 carp("Maximum prediction count exceeded");
334                 last;
335             }
336             $next_holding = $curr_holding->increment->clone;
337         }
338     }
339
340     return @predictions;
341 }
342
343 #
344 # create an array of compressed holdings from all holdings for a given caption,
345 # compressing as needed
346 #
347 # Optionally you can skip sorting, but the resulting compression will be compromised
348 # if the current holdings are out of order
349 #
350 # TODO: gap marking, gap preservation
351 #
352 # TODO: some of this could be moved to the Caption object to allow for 
353 # decompression in the absense of an overarching MFHD object
354 #
355 sub get_compressed_holdings {
356     my $self = shift;
357     my $caption = shift;
358     my $opts = shift;
359     my $skip_sort = $opts->{'skip_sort'};
360
361     # basic check for necessary pattern information
362     if (!scalar keys %{$caption->pattern}) {
363         carp "Cannot compress without pattern data, returning original holdings";
364         return $self->holdings_by_caption($caption);
365     }
366
367     # make sure none are compressed (except for open-ended)
368     my @decomp_holdings;
369     if ($skip_sort) {
370         @decomp_holdings = $self->get_decompressed_holdings($caption, {'skip_sort' => 1, 'passthru_open_ended' => 1});
371     } else {
372         # sort for best algorithm
373         @decomp_holdings = $self->get_decompressed_holdings($caption, {'dedupe' => 1, 'passthru_open_ended' => 1});
374     }
375
376     return () if !@decomp_holdings;
377
378     # if first holding is open-ended, it 'includes' all the rest, so return
379     if ($decomp_holdings[0]->is_open_ended) {
380         return ($decomp_holdings[0]);
381     }
382
383     my $runner = $decomp_holdings[0]->clone->increment;   
384     my $curr_holding = shift(@decomp_holdings);
385     $curr_holding = $curr_holding->clone;
386     my $seqno = 1;
387     $curr_holding->seqno($seqno);
388     my @comp_holdings;
389     foreach my $holding (@decomp_holdings) {
390         if ($runner eq $holding) {
391             $curr_holding->extend;
392             $runner->increment;
393         } elsif ($runner gt $holding) { # should not happen unless holding is not in series
394             carp("Found unexpected holding, skipping");
395         } elsif ($holding->is_open_ended) { # special case, as it will always be the last
396             if ($runner eq $holding->clone->compressed_to_first) {
397                 $curr_holding->compressed_end();
398             } else {
399                 push(@comp_holdings, $curr_holding);
400                 $curr_holding = $holding->clone;
401                 $seqno++;
402                 $curr_holding->seqno($seqno);
403             }
404             last;
405         } else {
406             push(@comp_holdings, $curr_holding);
407             while ($runner le $holding) {
408                 # Here is where we used to get stuck in an infinite loop
409                 # until the "Don't know how to deal with frequency" was
410                 # elevated from a carp to a croak.
411                 $runner->increment;
412             }
413             $curr_holding = $holding->clone;
414             $seqno++;
415             $curr_holding->seqno($seqno);
416         }
417     }
418     push(@comp_holdings, $curr_holding);
419
420     return @comp_holdings;
421 }
422
423 #
424 # create an array of single holdings from all holdings for a given caption,
425 # decompressing as needed
426 #
427 # optional arguments:
428 #    skip_sort: do not sort the returned holdings
429 #    dedupe: remove any duplicate holdings from the set
430 #    passthru_open_ended: open-ended compressed holdings cannot be logically
431 #    decompressed (they are infinite); if set to true these holdings are passed
432 #    thru rather than skipped
433 # TODO: some of this could be moved to the Caption (and/or Holding) object to
434 # allow for decompression in the absense of an overarching MFHD object
435 #
436 sub get_decompressed_holdings {
437     my $self = shift;
438     my $caption = shift;
439     my $opts = shift;
440     my $skip_sort = $opts->{'skip_sort'};
441     my $dedupe = $opts->{'dedupe'};
442     my $passthru_open_ended = $opts->{'passthru_open_ended'};
443
444     if ($dedupe and $skip_sort) {
445         carp("Attempted deduplication without sorting, failure likely");
446     }
447
448     my @holdings = $self->holdings_by_caption($caption);
449
450     return () if !@holdings;
451
452     my @decomp_holdings;
453
454     foreach my $holding (@holdings) {
455         if (!$holding->is_compressed) {
456             push(@decomp_holdings, $holding->clone);
457         } elsif ($holding->is_open_ended) {
458             if ($passthru_open_ended) {
459                 push(@decomp_holdings, $holding->clone);
460             } else {
461                 carp("Open-ended holdings cannot be decompressed, skipping");
462             }
463         } else {
464             my $base_holding = $holding->clone->compressed_to_first;
465             my @new_holdings = $self->generate_predictions(
466                 {'base_holding' => $base_holding,
467                  'end_holding' => $holding->clone->compressed_to_last});
468             push(@decomp_holdings, $base_holding, @new_holdings);
469         }
470     }
471
472     unless ($skip_sort) {
473         my @temp_holdings = sort {$a cmp $b} @decomp_holdings;
474         @decomp_holdings = @temp_holdings;
475     }
476
477     my @return_holdings = (shift(@decomp_holdings));
478     $return_holdings[0]->seqno(1);
479     my $seqno = 2;
480     foreach my $holding (@decomp_holdings) { # renumber sequence
481         if ($holding eq $return_holdings[-1] and $dedupe) {
482             carp("Found duplicate holding in decompression set, discarding");
483             next;
484         }
485         $holding->seqno($seqno);
486         $seqno++;
487         push(@return_holdings, $holding);
488     }
489
490     return @return_holdings;
491 }
492
493 ##
494 ## close any open-ended holdings which are followed by another holding by
495 ## combining them
496 ##
497 ## This needs more thought about concerning usability (e.g. should it be a
498 ## mutator?), commenting out for now
499 #sub _get_truncated_holdings {
500 #    my $self = shift;
501 #    my $caption = shift;
502 #
503 #    my @holdings = $self->holdings_by_caption($caption);
504 #
505 #    return () if !@holdings;
506 #
507 #    @holdings = sort {$a cmp $b} @holdings;
508 #    
509 #    my $current_open_holding;
510 #    my @truncated_holdings;
511 #    foreach my $holding (@holdings) {
512 #        if ($current_open_holding) {
513 #            if ($holding->is_open_ended) {
514 #                next; # consecutive open holdings are meaningless, as they are contained by the previous
515 #            } elsif ($holding->is_compressed) {
516 #                $current_open_holding->compressed_end($holding->compressed_to_last);
517 #            } else {
518 #                $current_open_holding->compressed_end($holding);
519 #            }
520 #            push(@truncated_holdings, $current_open_holding);
521 #            $current_open_holding = undef;
522 #        } elsif ($holding->is_open_ended) {
523 #            $current_open_holding = $holding;
524 #        } else {
525 #            push(@truncated_holdings, $holding);
526 #        }
527 #    }
528 #    
529 #    # catch possible open holding at end
530 #    push(@truncated_holdings, $current_open_holding) if $current_open_holding;
531 #
532 #    my $seqno = 1;
533 #    foreach my $holding (@truncated_holdings) { # renumber sequence
534 #        $holding->seqno($seqno);
535 #        $seqno++;
536 #    }
537 #
538 #    return @truncated_holdings;
539 #}
540
541 #
542 # format_holdings(): Generate textual display of all holdings in record
543 # for given type of caption (853--855) taking into account all the
544 # captions, holdings statements, and textual
545 # holdings.
546 #
547 # returns string formatted holdings as one very long line.
548 # Caller must provide any label (such as "library has:" and insert
549 # line breaks as appropriate.
550
551 # Translate caption field labels to the corresponding textual holdings
552 # statement labels. That is, convert 853 "Basic bib unit" caption to
553 # 866 "basic bib unit" text holdings label.
554
555 my %cap_to_txt = (
556                   '853' => '866',
557                   '854' => '867',
558                   '855' => '868',
559                  );
560
561 sub format_holdings {
562     my $self = shift;
563     my $field = shift;
564     my $holdings_field;
565     my @txt_holdings;
566     my %txt_link_ids;
567     my $holdings_stmt = '';
568     my ($l, $start);
569
570     # convert caption field id to holdings field id
571     ($holdings_field = $field) =~ s/5/6/;
572
573     # Textual holdings statements complicate the basic algorithm for
574     # formatting the holdings: If there's a textual holdings statement
575     # with the subfield "$80", then that overrides ALL the MFHD holdings
576     # information and is all that is displayed. Otherwise, the textual
577     # holdings statements will either replace some of the MFHD holdings
578     # information, or supplement it, depending on the value of the
579     # $8 linkage subfield.
580
581     if (defined $self->field($cap_to_txt{$field})) {
582         @txt_holdings = $self->field($cap_to_txt{$field});
583
584         foreach my $txt (@txt_holdings) {
585
586             # if there's a $80 subfield, then we're done, it's
587             # all the formatted holdings
588             if ($txt->subfield('8') eq '0') {
589                 # textual holdings statement that completely
590                 # replaces MFHD holdings in 853/863, etc.
591                 $holdings_stmt = $txt->subfield('a');
592
593                 if (defined $txt->subfield('z')) {
594                     $holdings_stmt .= ' -- ' . $txt->subfield('z');
595                 }
596
597                 printf("# format_holdings() returning %s txt holdings\n",
598                        $cap_to_txt{$field});
599                 return $holdings_stmt;
600             }
601
602             # If there are non-$80 subfields in the textual holdings
603             # then we need to keep track of the subfields, so we can
604             # intersperse the textual holdings in with the the calculated
605             # holdings from the 853/863 fields.
606             foreach my $linkid ($txt->subfield('8')) {
607                 $txt_link_ids{$linkid} = $txt;
608             }
609         }
610     }
611
612     # Now loop through all the captions, finding the corresponding
613     # holdings statements (either MFHD or textual), and build up the
614     # complete formatted holdings statement. The textual holdings statements
615     # have either the same link id field as a caption, which means that
616     # the text holdings win, or they have ids that are interfiled with
617     # the captions, which mean they go into the middle.
618
619     my @ids = sort($self->caption_link_ids($field), keys %txt_link_ids);
620     foreach my $cap_id (@ids) {
621         my $last_txt = undef;
622
623         if (exists $txt_link_ids{$cap_id}) {
624             # there's a textual holding statement with this caption ID,
625             # so just use that. This covers both the "replaces" and
626             # the "supplements" holdings information options.
627
628             # a single textual holdings statement can replace multiple
629             # captions. If the _last_ caption we saw had a textual
630             # holdings statement, and this caption has the same one, then
631             # we don't add the holdings again.
632             if (!defined $last_txt || ($last_txt != $txt_link_ids{$cap_id})) {
633                 my $txt = $txt_link_ids{$cap_id};
634                 $holdings_stmt .= ',' if $holdings_stmt;
635                 $holdings_stmt .= $txt->subfield('a');
636                 if (defined $txt->subfield('z')) {
637                     $holdings_stmt .= ' -- ' . $txt->subfield('z');
638                 }
639
640                 $last_txt = $txt;
641             }
642             next;
643         }
644
645         # We found a caption that doesn't have a corresponding textual
646         # holdings statement, so reset $last_txt to undef.
647         $last_txt = undef;
648
649         my @holdings = $self->holdings($holdings_field, $cap_id);
650
651         next unless scalar @holdings;
652
653         # XXX Need to format compressed holdings. see code in test.pl
654         # for example. Try to do it without indexing?
655         $holdings_stmt .= ',' if $holdings_stmt;
656
657         if ($self->compressible) {
658             $start = $l = shift @holdings;
659             $holdings_stmt .= $l->format;
660
661             while (my $h = shift @holdings) {
662                 if (!$h->matches($l->next)) {
663                     # this item is not part of the current run,
664                     # close out the run and record this item
665                     if ($l != $start) {
666                         $holdings_stmt .= '-' . $l->format;
667                     }
668
669                     $holdings_stmt .= ',' . $h->format;
670                     $start = $h
671                 } elsif (!scalar(@holdings) || defined($h->subfield('z'))) {
672                     # This is the end of the holdings for this caption
673                     # or this item has a public note that we want
674                     # to display
675                     $holdings_stmt .= '-' . $h->format;
676                 }
677
678                 if (defined $h->subfield('z')) {
679                     $holdings_stmt .= ' -- ' . $h->subfield('z');
680                 }
681
682                 $l = $h;
683             }
684         } else {
685             $holdings_stmt .= ',' if $holdings_stmt;
686             $holdings_stmt .= (shift @holdings)->format;
687             foreach my $h (@holdings) {
688                 $holdings_stmt .= ',' . $h->format;
689                 if (defined $h->subfield('z')) {
690                     $holdings_stmt .= ' -- ' . $h->subfield('z');
691                 }
692             }
693         }
694     }
695
696     return $holdings_stmt;
697 }
698
699 1;