]> git.evergreen-ils.org Git - Evergreen.git/blob - Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD/Holding.pm
Merge remote branch 'working/user/shadowspar/ttopac-altcleanup' into template-toolkit...
[Evergreen.git] / Open-ILS / src / perlmods / lib / OpenILS / Utils / MFHD / Holding.pm
1 # MFHD::Holding provides some additional holdings logic to a MARC::Field
2 # object.  In its current state it is primarily read-only, as direct changes
3 # to the underlying MARC::Field are not reflected in the MFHD logic layer, and
4 # only the 'increment', 'notes', and 'seqno' methods do updates to the
5 # MARC::Field layer.
6
7 package MFHD::Holding;
8 use strict;
9 use integer;
10
11 use Carp;
12 use DateTime;
13 use Data::Dumper;
14
15 use base 'MARC::Field';
16
17 sub new {
18     my $proto     = shift;
19     my $class     = ref($proto) || $proto;
20     my $seqno     = shift;
21     my $self      = shift;
22     my $caption   = shift;
23     my $last_enum = undef;
24
25     $self->{_mfhdh_SEQNO}          = $seqno;
26     $self->{_mfhdh_CAPTION}        = $caption;
27     $self->{_mfhdh_DESCR}          = {};
28     $self->{_mfhdh_COPY}           = undef;
29     $self->{_mfhdh_BREAK}          = undef;
30     $self->{_mfhdh_NOTES}          = {};
31     $self->{_mfhdh_NOTES}{public}  = [];
32     $self->{_mfhdh_NOTES}{private} = [];
33     $self->{_mfhdh_COPYRIGHT}      = [];
34     $self->{_mfhdh_COMPRESSED}     = ($self->indicator(2) eq '0' || $self->indicator(2) eq '2') ? 1 : 0;
35     # TODO: full support for second indicators 2, 3, and 4
36     $self->{_mfhdh_OPEN_ENDED}     = 0;
37
38     foreach my $subfield ($self->subfields) {
39         my ($key, $val) = @$subfield;
40
41         if ($key =~ /[a-m]/) {
42             if (exists($self->{_mfhdh_FIELDS}->{$key})) {
43                 carp("Duplicate, non-repeatable subfield '$key' found, ignoring");
44                 next;
45             }
46             if ($self->{_mfhdh_COMPRESSED}) {
47                 $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [split(/\-/, $val, -1)];
48                 if (!defined($self->{_mfhdh_FIELDS}->{$key}{HOLDINGS}[1])) {
49                     $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS}[1] = $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS}[0];
50                 }
51             } else {
52                 $self->{_mfhdh_FIELDS}->{$key}{HOLDINGS} = [$val];
53             }
54             if ($key =~ /[a-h]/) {
55                 # Enumeration specific details of holdings
56                 $self->{_mfhdh_FIELDS}->{$key}{UNIT} = undef;
57                 $last_enum = $key;
58             }
59         } elsif ($key eq 'o') {
60             warn '$o specified prior to first enumeration'
61               unless defined($last_enum);
62             $self->{_mfhdh_FIELDS}->{$last_enum}->{UNIT} = $val;
63             $last_enum = undef;
64         } elsif ($key =~ /[npq]/) {
65             $self->{_mfhdh_DESCR}->{$key} = $val;
66         } elsif ($key eq 's') {
67             push @{$self->{_mfhdh_COPYRIGHT}}, $val;
68         } elsif ($key eq 't') {
69             $self->{_mfhdh_COPY} = $val;
70         } elsif ($key eq 'w') {
71             carp "Unrecognized break indicator '$val'"
72               unless $val =~ /^[gn]$/;
73             $self->{_mfhdh_BREAK} = $val;
74         } elsif ($key eq 'x') {
75             push @{$self->{_mfhdh_NOTES}{private}}, $val;
76         } elsif ($key eq 'z') {
77             push @{$self->{_mfhdh_NOTES}{public}}, $val;
78         }
79     }
80
81     if (   $self->{_mfhdh_COMPRESSED}
82         && $self->{_mfhdh_FIELDS}{'a'}{HOLDINGS}[1] eq '') {
83         $self->{_mfhdh_OPEN_ENDED} = 1;
84     }
85     bless($self, $class);
86     return $self;
87 }
88
89 #
90 # accessor to the object's field hash
91 #
92 # We are avoiding calling these elements 'subfields' because they are more
93 # than simply the MARC subfields, although in the current implementation they
94 # are indexed on the subfield key
95 #
96 # TODO: this accessor should probably be replaced with methods which hide the
97 # underlying structure of {_mfhdh_FIELDS} (see field_values for a start)
98 #
99 sub fields {
100     my $self = shift;
101
102     return $self->{_mfhdh_FIELDS};
103 }
104
105 #
106 # Given a field key, returns an array ref of one (for single statements)
107 # or two (for compressed statements) values
108 #
109 # TODO: add setter functionality to replace direct {HOLDINGS} access in other
110 # methods. It also makes sense to override some of the MARC::Field setter
111 # methods (such as update()) to accomplish this level of encapsulation.
112 #
113 sub field_values {
114     my ($self, $key) = @_;
115
116     if (exists $self->fields->{$key}) {
117         my @values = @{$self->fields->{$key}{HOLDINGS}};
118         return \@values;
119     } else {
120         return undef;
121     }
122 }
123
124 sub seqno {
125     my $self = shift;
126
127     if (@_) {
128         $self->{_mfhdh_SEQNO} = $_[0];
129         $self->update(8 => $self->caption->link_id . '.' . $_[0]);
130     }
131
132     return $self->{_mfhdh_SEQNO};
133 }
134
135 #
136 # Optionally accepts a true/false value to set the 'compressed' attribute
137 # Returns 'compressed' attribute
138 #
139 sub is_compressed {
140     my $self = shift;
141     my $is_compressed = shift;
142
143     if (defined($is_compressed)) {
144         if ($is_compressed) {
145             $self->{_mfhdh_COMPRESSED} = 1;
146             $self->update(ind2 => '0');
147         } else {
148             $self->{_mfhdh_COMPRESSED} = 0;
149             $self->update(ind2 => '1');
150         }
151     }
152
153     return $self->{_mfhdh_COMPRESSED};
154 }
155
156 sub is_open_ended {
157     my $self = shift;
158
159     return $self->{_mfhdh_OPEN_ENDED};
160 }
161
162 sub caption {
163     my $self = shift;
164
165     return $self->{_mfhdh_CAPTION};
166 }
167
168 #
169 # notes: If called with no arguments, returns the public notes array ref.
170 # If called with a single argument, it returns either 'public' or
171 # 'private' notes based on the passed string.
172 #
173 # If called with more than one argument, it sets the proper note field, with
174 # type being the first argument and the note value(s) as the remaining
175 # argument(s).
176 #
177 # It is also optional to pass in an array ref of note values as the third
178 # argument rather than a list.
179 #
180 sub notes {
181     my $self  = shift;
182     my $type  = shift;
183     my @notes = @_;
184
185     if (!$type) {
186         $type = 'public';
187     } elsif ($type ne 'public' && $type ne 'private') {
188         carp("Notes being applied without specifying type");
189         unshift(@notes, $type);
190         $type = 'public';
191     }
192
193     if (ref($notes[0])) {
194         $self->{_mfhdh_NOTES}{$type} = $notes[0];
195         $self->_replace_note_subfields($type, @{$notes[0]});
196     } elsif (@notes) {
197         if ($notes[0]) {
198             $self->{_mfhdh_NOTES}{$type} = \@notes;
199         } else {
200             $self->{_mfhdh_NOTES}{$type} = [];
201         }
202         $self->_replace_note_subfields($type, @notes);
203     }
204
205     return $self->{_mfhdh_NOTES}{$type};
206 }
207
208 #
209 # utility function for 'notes' method
210 #
211 sub _replace_note_subfields {
212     my $self              = shift;
213     my $type              = shift;
214     my @notes             = @_;
215     my %note_subfield_ids = ('public' => 'z', 'private' => 'x');
216
217     $self->delete_subfield(code => $note_subfield_ids{$type});
218
219     foreach my $note (@notes) {
220         $self->add_subfields($note_subfield_ids{$type} => $note);
221     }
222 }
223
224 #
225 # return a simple subfields list (for easier revivification from database)
226 #
227 sub subfields_list {
228     my $self = shift;
229     my @subfields;
230
231     foreach my $subfield ($self->subfields) {
232         push(@subfields, $subfield->[0], $subfield->[1]);
233     }
234     return @subfields;
235 }
236
237 #
238 # Called by method 'format_part' for formatting the chronology portion of
239 # the holding statement
240 #
241 sub format_chron {
242     my $self     = shift;
243     my $holdings = shift;
244     my $caption  = $self->caption;
245     my @keys     = @_;
246     my $str      = '';
247     my %month    = (
248         '01' => 'Jan.',
249         '02' => 'Feb.',
250         '03' => 'Mar.',
251         '04' => 'Apr.',
252         '05' => 'May ',
253         '06' => 'Jun.',
254         '07' => 'Jul.',
255         '08' => 'Aug.',
256         '09' => 'Sep.',
257         '10' => 'Oct.',
258         '11' => 'Nov.',
259         '12' => 'Dec.',
260         '21' => 'Spring',
261         '22' => 'Summer',
262         '23' => 'Autumn',
263         '24' => 'Winter'
264     );
265
266     foreach my $i (0..@keys) {
267         my $key = $keys[$i];
268         my $capstr;
269         my $chron;
270         my $sep;
271
272         last if !defined $caption->capstr($key);
273
274         $capstr = $caption->capstr($key);
275         if (substr($capstr, 0, 1) eq '(') {
276             # a caption enclosed in parentheses is not displayed
277             $capstr = '';
278         }
279
280         # If this is the second level of chronology, then it's
281         # likely to be a month or season, so we should use the
282         # string name rather than the number given.
283         if (($i == 1)) {
284             # account for possible combined issue chronology
285             my @chron_parts = split('/', $holdings->{$key});
286             for (my $i = 0; $i < @chron_parts; $i++) {
287                 $chron_parts[$i] = $month{$chron_parts[$i]} if exists $month{$chron_parts[$i]};
288             }
289             $chron = join('/', @chron_parts);
290         } else {
291             $chron = $holdings->{$key};
292         }
293
294         $str .= (($i == 0 || $str =~ /[. ]$/) ? '' : ':') . $capstr . $chron;
295     }
296
297     return $str;
298 }
299
300 #
301 # Called by method 'format' for each member of a possibly compressed holding
302 #
303 sub format_part {
304     my $self           = shift;
305     my $holding_values = shift;
306     my $caption        = $self->caption;
307     my $str            = '';
308
309     if ($caption->type_of_unit) {
310         $str = $caption->type_of_unit . ' ';
311     }
312
313     if ($caption->enumeration_is_chronology) {
314         # if issues are identified by chronology only, then the
315         # chronology data is stored in the enumeration subfields,
316         # so format those fields as if they were chronological.
317         $str = $self->format_chron($holding_values, 'a'..'f');
318     } else {
319         # OK, there is enumeration data and maybe chronology
320         # data as well, format both parts appropriately
321
322         # Enumerations
323         foreach my $key ('a'..'f') {
324             my $capstr;
325             my $chron;
326             my $sep;
327
328             last if !defined $caption->capstr($key);
329
330             $capstr = $caption->capstr($key);
331             if (substr($capstr, 0, 1) eq '(') {
332                 # a caption enclosed in parentheses is not displayed
333                 $capstr = '';
334             }
335             $str .=
336               ($key eq 'a' ? '' : ':') . $capstr . $holding_values->{$key};
337         }
338
339         # Chronology
340         if (defined $caption->capstr('i')) {
341             $str .= '(';
342             $str .= $self->format_chron($holding_values, 'i'..'l');
343             $str .= ')';
344         }
345
346         if ($caption->capstr('g')) {
347             # There's at least one level of alternative enumeration
348             $str .= '=';
349             foreach my $key ('g', 'h') {
350                 $str .=
351                     ($key eq 'g' ? '' : ':')
352                   . $caption->capstr($key)
353                   . $holding_values->{$key};
354             }
355
356             # This assumes that alternative chronology is only ever
357             # provided if there is an alternative enumeration.
358             if ($caption->capstr('m')) {
359                 # Alternative Chronology
360                 $str .= '(';
361                 $str .= $caption->capstr('m') . $holding_values->{'m'};
362                 $str .= ')';
363             }
364         }
365     }
366
367     # Breaks in the sequence
368 # XXX: this is non-standard and also not the right place for this, since gaps
369 # only make sense in the context of multiple holding segments, not a single
370 # holding
371 #    if (defined($self->{_mfhdh_BREAK})) {
372 #        if ($self->{_mfhdh_BREAK} eq 'n') {
373 #            $str .= ' non-gap break';
374 #        } elsif ($self->{_mfhdh_BREAK} eq 'g') {
375 #            $str .= ' gap';
376 #        } else {
377 #            warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'";
378 #        }
379 #    }
380 #
381     return $str;
382 }
383
384 #
385 # Create and return a string which conforms to display standard Z39.71
386 #
387 sub format {
388     my $self      = shift;
389     my $subfields = $self->fields;
390     my %holding_start;
391     my %holding_end;
392     my $formatted;
393
394     foreach my $key (keys %$subfields) {
395         ($holding_start{$key}, $holding_end{$key}) =
396           @{$self->field_values($key)};
397     }
398
399     if ($self->is_compressed) {
400         # deal with open-ended statements
401         my $formatted_end;
402         if ($self->is_open_ended) {
403             $formatted_end = '';
404         } else {
405             $formatted_end = $self->format_part(\%holding_end);
406         }
407         $formatted =
408           $self->format_part(\%holding_start) . ' - ' . $formatted_end;
409     } else {
410         $formatted = $self->format_part(\%holding_start);
411     }
412
413     # Public Note
414     if (@{$self->notes}) {
415         $formatted .= ' -- ' . join(', ', @{$self->notes});
416     }
417
418     return $formatted;
419 }
420
421 # next: Given a holding statement, return a hash containing the
422 # enumeration values for the next issues, whether we hold it or not
423 # Just pass through to Caption::next
424 #
425 sub next {
426     my $self    = shift;
427     my $caption = $self->caption;
428
429     return $caption->next($self);
430 }
431
432 #
433 # matches($pat): check to see if $self matches the enumeration hashref passed
434 # in as $pat, as returned by the 'next' method. e.g.:
435 # $holding2->matches($holding1->next) # true if $holding2 directly follows
436 # $holding1
437 #
438 # Always returns false if $self is compressed
439 #
440 sub matches {
441     my $self = shift;
442     my $pat  = shift;
443
444     return 0 if $self->is_compressed;
445
446     foreach my $key ('a'..'f') {
447         # If a subfield exists in $self but not in $pat, or vice versa
448         # or if the field has different values, then fail
449         if (
450             defined($self->field_values($key)) != exists($pat->{$key})
451             || (exists $pat->{$key}
452                 && ($self->field_values($key)->[0] ne $pat->{$key}))
453           ) {
454             return 0;
455         }
456     }
457     return 1;
458 }
459
460 #
461 # Check that all the fields in a holdings statement are
462 # included in the corresponding caption.
463 #
464 sub validate {
465     my $self = shift;
466
467     foreach my $key (keys %{$self->fields}) {
468         if (!$self->caption || !$self->caption->capfield($key)) {
469             return 0;
470         }
471     }
472     return 1;
473 }
474
475 #
476 # Replace a single holding with it's next prediction
477 # and return itself
478 #
479 sub increment {
480     my $self = shift;
481
482     if ($self->is_open_ended) {
483         carp "Holding is open-ended, cannot increment";
484         return $self;
485     } elsif ($self->is_compressed) {
486         carp "Incrementing a compressed holding is deprecated, use extend instead";
487         return $self->extend;
488     }
489
490     my $next = $self->next();
491
492     foreach my $key (keys %{$next}) {
493         $self->fields->{$key}{HOLDINGS}[0] = $next->{$key};
494     }
495
496     $self->seqno($self->seqno + 1);
497     $self->update(%{$next});    # update underlying subfields
498     return $self;
499 }
500
501 #
502 # Extends a holding (compressing if needed) to include the next
503 # prediction and returns itself
504 #
505 sub extend {
506     my $self = shift;
507
508     if ($self->is_open_ended) {
509         carp "Holding is open-ended, cannot extend";
510         return $self;
511     }
512
513     my $next = $self->next();
514
515     if (!$self->is_compressed) {
516         $self->is_compressed(1);  # add compressed state
517     }
518
519     foreach my $key (keys %{$next}) {
520         my @values = @{$self->field_values($key)};
521         $values[1] = $next->{$key};
522         $self->fields->{$key}{HOLDINGS} = \@values;
523         $next->{$key} = join('-', @values);
524     }
525
526     $self->update(%{$next});    # update underlying subfields
527     return $self;
528 }
529
530 #
531 # Turns a compressed holding into the singular form of the first member
532 # in the range
533 #
534 sub compressed_to_first {
535     my $self = shift;
536
537     if (!$self->is_compressed) {
538         carp "Holding not compressed, cannot convert to first member";
539         return $self;
540     }
541
542     my %changes;
543     foreach my $key (keys %{$self->fields}) {
544         my @values = @{$self->field_values($key)};
545         $self->fields->{$key}{HOLDINGS} = [$values[0]];
546         $changes{$key} = $values[0];
547     }
548
549     $self->update(%changes);    # update underlying subfields
550     $self->is_compressed(0);    # remove compressed state
551
552     return $self;
553 }
554
555 #
556 # Turns a compressed holding into the singular form of the last member
557 # in the range
558 #
559 sub compressed_to_last {
560     my $self = shift;
561
562     if (!$self->is_compressed) {
563         carp "Holding not compressed, cannot convert to last member";
564         return $self;
565     } elsif ($self->is_open_ended) {
566         carp "Holding is open-ended, cannot convert to last member";
567         return undef;
568     }
569
570     my %changes;
571     foreach my $key (keys %{$self->fields}) {
572         my @values = @{$self->field_values($key)};
573         $self->fields->{$key}{HOLDINGS} = [$values[1]];
574         $changes{$key} = $values[1];
575     }
576
577     $self->update(%changes);    # update underlying subfields
578     $self->is_compressed(0);    # remove compressed state
579
580     return $self;
581 }
582
583 #
584 # Creates or replaces an end of a compressed holding
585 #
586 sub compressed_end {
587     my $self = shift;
588     my $end_holding = shift;
589
590     my %changes;
591     if ($end_holding) {
592         foreach my $key (keys %{$self->fields}) {
593             my @values = @{$self->field_values($key)};
594             my @end_values = @{$end_holding->field_values($key)};
595             $values[1] = $end_values[0];
596             $self->fields->{$key}{HOLDINGS} = \@values;
597             $changes{$key} = join('-', @values);
598         }
599     } elsif (!$self->is_open_ended) { # make open-ended if no $end_holding
600         foreach my $key (keys %{$self->fields}) {
601             my @values = @{$self->field_values($key)};
602             $self->fields->{$key}{HOLDINGS} = [$values[0]];
603             $changes{$key} = $values[0] . '-';
604         }
605         $self->{_mfhdh_OPEN_ENDED} = 1; #TODO: setter for this value
606     }
607
608     $self->update(%changes);    # update underlying subfields
609
610     if (!$self->is_compressed) {
611         $self->is_compressed(1);  # add compressed state
612     }
613
614     return $self;
615 }
616
617 #
618 # Basic, working, unoptimized clone operation
619 #
620 sub clone {
621     my $self = shift;
622
623     my $clone_field = $self->SUPER::clone();
624     return new MFHD::Holding($self->seqno, $clone_field, $self->caption);
625 }
626
627 #
628 # Turn a chronology instance into date(s) in YYYY-MM-DD format
629 #
630 # In list context it returns a list of start and (possibly undefined)
631 # end dates
632 #
633 # In scalar context, it returns a YYYY-MM-DD date string of either the
634 # single date or the (possibly undefined) end date of a compressed holding
635 #
636 sub chron_to_date {
637     my $self    = shift;
638     my $caption = $self->caption;
639
640     my @keys;
641     if ($caption->enumeration_is_chronology) {
642         @keys = ('a'..'f');
643     } else {
644         @keys = ('i'..'m');
645     }
646
647     # @chron_start and @chron_end will hold the (year, month, day) values
648     # represented by the start and optional end of the chronology instance.
649     # Default to January 1 with a year of 0 as initial values.
650     my @chron_start = (0, 1, 1);
651     my @chron_end   = (0, 1, 1);
652     my @chrons = (\@chron_start, \@chron_end);
653     foreach my $key (@keys) {
654         my $capstr = $caption->capstr($key);
655         last if !defined($capstr);
656         if ($capstr =~ /year/) {
657             ($chron_start[0], $chron_end[0]) = @{$self->field_values($key)};
658         } elsif ($capstr =~ /month/) {
659             ($chron_start[1], $chron_end[1]) = @{$self->field_values($key)};
660         } elsif ($capstr =~ /day/) {
661             ($chron_start[2], $chron_end[2]) = @{$self->field_values($key)};
662         } elsif ($capstr =~ /season/) {
663             # chrons defined as season-only will use the astronomical season
664             # dates as a basic estimate.
665             my @seasons = @{$self->field_values($key)};
666             for (my $i = 0; $i < @seasons; $i++) {
667                 $seasons[$i] = &_uncombine($seasons[$i], 0);
668                 if ($seasons[$i] == 21) {
669                     $chrons[$i]->[1] = 3;
670                     $chrons[$i]->[2] = 20;
671                 } elsif ($seasons[$i] == 22) {
672                     $chrons[$i]->[1] = 6;
673                     $chrons[$i]->[2] = 21;
674                 } elsif ($seasons[$i] == 23) {
675                     $chrons[$i]->[1] = 9;
676                     $chrons[$i]->[2] = 22;
677                 } elsif ($seasons[$i] == 24) {
678                     # "winter" can come at the beginning or end of a year,
679                     if ($self->caption->winter_starts_year()) {
680                         $chrons[$i]->[1] = 1;
681                         $chrons[$i]->[2] = 1;
682                     } else { # default to astronomical
683                         $chrons[$i]->[1] = 12;
684                         $chrons[$i]->[2] = 21;
685                     }
686                 }
687             }
688         }
689     }
690
691     # if we have an an annual, set the month to ypm## if available
692     if (exists($self->caption->{_mfhdc_PATTERN}->{y}->{p}) and $self->caption->{_mfhdc_PATTERN}->{w} eq 'a') {
693         my $reg = $self->caption->{_mfhdc_PATTERN}->{y}->{p}->[0];
694         if ($reg =~ /^m(\d+)/) {
695             $chrons[0]->[1] = $1;
696             $chrons[1]->[1] = $1;
697         }
698     }
699
700     my @dates;
701     foreach my $chron (@chrons) {
702         my $date = undef;
703         if ($chron->[0] != 0) {
704             $date =
705                 &_uncombine($chron->[0], 0) . '-'
706               . sprintf('%02d', $chron->[1]) . '-'
707               . sprintf('%02d', $chron->[2]);
708         }
709         push(@dates, $date);
710     }
711
712     if (wantarray()) {
713         return @dates;
714     } elsif ($self->is_compressed) {
715         return $dates[1];
716     } else {
717         return $dates[0];
718     }
719 }
720
721 #
722 # utility function for uncombining instance parts
723 #
724 sub _uncombine {
725     my ($combo, $pos) = @_;
726
727     if (ref($combo)) {
728         carp("Function '_uncombine' is not an instance method");
729         return;
730     }
731
732     my @parts = split('/', $combo);
733     return $parts[$pos];
734 }
735
736 #
737 # Overload string comparison operators
738 #
739 # We are not overloading '<=>' because '==' is used liberally in MARC::Record
740 # to compare field identity (i.e. is this the same exact Field object?), not value
741 #
742 # Other string operators are auto-generated from 'cmp'
743 #
744 # Please note that this comparison is based on what the holding represents,
745 # not whether it is strictly identical (e.g. the seqno and link may vary)
746 #
747 # XXX: sorting using this operator is currently not deterministic for
748 # nonsensical holdings (e.g. V.10-V.5), and may require further consideration
749 use overload ('cmp' => \&_compare,
750               'fallback' => 1);
751 sub _compare {
752     my ($holding_1, $holding_2, $swap) = @_;
753
754     # TODO: this needs some more consideration
755     # fall back to 'built-in' comparison
756     if (!UNIVERSAL::isa($holding_2, ref $holding_1)) {
757         if (defined $holding_2) {
758             carp("Use of non-holding in holding comparison operation") if $holding_2 ne '~~~';
759             if ($swap) {
760                 return ( "$holding_2" cmp "$holding_1" );
761             } else {
762                 return ( "$holding_1" cmp "$holding_2" );
763             }
764         } else {
765             carp("Use of undefined value in holding comparison operation");
766             return 1; # similar to built-in, something is "greater than" nothing
767         }
768     }
769
770     # special cases for compressed holdings
771     my ($holding_1_first, $holding_1_last, $holding_2_first, $holding_2_last, $found_compressed);
772     # 0 for no compressed, 1 for first compressed, 2 for second compressed, 3 for both compressed
773     $found_compressed = 0; 
774     if ($holding_1->is_compressed) {
775         if (!$holding_1->is_open_ended) {
776             $holding_1_last = $holding_1->clone->compressed_to_last;
777         } else {
778             $holding_1_last = '~~~'; # take advantage of string sort fallback
779         }
780         $found_compressed += 1;
781     } else {
782         $holding_1_first = $holding_1;
783         $holding_1_last = $holding_1;
784     }
785     if ($holding_2->is_compressed) {
786         $holding_2_first = $holding_2->clone->compressed_to_first;
787         $found_compressed += 2;
788     } else {
789         $holding_2_first = $holding_2;
790         $holding_2_last = $holding_2;
791     }
792
793     if ($found_compressed) {
794         my $cmp = ($holding_1_last cmp $holding_2_first); # 1 ends before 2 starts
795         if ($cmp == -1) {
796             return -1; # 1 is fully lt
797         } elsif ($cmp == 0) {
798             carp("Overlapping holdings in comparison, lt and gt based on start value only");
799             return -1;
800         } else { # check the opposite, 2 ends before 1 starts
801             # clone is expensive, wait until we need it (here)
802             if (!defined($holding_2_last)) {
803                 if (!$holding_2->is_open_ended) {
804                     $holding_2_last = $holding_2->clone->compressed_to_last;
805                 } else {
806                     $holding_2_last = '~~~'; # take advantage of string sort fallback
807                 }
808             }
809             if (!defined($holding_1_first)) {
810                 $holding_1_first = $holding_1->clone->compressed_to_first;
811             }
812             $cmp = ($holding_2_last cmp $holding_1_first);
813             if ($cmp == -1) {
814                 return 1; # 1 is fully gt
815             } elsif ($cmp == 0) {
816                 carp("Overlapping holdings in comparison, lt and gt based on start value only");
817                 return 1;
818             } else {
819                 $cmp = ($holding_1_first cmp $holding_2_first);
820                 if ($cmp) { # they are not equal
821                     carp("Overlapping holdings in comparison, lt and gt based on start value only");
822                     return $cmp;
823                 } elsif ($found_compressed == 1) {
824                     carp("Compressed holding found with start equal to non-compressed holding");
825                     return 1; # compressed (first holding) is 'greater than' non-compressed
826                 } elsif ($found_compressed == 2) {
827                     carp("Compressed holding found with start equal to non-compressed holding");
828                     return -1; # compressed (second holding) is 'greater than' non-compressed
829                 } else { # both holdings compressed, check for full equality
830                     $cmp = ($holding_1_last cmp $holding_2_last);
831                     if ($cmp) { # they are not equal
832                         carp("Compressed holdings in comparison have equal starts, lt and gt based on end value only");
833                         return $cmp;
834                     } else {
835                         return 0; # both are compressed, both ends are equal
836                     }
837                 }
838             }
839         }
840     }
841
842     # start doing the actual comparison
843     my $result;
844     foreach my $key ('a'..'f') {
845         if (defined($holding_1->field_values($key))) {
846             if (!defined($holding_2->field_values($key))) {
847                 return 1; # more details equals 'greater' (?)
848             } else {
849                 $result = $holding_1->field_values($key)->[0] <=> $holding_2->field_values($key)->[0];
850             }
851         } elsif (defined($holding_2->field_values($key))) {
852             return -1; # more details equals 'greater' (?)
853         }
854
855         return $result if $result;
856     }
857
858     # got through, return 0 for equal
859     return 0;
860 }
861
862 1;