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