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 my %__mfhd_month_labels = (
 237     '01' => ['Jan.', 'January'],
 238     '02' => ['Feb.', 'February'],
 239     '03' => ['Mar.', 'March'],
 240     '04' => ['Apr.', 'April'],
 241     '05' => ['May ', 'May'],
 242     '06' => ['Jun.', 'June'],
 243     '07' => ['Jul.', 'July'],
 244     '08' => ['Aug.', 'August'],
 245     '09' => ['Sep.', 'September'],
 246     '10' => ['Oct.', 'October'],
 247     '11' => ['Nov.', 'November'],
 248     '12' => ['Dec.', 'December'],
 249     '21' => 'Spring',
 250     '22' => 'Summer',
 251     '23' => 'Autumn',
 252     '24' => 'Winter'
 253 );
 254
 255 sub _get_mfhd_month_label {
 256     my ($month, $long) = @_;
 257     $long ||= 0;
 258
 259     my $o = $__mfhd_month_labels{$month};
 260     return (ref $o) ? $o->[$long] : $o;
 261 }
 262
 263 # Called by method 'format_chron'
 264 #
 265 sub format_single_chron {
 266     my $self = shift;
 267     my $holdings = shift;
 268     my $key = shift;
 269     my $skip_sep = shift;
 270     my $long = shift;
 271     my $capstr;
 272     my $chron;
 273     my $sep = ':';
 274
 275     return if !defined $self->caption->capstr($key);
 276
 277     $capstr = $self->caption->capstr($key);
 278     if (substr($capstr, 0, 1) eq '(') {
 279         # a caption enclosed in parentheses is not displayed
 280         $capstr = '';
 281     }
 282
 283     # If this is the second level of chronology, then it's
 284     # likely to be a month or season, so we should use the
 285     # string name rather than the number given.
 286     if ($key eq 'b' or $key eq 'j') {
 287         # account for possible combined issue chronology
 288         my @chron_parts = split('/', $holdings->{$key});
 289         for (my $i = 0; $i < @chron_parts; $i++) {
 290             my $month_label =  _get_mfhd_month_label($chron_parts[$i], $long);
 291             $chron_parts[$i] = $month_label if defined $month_label;
 292         }
 293         $chron = join('/', @chron_parts);
 294     } else {
 295         $chron = $holdings->{$key};
 296     }
 297
 298     $skip_sep ||= ($key eq 'a' || $key eq 'i');
 299
 300     return ($skip_sep ? '' : $sep) . $capstr . $chron;
 301 }
 302
 303 #
 304 # Called by method 'format_part' for formatting the chronology portion of
 305 # the holding statement
 306 #
 307 sub format_chron {
 308     my $self     = shift;
 309     my $holdings = shift;
 310     my @keys     = @_;
 311     my $str      = '';
 312
 313     foreach my $key (@keys) {
 314         my $skip_sep = ($str =~ /[. ]$/);
 315         my $new_part = $self->format_single_chron($holdings, $key, $skip_sep);
 316         last unless defined $new_part;
 317         $str .= $new_part;
 318     }
 319
 320     return $str;
 321 }
 322
 323 #
 324 # Called by method 'format_part' for each enum subfield
 325 #
 326 sub format_single_enum {
 327     my $self = shift;
 328     my $holding_values = shift;
 329     my $key = shift;
 330     my $skip_sep = shift;
 331     my $capstr;
 332     my $chron;
 333     my $sep = ':';
 334
 335     return if !defined $self->caption->capstr($key);
 336
 337     $capstr = $self->caption->capstr($key);
 338     if (substr($capstr, 0, 1) eq '(') {
 339         # a caption enclosed in parentheses is not displayed
 340         $capstr = '';
 341     } elsif ($skip_sep) {
 342         # We'll let a $skip_sep parameter of true mean what it means down by
 343         # the return statement AND to pad the caption itself here.
 344         $capstr .= ' ';
 345     }
 346
 347
 348     $skip_sep ||= ($key eq 'a');
 349     return ($skip_sep ? '' : $sep) . $capstr . $holding_values->{$key};
 350 }
 351
 352 #
 353 # Called by method 'format' for each member of a possibly compressed holding
 354 #
 355 sub format_part {
 356     my $self           = shift;
 357     my $holding_values = shift;
 358     my $caption        = $self->caption;
 359     my $str            = '';
 360
 361     if ($caption->type_of_unit) {
 362         $str = $caption->type_of_unit . ' ';
 363     }
 364
 365     if ($caption->enumeration_is_chronology) {
 366         # if issues are identified by chronology only, then the
 367         # chronology data is stored in the enumeration subfields,
 368         # so format those fields as if they were chronological.
 369         $str = $self->format_chron($holding_values, 'a'..'f');
 370     } else {
 371         # OK, there is enumeration data and maybe chronology
 372         # data as well, format both parts appropriately
 373
 374         # Enumerations
 375         foreach my $key ('a'..'f') {
 376             my $new_part = $self->format_single_enum($holding_values, $key);
 377             last unless defined $new_part;
 378             $str .= $new_part;
 379         }
 380
 381         # Chronology
 382         if (defined $caption->capstr('i')) {
 383             $str .= '(';
 384             $str .= $self->format_chron($holding_values, 'i'..'l');
 385             $str .= ')';
 386         }
 387
 388         if ($caption->capstr('g')) {
 389             # There's at least one level of alternative enumeration
 390             $str .= '=';
 391             foreach my $key ('g', 'h') {
 392                 $str .=
 393                     ($key eq 'g' ? '' : ':')
 394                   . $caption->capstr($key)
 395                   . $holding_values->{$key};
 396             }
 397
 398             # This assumes that alternative chronology is only ever
 399             # provided if there is an alternative enumeration.
 400             if ($caption->capstr('m')) {
 401                 # Alternative Chronology
 402                 $str .= '(';
 403                 $str .= $caption->capstr('m') . $holding_values->{'m'};
 404                 $str .= ')';
 405             }
 406         }
 407     }
 408
 409     # Breaks in the sequence
 410 # XXX: this is non-standard and also not the right place for this, since gaps
 411 # only make sense in the context of multiple holding segments, not a single
 412 # holding
 413 #    if (defined($self->{_mfhdh_BREAK})) {
 414 #        if ($self->{_mfhdh_BREAK} eq 'n') {
 415 #            $str .= ' non-gap break';
 416 #        } elsif ($self->{_mfhdh_BREAK} eq 'g') {
 417 #            $str .= ' gap';
 418 #        } else {
 419 #            warn "unrecognized break indicator '$self->{_mfhdh_BREAK}'";
 420 #        }
 421 #    }
 422 #
 423     return $str;
 424 }
 425
 426 #
 427 # Create and return a string which conforms to display standard Z39.71
 428 #
 429 sub format {
 430     my $self      = shift;
 431     my $subfields = $self->fields;
 432     my %holding_start;
 433     my %holding_end;
 434     my $formatted;
 435
 436     foreach my $key (keys %$subfields) {
 437         ($holding_start{$key}, $holding_end{$key}) =
 438           @{$self->field_values($key)};
 439     }
 440
 441     if ($self->is_compressed) {
 442         # deal with open-ended statements
 443         my $formatted_end;
 444         if ($self->is_open_ended) {
 445             $formatted_end = '';
 446         } else {
 447             $formatted_end = $self->format_part(\%holding_end);
 448         }
 449         $formatted =
 450           $self->format_part(\%holding_start) . ' - ' . $formatted_end;
 451     } else {
 452         $formatted = $self->format_part(\%holding_start);
 453     }
 454
 455     # Public Note
 456     if (@{$self->notes}) {
 457         $formatted .= ' -- ' . join(', ', @{$self->notes});
 458     }
 459
 460     return $formatted;
 461 }
 462
 463 # next: Given a holding statement, return a hash containing the
 464 # enumeration values for the next issues, whether we hold it or not
 465 # Just pass through to Caption::next
 466 #
 467 sub next {
 468     my $self    = shift;
 469     my $caption = $self->caption;
 470
 471     return $caption->next($self);
 472 }
 473
 474 #
 475 # matches($pat): check to see if $self matches the enumeration hashref passed
 476 # in as $pat, as returned by the 'next' method. e.g.:
 477 # $holding2->matches($holding1->next) # true if $holding2 directly follows
 478 # $holding1
 479 #
 480 # Always returns false if $self is compressed
 481 #
 482 sub matches {
 483     my $self = shift;
 484     my $pat  = shift;
 485
 486     return 0 if $self->is_compressed;
 487
 488     foreach my $key ('a'..'f') {
 489         # If a subfield exists in $self but not in $pat, or vice versa
 490         # or if the field has different values, then fail
 491         if (
 492             defined($self->field_values($key)) != exists($pat->{$key})
 493             || (exists $pat->{$key}
 494                 && ($self->field_values($key)->[0] ne $pat->{$key}))
 495           ) {
 496             return 0;
 497         }
 498     }
 499     return 1;
 500 }
 501
 502 #
 503 # Check that all the fields in a holdings statement are
 504 # included in the corresponding caption.
 505 #
 506 sub validate {
 507     my $self = shift;
 508
 509     foreach my $key (keys %{$self->fields}) {
 510         if (!$self->caption || !$self->caption->capfield($key)) {
 511             return 0;
 512         }
 513     }
 514     return 1;
 515 }
 516
 517 #
 518 # Replace a single holding with it's next prediction
 519 # and return itself
 520 #
 521 sub increment {
 522     my $self = shift;
 523
 524     if ($self->is_open_ended) {
 525         carp "Holding is open-ended, cannot increment";
 526         return $self;
 527     } elsif ($self->is_compressed) {
 528         carp "Incrementing a compressed holding is deprecated, use extend instead";
 529         return $self->extend;
 530     }
 531
 532     my $next = $self->next();
 533
 534     foreach my $key (keys %{$next}) {
 535         $self->fields->{$key}{HOLDINGS}[0] = $next->{$key};
 536     }
 537
 538     $self->seqno($self->seqno + 1);
 539     $self->update(%{$next});    # update underlying subfields
 540     return $self;
 541 }
 542
 543 #
 544 # Extends a holding (compressing if needed) to include the next
 545 # prediction and returns itself
 546 #
 547 sub extend {
 548     my $self = shift;
 549
 550     if ($self->is_open_ended) {
 551         carp "Holding is open-ended, cannot extend";
 552         return $self;
 553     }
 554
 555     my $next = $self->next();
 556
 557     if (!$self->is_compressed) {
 558         $self->is_compressed(1);  # add compressed state
 559     }
 560
 561     foreach my $key (keys %{$next}) {
 562         my @values = @{$self->field_values($key)};
 563         $values[1] = $next->{$key};
 564         $self->fields->{$key}{HOLDINGS} = \@values;
 565         $next->{$key} = join('-', @values);
 566     }
 567
 568     $self->update(%{$next});    # update underlying subfields
 569     return $self;
 570 }
 571
 572 #
 573 # Turns a compressed holding into the singular form of the first member
 574 # in the range
 575 #
 576 sub compressed_to_first {
 577     my $self = shift;
 578
 579     if (!$self->is_compressed) {
 580         carp "Holding not compressed, cannot convert to first member";
 581         return $self;
 582     }
 583
 584     my %changes;
 585     foreach my $key (keys %{$self->fields}) {
 586         my @values = @{$self->field_values($key)};
 587         $self->fields->{$key}{HOLDINGS} = [$values[0]];
 588         $changes{$key} = $values[0];
 589     }
 590
 591     $self->update(%changes);    # update underlying subfields
 592     $self->is_compressed(0);    # remove compressed state
 593
 594     return $self;
 595 }
 596
 597 #
 598 # Turns a compressed holding into the singular form of the last member
 599 # in the range
 600 #
 601 sub compressed_to_last {
 602     my $self = shift;
 603
 604     if (!$self->is_compressed) {
 605         carp "Holding not compressed, cannot convert to last member";
 606         return $self;
 607     } elsif ($self->is_open_ended) {
 608         carp "Holding is open-ended, cannot convert to last member";
 609         return undef;
 610     }
 611
 612     my %changes;
 613     foreach my $key (keys %{$self->fields}) {
 614         my @values = @{$self->field_values($key)};
 615         $self->fields->{$key}{HOLDINGS} = [$values[1]];
 616         $changes{$key} = $values[1];
 617     }
 618
 619     $self->update(%changes);    # update underlying subfields
 620     $self->is_compressed(0);    # remove compressed state
 621
 622     return $self;
 623 }
 624
 625 #
 626 # Creates or replaces an end of a compressed holding
 627 #
 628 sub compressed_end {
 629     my $self = shift;
 630     my $end_holding = shift;
 631
 632     my %changes;
 633     if ($end_holding) {
 634         foreach my $key (keys %{$self->fields}) {
 635             my @values = @{$self->field_values($key)};
 636             my @end_values = @{$end_holding->field_values($key)};
 637             $values[1] = $end_values[0];
 638             $self->fields->{$key}{HOLDINGS} = \@values;
 639             $changes{$key} = join('-', @values);
 640         }
 641     } elsif (!$self->is_open_ended) { # make open-ended if no $end_holding
 642         foreach my $key (keys %{$self->fields}) {
 643             my @values = @{$self->field_values($key)};
 644             $self->fields->{$key}{HOLDINGS} = [$values[0]];
 645             $changes{$key} = $values[0] . '-';
 646         }
 647         $self->{_mfhdh_OPEN_ENDED} = 1; #TODO: setter for this value
 648     }
 649
 650     $self->update(%changes);    # update underlying subfields
 651
 652     if (!$self->is_compressed) {
 653         $self->is_compressed(1);  # add compressed state
 654     }
 655
 656     return $self;
 657 }
 658
 659 #
 660 # Basic, working, unoptimized clone operation
 661 #
 662 sub clone {
 663     my $self = shift;
 664
 665     my $clone_field = $self->SUPER::clone();
 666     return new MFHD::Holding($self->seqno, $clone_field, $self->caption);
 667 }
 668
 669 #
 670 # Turn a chronology instance into date(s) in YYYY-MM-DD format
 671 #
 672 # In list context it returns a list of start and (possibly undefined)
 673 # end dates
 674 #
 675 # In scalar context, it returns a YYYY-MM-DD date string of either the
 676 # single date or the (possibly undefined) end date of a compressed holding
 677 #
 678 sub chron_to_date {
 679     my $self    = shift;
 680     my $caption = $self->caption;
 681
 682     my @keys;
 683     if ($caption->enumeration_is_chronology) {
 684         @keys = ('a'..'f');
 685     } else {
 686         @keys = ('i'..'m');
 687     }
 688
 689     # @chron_start and @chron_end will hold the (year, month, day) values
 690     # represented by the start and optional end of the chronology instance.
 691     # Default to January 1 with a year of 0 as initial values.
 692     my @chron_start = (0, 1, 1);
 693     my @chron_end   = (0, 1, 1);
 694     my @chrons = (\@chron_start, \@chron_end);
 695     foreach my $key (@keys) {
 696         my $capstr = $caption->capstr($key);
 697         last if !defined($capstr);
 698         if ($capstr =~ /year/) {
 699             ($chron_start[0], $chron_end[0]) = @{$self->field_values($key)};
 700         } elsif ($capstr =~ /month/) {
 701             ($chron_start[1], $chron_end[1]) = @{$self->field_values($key)};
 702         } elsif ($capstr =~ /day/) {
 703             ($chron_start[2], $chron_end[2]) = @{$self->field_values($key)};
 704         } elsif ($capstr =~ /season/) {
 705             # chrons defined as season-only will use the astronomical season
 706             # dates as a basic estimate.
 707             my @seasons = @{$self->field_values($key)};
 708             for (my $i = 0; $i < @seasons; $i++) {
 709                 $seasons[$i] = &_uncombine($seasons[$i], 0);
 710                 if ($seasons[$i] == 21) {
 711                     $chrons[$i]->[1] = 3;
 712                     $chrons[$i]->[2] = 20;
 713                 } elsif ($seasons[$i] == 22) {
 714                     $chrons[$i]->[1] = 6;
 715                     $chrons[$i]->[2] = 21;
 716                 } elsif ($seasons[$i] == 23) {
 717                     $chrons[$i]->[1] = 9;
 718                     $chrons[$i]->[2] = 22;
 719                 } elsif ($seasons[$i] == 24) {
 720                     # "winter" can come at the beginning or end of a year,
 721                     if ($self->caption->winter_starts_year()) {
 722                         $chrons[$i]->[1] = 1;
 723                         $chrons[$i]->[2] = 1;
 724                     } else { # default to astronomical
 725                         $chrons[$i]->[1] = 12;
 726                         $chrons[$i]->[2] = 21;
 727                     }
 728                 }
 729             }
 730         }
 731     }
 732
 733     # if we have an an annual, set the month to ypm## if available
 734     if (exists($self->caption->{_mfhdc_PATTERN}->{y}->{p}) and $self->caption->{_mfhdc_PATTERN}->{w} eq 'a') {
 735         my $reg = $self->caption->{_mfhdc_PATTERN}->{y}->{p}->[0];
 736         if ($reg =~ /^m(\d+)/) {
 737             $chrons[0]->[1] = $1;
 738             $chrons[1]->[1] = $1;
 739         }
 740     }
 741
 742     my @dates;
 743     foreach my $chron (@chrons) {
 744         my $date = undef;
 745         if ($chron->[0] != 0) {
 746             $date =
 747                 &_uncombine($chron->[0], 0) . '-'
 748               . sprintf('%02d', $chron->[1]) . '-'
 749               . sprintf('%02d', $chron->[2]);
 750         }
 751         push(@dates, $date);
 752     }
 753
 754     if (wantarray()) {
 755         return @dates;
 756     } elsif ($self->is_compressed) {
 757         return $dates[1];
 758     } else {
 759         return $dates[0];
 760     }
 761 }
 762
 763 #
 764 # utility function for uncombining instance parts
 765 #
 766 sub _uncombine {
 767     my ($combo, $pos) = @_;
 768
 769     if (ref($combo)) {
 770         carp("Function '_uncombine' is not an instance method");
 771         return;
 772     }
 773
 774     my @parts = split('/', $combo);
 775     return $parts[$pos];
 776 }
 777
 778 #
 779 # Overload string comparison operators
 780 #
 781 # We are not overloading '<=>' because '==' is used liberally in MARC::Record
 782 # to compare field identity (i.e. is this the same exact Field object?), not value
 783 #
 784 # Other string operators are auto-generated from 'cmp'
 785 #
 786 # Please note that this comparison is based on what the holding represents,
 787 # not whether it is strictly identical (e.g. the seqno and link may vary)
 788 #
 789 # XXX: sorting using this operator is currently not deterministic for
 790 # nonsensical holdings (e.g. V.10-V.5), and may require further consideration
 791 use overload ('cmp' => \&_compare,
 792               'fallback' => 1);
 793 sub _compare {
 794     my ($holding_1, $holding_2, $swap) = @_;
 795
 796     # TODO: this needs some more consideration
 797     # fall back to 'built-in' comparison
 798     if (!UNIVERSAL::isa($holding_2, ref $holding_1)) {
 799         if (defined $holding_2) {
 800             carp("Use of non-holding in holding comparison operation") if $holding_2 ne '~~~';
 801             if ($swap) {
 802                 return ( "$holding_2" cmp "$holding_1" );
 803             } else {
 804                 return ( "$holding_1" cmp "$holding_2" );
 805             }
 806         } else {
 807             carp("Use of undefined value in holding comparison operation");
 808             return 1; # similar to built-in, something is "greater than" nothing
 809         }
 810     }
 811
 812     # special cases for compressed holdings
 813     my ($holding_1_first, $holding_1_last, $holding_2_first, $holding_2_last, $found_compressed);
 814     # 0 for no compressed, 1 for first compressed, 2 for second compressed, 3 for both compressed
 815     $found_compressed = 0;
 816     if ($holding_1->is_compressed) {
 817         if (!$holding_1->is_open_ended) {
 818             $holding_1_last = $holding_1->clone->compressed_to_last;
 819         } else {
 820             $holding_1_last = '~~~'; # take advantage of string sort fallback
 821         }
 822         $found_compressed += 1;
 823     } else {
 824         $holding_1_first = $holding_1;
 825         $holding_1_last = $holding_1;
 826     }
 827     if ($holding_2->is_compressed) {
 828         $holding_2_first = $holding_2->clone->compressed_to_first;
 829         $found_compressed += 2;
 830     } else {
 831         $holding_2_first = $holding_2;
 832         $holding_2_last = $holding_2;
 833     }
 834
 835     if ($found_compressed) {
 836         my $cmp = ($holding_1_last cmp $holding_2_first); # 1 ends before 2 starts
 837         if ($cmp == -1) {
 838             return -1; # 1 is fully lt
 839         } elsif ($cmp == 0) {
 840             carp("Overlapping holdings in comparison, lt and gt based on start value only");
 841             return -1;
 842         } else { # check the opposite, 2 ends before 1 starts
 843             # clone is expensive, wait until we need it (here)
 844             if (!defined($holding_2_last)) {
 845                 if (!$holding_2->is_open_ended) {
 846                     $holding_2_last = $holding_2->clone->compressed_to_last;
 847                 } else {
 848                     $holding_2_last = '~~~'; # take advantage of string sort fallback
 849                 }
 850             }
 851             if (!defined($holding_1_first)) {
 852                 $holding_1_first = $holding_1->clone->compressed_to_first;
 853             }
 854             $cmp = ($holding_2_last cmp $holding_1_first);
 855             if ($cmp == -1) {
 856                 return 1; # 1 is fully gt
 857             } elsif ($cmp == 0) {
 858                 carp("Overlapping holdings in comparison, lt and gt based on start value only");
 859                 return 1;
 860             } else {
 861                 $cmp = ($holding_1_first cmp $holding_2_first);
 862                 if ($cmp) { # they are not equal
 863                     carp("Overlapping holdings in comparison, lt and gt based on start value only");
 864                     return $cmp;
 865                 } elsif ($found_compressed == 1) {
 866                     carp("Compressed holding found with start equal to non-compressed holding");
 867                     return 1; # compressed (first holding) is 'greater than' non-compressed
 868                 } elsif ($found_compressed == 2) {
 869                     carp("Compressed holding found with start equal to non-compressed holding");
 870                     return -1; # compressed (second holding) is 'greater than' non-compressed
 871                 } else { # both holdings compressed, check for full equality
 872                     $cmp = ($holding_1_last cmp $holding_2_last);
 873                     if ($cmp) { # they are not equal
 874                         carp("Compressed holdings in comparison have equal starts, lt and gt based on end value only");
 875                         return $cmp;
 876                     } else {
 877                         return 0; # both are compressed, both ends are equal
 878                     }
 879                 }
 880             }
 881         }
 882     }
 883
 884     # start doing the actual comparison
 885     my $result;
 886     foreach my $key ('a'..'f') {
 887         if (defined($holding_1->field_values($key))) {
 888             if (!defined($holding_2->field_values($key))) {
 889                 return 1; # more details equals 'greater' (?)
 890             } else {
 891                 $result = $holding_1->field_values($key)->[0] <=> $holding_2->field_values($key)->[0];
 892             }
 893         } elsif (defined($holding_2->field_values($key))) {
 894             return -1; # more details equals 'greater' (?)
 895         }
 896
 897         return $result if $result;
 898     }
 899
 900     # got through, return 0 for equal
 901     return 0;
 902 }
 903
 904 1;