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