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