Open-ILS/src/perlmods/lib/OpenILS/Utils/MFHD.pm

   1 package MFHD;
   2 use strict;
   3 use warnings;
   4 use integer;
   5 use Carp;
   6 use DateTime::Format::Strptime;
   7 use Data::Dumper;
   8
   9 # for inherited methods to work properly, we need to force a
  10 # MARC::Record version greater than 2.0.0
  11 use MARC::Record "2.0.1";
  12 use base 'MARC::Record';
  13
  14 use OpenILS::Utils::MFHD::Caption;
  15 use OpenILS::Utils::MFHD::Holding;
  16
  17 sub new {
  18     my $proto = shift;
  19     my $class = ref($proto) || $proto;
  20     my $self  = shift;
  21
  22     $self->{_strp_date} = new DateTime::Format::Strptime(pattern => '%F');
  23
  24     $self->{_mfhd_CAPTIONS} = {};
  25     $self->{_mfhd_COMPRESSIBLE} = (substr($self->leader, 17, 1) =~ /[45]/);
  26
  27     foreach my $field ('853', '854', '855') {
  28         my $captions = {};
  29         foreach my $caption ($self->field($field)) {
  30             my $cap_id;
  31
  32             $cap_id = $caption->subfield('8') || '0';
  33
  34             if (exists $captions->{$cap_id}) {
  35                 carp "Multiple MFHD captions with label '$cap_id'";
  36             }
  37
  38             $captions->{$cap_id} = new MFHD::Caption($caption);
  39             if ($self->{_mfhd_COMPRESSIBLE}) {
  40                 $self->{_mfhd_COMPRESSIBLE} &&=
  41                   $captions->{$cap_id}->compressible;
  42             }
  43         }
  44         $self->{_mfhd_CAPTIONS}->{$field} = $captions;
  45     }
  46
  47     foreach my $field ('863', '864', '865') {
  48         my $holdings = {};
  49         my $cap_field;
  50
  51         ($cap_field = $field) =~ s/6/5/;
  52
  53         foreach my $hfield ($self->field($field)) {
  54             my ($linkage, $link_id, $seqno);
  55             my $holding;
  56
  57             $linkage = $hfield->subfield('8');
  58             ($link_id, $seqno) = split(/\./, $linkage);
  59
  60             if (!exists $holdings->{$link_id}) {
  61                 $holdings->{$link_id} = {};
  62             }
  63             $holding =
  64               new MFHD::Holding($seqno, $hfield,
  65                 $self->{_mfhd_CAPTIONS}->{$cap_field}->{$link_id});
  66             $holdings->{$link_id}->{$seqno} = $holding;
  67
  68             if ($self->{_mfhd_COMPRESSIBLE}) {
  69                 $self->{_mfhd_COMPRESSIBLE} &&= $holding->validate;
  70             }
  71         }
  72         $self->{_mfhd_HOLDINGS}->{$field} = $holdings;
  73     }
  74
  75     bless($self, $class);
  76     return $self;
  77 }
  78
  79 sub compressible {
  80     my $self = shift;
  81
  82     return $self->{_mfhd_COMPRESSIBLE};
  83 }
  84
  85 sub caption_link_ids {
  86     my $self  = shift;
  87     my $field = shift;
  88
  89     return sort keys %{$self->{_mfhd_CAPTIONS}->{$field}};
  90 }
  91
  92 # optional argument to get back a 'hashref' or an 'array' (default)
  93 sub captions {
  94     my $self  = shift;
  95     my $tag = shift;
  96     my $return_type = shift;
  97
  98     # TODO: add support for caption types as argument? (base, index, supplement)
  99     my @sorted_ids = $self->caption_link_ids($tag);
 100
 101     if (defined($return_type) and $return_type eq 'hashref') {
 102         my %captions;
 103         foreach my $link_id (@sorted_ids) {
 104             $captions{$link_id} = $self->{_mfhd_CAPTIONS}{$tag}{$link_id};
 105         }
 106         return \%captions;
 107     } else {
 108         my @captions;
 109         foreach my $link_id (@sorted_ids) {
 110             push(@captions, $self->{_mfhd_CAPTIONS}{$tag}{$link_id});
 111         }
 112         return @captions;
 113     }
 114 }
 115
 116 sub append_fields {
 117     my $self = shift;
 118
 119     my $field_count = $self->SUPER::append_fields(@_);
 120     if ($field_count) {
 121         foreach my $field (@_) {
 122             $self->_avoid_link_collision($field);
 123             my $field_type = ref $field;
 124             if ($field_type eq 'MFHD::Holding') {
 125                 $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
 126             } elsif ($field_type eq 'MFHD::Caption') {
 127                 $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
 128             }
 129         }
 130         return $field_count;
 131     } else {
 132         return;
 133     }
 134 }
 135
 136 sub delete_field {
 137     my $self = shift;
 138     my $field = shift;
 139
 140     my $field_count = $self->SUPER::delete_field($field);
 141     if ($field_count) {
 142         my $field_type = ref($field);
 143         if ($field_type eq 'MFHD::Holding') {
 144             delete($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno});
 145         } elsif ($field_type eq 'MFHD::Caption') {
 146             delete($self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id});
 147         }
 148         return $field_count;
 149     } else {
 150         return;
 151     }
 152 }
 153
 154 sub insert_fields_before {
 155     my $self = shift;
 156     my $before = shift;
 157
 158     my $field_count = $self->SUPER::insert_fields_before($before, @_);
 159     if ($field_count) {
 160         foreach my $field (@_) {
 161             $self->_avoid_link_collision($field);
 162             my $field_type = ref $field;
 163             if ($field_type eq 'MFHD::Holding') {
 164                 $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
 165             } elsif ($field_type eq 'MFHD::Caption') {
 166                 $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
 167             }
 168         }
 169         return $field_count;
 170     } else {
 171         return;
 172     }
 173 }
 174
 175 sub insert_fields_after {
 176     my $self = shift;
 177     my $after = shift;
 178
 179     my $field_count = $self->SUPER::insert_fields_after($after, @_);
 180     if ($field_count) {
 181         foreach my $field (@_) {
 182             $self->_avoid_link_collision($field);
 183             my $field_type = ref $field;
 184             if ($field_type eq 'MFHD::Holding') {
 185                 $self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$field->seqno} = $field;
 186             } elsif ($field_type eq 'MFHD::Caption') {
 187                 $self->{_mfhd_CAPTIONS}{$field->tag}{$field->link_id} = $field;
 188             }
 189         }
 190         return $field_count;
 191     } else {
 192         return;
 193     }
 194 }
 195
 196 sub _avoid_link_collision {
 197     my $self = shift;
 198     my $field = shift;
 199
 200     my $fieldref = ref($field);
 201     if ($fieldref eq 'MFHD::Holding') {
 202         my $seqno = $field->seqno;
 203         my $changed_seqno = 0;
 204         if (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno})) {
 205             $changed_seqno = 1;
 206             do {
 207                 $seqno++;
 208             } while (exists($self->{_mfhd_HOLDINGS}{$field->tag}{$field->caption->link_id}{$seqno}));
 209         }
 210         $field->seqno($seqno) if $changed_seqno;
 211     } elsif ($fieldref eq 'MFHD::Caption') {
 212         my $link_id = $field->link_id;
 213         my $changed_link_id = 0;
 214         if (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id})) {
 215             $link_id++;
 216             $changed_link_id = 1;
 217             do {
 218                 $link_id++;
 219             } while (exists($self->{_mfhd_CAPTIONS}{$field->tag}{$link_id}));
 220         }
 221         $field->link_id($link_id) if $changed_link_id;
 222     }
 223 }
 224
 225 sub active_captions {
 226     my $self  = shift;
 227     my $tag = shift;
 228
 229     # TODO: add support for caption types as argument? (basic, index, supplement)
 230     my @captions;
 231     my @active_captions;
 232
 233     @captions = $self->captions($tag);
 234
 235     # TODO: for now, we will assume the last 85X field is active
 236     # and the rest are historical.  The standard is hazy about
 237     # how multiple active patterns of the same 85X type should be
 238     # handled.  We will, however, return as an array for future
 239     # use.
 240     push(@active_captions, $captions[-1]);
 241
 242     return @active_captions;
 243 }
 244
 245 sub holdings {
 246     my $self  = shift;
 247     my $field = shift;
 248     my $capid = shift;
 249
 250     return
 251       sort { $a->seqno <=> $b->seqno }
 252       values %{$self->{_mfhd_HOLDINGS}->{$field}->{$capid}};
 253 }
 254
 255 sub holdings_by_caption {
 256     my $self  = shift;
 257     my $caption = shift;
 258
 259     my $htag    = $caption->tag;
 260     my $link_id = $caption->link_id;
 261     $htag =~ s/^85/86/;
 262     return $self->holdings($htag, $link_id);
 263 }
 264
 265 sub _holding_date {
 266     my $self = shift;
 267     my $holding = shift;
 268
 269     return $self->{_strp_date}->parse_datetime($holding->chron_to_date);
 270 }
 271
 272 #
 273 # generate_predictions()
 274 # Accepts a hash ref of options initially defined as:
 275 # base_holding : reference to the holding field to predict from
 276 # include_base_issuance : whether to "predict" the startting holding, so as to generate a label for it
 277 # num_to_predict : the number of issues you wish to predict
 278 # OR
 279 # end_holding : holding field ref, keep predicting until you meet or exceed it
 280 # OR
 281 # end_date : keep predicting until you exceed this
 282 #
 283 # The basic method is to first convert to a single holding if compressed, then
 284 # increment the holding and save the resulting values to @predictions.
 285 #
 286 # returns @predictions, an array of holding field refs (including end_holding
 287 # if applicable but NOT base_holding)
 288 #
 289 sub generate_predictions {
 290     my ($self, $options) = @_;
 291
 292     my $base_holding   = $options->{base_holding};
 293     my $num_to_predict = $options->{num_to_predict};
 294     my $end_holding    = $options->{end_holding};
 295     my $end_date       = $options->{end_date};
 296     my $max_to_predict = $options->{max_to_predict} || 10000; # fail-safe
 297     my $include_base_issuance   = $options->{include_base_issuance};
 298
 299     if (!defined($base_holding)) {
 300         carp("Base holding not defined in generate_predictions, returning empty set");
 301         return ();
 302     }
 303     if ($base_holding->is_compressed) {
 304         carp("Ambiguous compressed base holding in generate_predictions, returning empty set");
 305         return ();
 306     }
 307     my $curr_holding = $base_holding->clone; # prevent side-effects
 308
 309     my @predictions;
 310     push(@predictions, $curr_holding->clone) if ($include_base_issuance);
 311
 312     if ($num_to_predict) {
 313         for (my $i = 0; $i < $num_to_predict; $i++) {
 314             push(@predictions, $curr_holding->increment->clone);
 315         }
 316     } elsif (defined($end_holding)) {
 317         $end_holding = $end_holding->clone; # prevent side-effects
 318         my $next_holding = $curr_holding->increment->clone;
 319         my $num_predicted = 0;
 320         while ($next_holding le $end_holding) {
 321             push(@predictions, $next_holding);
 322             $num_predicted++;
 323             if ($num_predicted >= $max_to_predict) {
 324                 carp("Maximum prediction count exceeded");
 325                 last;
 326             }
 327             $next_holding = $curr_holding->increment->clone;
 328         }
 329     } elsif (defined($end_date)) {
 330         my $next_holding = $curr_holding->increment->clone;
 331         my $num_predicted = 0;
 332         while ($self->_holding_date($next_holding) <= $end_date) {
 333             push(@predictions, $next_holding);
 334             $num_predicted++;
 335             if ($num_predicted >= $max_to_predict) {
 336                 carp("Maximum prediction count exceeded");
 337                 last;
 338             }
 339             $next_holding = $curr_holding->increment->clone;
 340         }
 341     }
 342
 343     return @predictions;
 344 }
 345
 346 #
 347 # create an array of compressed holdings from all holdings for a given caption,
 348 # compressing as needed
 349 #
 350 # Optionally you can skip sorting, but the resulting compression will be compromised
 351 # if the current holdings are out of order
 352 #
 353 # TODO: gap marking, gap preservation
 354 #
 355 # TODO: some of this could be moved to the Caption object to allow for
 356 # decompression in the absense of an overarching MFHD object
 357 #
 358 sub get_compressed_holdings {
 359     my $self = shift;
 360     my $caption = shift;
 361     my $opts = shift;
 362     my $skip_sort = $opts->{'skip_sort'};
 363
 364     # basic check for necessary pattern information
 365     if (!scalar keys %{$caption->pattern}) {
 366         carp "Cannot compress without pattern data, returning original holdings";
 367         return $self->holdings_by_caption($caption);
 368     }
 369
 370     # make sure none are compressed (except for open-ended)
 371     my @decomp_holdings;
 372     if ($skip_sort) {
 373         @decomp_holdings = $self->get_decompressed_holdings($caption, {'skip_sort' => 1, 'passthru_open_ended' => 1});
 374     } else {
 375         # sort for best algorithm
 376         @decomp_holdings = $self->get_decompressed_holdings($caption, {'dedupe' => 1, 'passthru_open_ended' => 1});
 377     }
 378
 379     return () if !@decomp_holdings;
 380
 381     # if first holding is open-ended, it 'includes' all the rest, so return
 382     if ($decomp_holdings[0]->is_open_ended) {
 383         return ($decomp_holdings[0]);
 384     }
 385
 386     my $runner = $decomp_holdings[0]->clone->increment;
 387     my $curr_holding = shift(@decomp_holdings);
 388     $curr_holding = $curr_holding->clone;
 389     my $seqno = 1;
 390     $curr_holding->seqno($seqno);
 391     my @comp_holdings;
 392     foreach my $holding (@decomp_holdings) {
 393         if ($runner eq $holding) {
 394             $curr_holding->extend;
 395             $runner->increment;
 396         } elsif ($holding->is_open_ended) { # special case, as it will always be the last
 397             if ($runner ge $holding->clone->compressed_to_first) {
 398                 $curr_holding->compressed_end();
 399             } else {
 400                 push(@comp_holdings, $curr_holding);
 401                 $curr_holding = $holding->clone;
 402                 $seqno++;
 403                 $curr_holding->seqno($seqno);
 404             }
 405             last;
 406         } elsif ($runner gt $holding) { # should not happen unless holding is not in series
 407             carp("Found unexpected holding, skipping");
 408         } else {
 409             push(@comp_holdings, $curr_holding);
 410
 411             my $loop_count = 0;
 412             (my $runner_dump = $runner->as_formatted) =~ s/\n\s+/*/gm; # logging
 413
 414             while ($runner le $holding) {
 415                 # Infinite loops used to happen here. As written today,
 416                 # ->increment() cannot be guaranteed to eventually falsify
 417                 # the condition ($runner le $holding) in certain cases.
 418
 419                 $runner->increment;
 420
 421                 if (++$loop_count >= 10000) {
 422                     (my $holding_dump = $holding->as_formatted) =~ s/\n\s+/*/gm;
 423
 424                     croak "\$runner<$runner_dump> didn't catch up with " .
 425                         "\$holding<$holding_dump> after 10000 increments";
 426                 }
 427             }
 428             $curr_holding = $holding->clone;
 429             $seqno++;
 430             $curr_holding->seqno($seqno);
 431         }
 432     }
 433     push(@comp_holdings, $curr_holding);
 434
 435     return @comp_holdings;
 436 }
 437
 438 #
 439 # create an array of single holdings from all holdings for a given caption,
 440 # decompressing as needed
 441 #
 442 # optional arguments:
 443 #    skip_sort: do not sort the returned holdings
 444 #    dedupe: remove any duplicate holdings from the set
 445 #    passthru_open_ended: open-ended compressed holdings cannot be logically
 446 #    decompressed (they are infinite); if set to true these holdings are passed
 447 #    thru rather than skipped
 448 # TODO: some of this could be moved to the Caption (and/or Holding) object to
 449 # allow for decompression in the absense of an overarching MFHD object
 450 #
 451 sub get_decompressed_holdings {
 452     my $self = shift;
 453     my $caption = shift;
 454     my $opts = shift;
 455     my $skip_sort = $opts->{'skip_sort'};
 456     my $dedupe = $opts->{'dedupe'};
 457     my $passthru_open_ended = $opts->{'passthru_open_ended'};
 458
 459     if ($dedupe and $skip_sort) {
 460         carp("Attempted deduplication without sorting, failure likely");
 461     }
 462
 463     my @holdings = $self->holdings_by_caption($caption);
 464
 465     return () if !@holdings;
 466
 467     my @decomp_holdings;
 468
 469     foreach my $holding (@holdings) {
 470         if (!$holding->is_compressed) {
 471             push(@decomp_holdings, $holding->clone);
 472         } elsif ($holding->is_open_ended) {
 473             if ($passthru_open_ended) {
 474                 push(@decomp_holdings, $holding->clone);
 475             } else {
 476                 carp("Open-ended holdings cannot be decompressed, skipping");
 477             }
 478         } else {
 479             my $base_holding = $holding->clone->compressed_to_first;
 480             my @new_holdings = $self->generate_predictions(
 481                 {'base_holding' => $base_holding,
 482                  'end_holding' => $holding->clone->compressed_to_last});
 483             push(@decomp_holdings, $base_holding, @new_holdings);
 484         }
 485     }
 486
 487     unless ($skip_sort) {
 488         my @temp_holdings = sort {$a cmp $b} @decomp_holdings;
 489         @decomp_holdings = @temp_holdings;
 490     }
 491
 492     my @return_holdings = (shift(@decomp_holdings));
 493     $return_holdings[0]->seqno(1);
 494     my $seqno = 2;
 495     foreach my $holding (@decomp_holdings) { # renumber sequence
 496         if ($holding eq $return_holdings[-1] and $dedupe) {
 497             carp("Found duplicate holding in decompression set, discarding");
 498             next;
 499         }
 500         $holding->seqno($seqno);
 501         $seqno++;
 502         push(@return_holdings, $holding);
 503     }
 504
 505     return @return_holdings;
 506 }
 507
 508 #
 509 # create an array of compressed holdings from all holdings for a given caption,
 510 # combining as needed
 511 #
 512 # NOTE: this sub is similar to, but much less aggressive/strict than
 513 # get_compressed_holdings(). Ultimately, get_compressed_holdings() might be
 514 # deprecated in favor of this
 515 #
 516 # TODO: gap marking, gap preservation
 517 #
 518 # TODO: some of this could be moved to the Caption (and/or Holding) object to
 519 # allow for combining in the absense of an overarching MFHD object
 520 #
 521 sub get_combined_holdings {
 522     my $self = shift;
 523     my $caption = shift;
 524
 525     my @holdings = $self->holdings_by_caption($caption);
 526     return () if !@holdings;
 527
 528     # basic check for necessary pattern information
 529     if (!scalar keys %{$caption->pattern}) {
 530         carp "Cannot combine without pattern data, returning original holdings";
 531         return @holdings;
 532     }
 533
 534     my @sorted_holdings = sort {$a cmp $b} @holdings;
 535
 536     my @combined_holdings = (shift(@sorted_holdings));
 537     my $seqno = 1;
 538     $combined_holdings[0]->seqno($seqno);
 539     foreach my $holding (@sorted_holdings) {
 540         # short-circuit: if we hit an open-ended holding,
 541         # it 'includes' all the rest, so just exit the loop
 542         if ($combined_holdings[-1]->is_open_ended) {
 543             last;
 544         } elsif ($holding eq $combined_holdings[-1]) {
 545             # duplicate, skip
 546             next;
 547         } else {
 548             # at this point, we know that $holding is gt $combined_holdings[-1]
 549             # we just need to figure out if they overlap or not
 550
 551             # first, get the end (or only) holding of [-1]
 552             my $last_holding_end = $combined_holdings[-1]->is_compressed ?
 553                 $combined_holdings[-1]->clone->compressed_to_last
 554                 : $combined_holdings[-1]->clone;
 555
 556             # next, get the end (or only) holding of the current
 557             # holding being considered
 558             my $holding_end;
 559             if ($holding->is_compressed) {
 560                 $holding_end = $holding->is_open_ended ?
 561                 undef
 562                 : $holding->clone->compressed_to_last;
 563             } else {
 564                 $holding_end = $holding;
 565             }
 566
 567             # next, make sure $holding isn't fully contained
 568             # if it is, skip it
 569             if ($holding_end and $holding_end le $last_holding_end) {
 570                 next;
 571             }
 572
 573             # now, get the beginning (or only) holding of $holding
 574             my $holding_start = $holding->is_compressed ?
 575                 $holding->clone->compressed_to_first
 576                 : $holding;
 577
 578             # see if they overlap
 579             if ($last_holding_end->increment ge $holding_start) {
 580                 # they overlap, combine them
 581                 $combined_holdings[-1]->compressed_end($holding_end);
 582             } else {
 583                 # no overlap, start a new group
 584                 $holding->seqno(++$seqno);
 585                 push(@combined_holdings, $holding);
 586             }
 587         }
 588     }
 589
 590     return @combined_holdings;
 591 }
 592
 593 ##
 594 ## close any open-ended holdings which are followed by another holding by
 595 ## combining them
 596 ##
 597 ## This needs more thought about concerning usability (e.g. should it be a
 598 ## mutator?), commenting out for now
 599 #sub _get_truncated_holdings {
 600 #    my $self = shift;
 601 #    my $caption = shift;
 602 #
 603 #    my @holdings = $self->holdings_by_caption($caption);
 604 #
 605 #    return () if !@holdings;
 606 #
 607 #    @holdings = sort {$a cmp $b} @holdings;
 608 #
 609 #    my $current_open_holding;
 610 #    my @truncated_holdings;
 611 #    foreach my $holding (@holdings) {
 612 #        if ($current_open_holding) {
 613 #            if ($holding->is_open_ended) {
 614 #                next; # consecutive open holdings are meaningless, as they are contained by the previous
 615 #            } elsif ($holding->is_compressed) {
 616 #                $current_open_holding->compressed_end($holding->compressed_to_last);
 617 #            } else {
 618 #                $current_open_holding->compressed_end($holding);
 619 #            }
 620 #            push(@truncated_holdings, $current_open_holding);
 621 #            $current_open_holding = undef;
 622 #        } elsif ($holding->is_open_ended) {
 623 #            $current_open_holding = $holding;
 624 #        } else {
 625 #            push(@truncated_holdings, $holding);
 626 #        }
 627 #    }
 628 #
 629 #    # catch possible open holding at end
 630 #    push(@truncated_holdings, $current_open_holding) if $current_open_holding;
 631 #
 632 #    my $seqno = 1;
 633 #    foreach my $holding (@truncated_holdings) { # renumber sequence
 634 #        $holding->seqno($seqno);
 635 #        $seqno++;
 636 #    }
 637 #
 638 #    return @truncated_holdings;
 639 #}
 640
 641 #
 642 # format_holdings(): Generate textual display of all holdings in record
 643 # for given type of caption (853--855) taking into account all the
 644 # captions, holdings statements, and textual
 645 # holdings.
 646 #
 647 # returns string formatted holdings as one very long line.
 648 # Caller must provide any label (such as "library has:" and insert
 649 # line breaks as appropriate.
 650
 651 # Translate caption field labels to the corresponding textual holdings
 652 # statement labels. That is, convert 853 "Basic bib unit" caption to
 653 # 866 "basic bib unit" text holdings label.
 654
 655 my %cap_to_txt = (
 656                   '853' => '866',
 657                   '854' => '867',
 658                   '855' => '868',
 659                  );
 660
 661 sub format_holdings {
 662     my $self = shift;
 663     my $field = shift;
 664     my $holdings_field;
 665     my @txt_holdings;
 666     my %txt_link_ids;
 667     my $holdings_stmt = '';
 668     my ($l, $start);
 669
 670     # convert caption field id to holdings field id
 671     ($holdings_field = $field) =~ s/5/6/;
 672
 673     # Textual holdings statements complicate the basic algorithm for
 674     # formatting the holdings: If there's a textual holdings statement
 675     # with the subfield "$80", then that overrides ALL the MFHD holdings
 676     # information and is all that is displayed. Otherwise, the textual
 677     # holdings statements will either replace some of the MFHD holdings
 678     # information, or supplement it, depending on the value of the
 679     # $8 linkage subfield.
 680
 681     if (defined $self->field($cap_to_txt{$field})) {
 682         @txt_holdings = $self->field($cap_to_txt{$field});
 683
 684         foreach my $txt (@txt_holdings) {
 685
 686             # if there's a $80 subfield, then we're done, it's
 687             # all the formatted holdings
 688             if ($txt->subfield('8') eq '0') {
 689                 # textual holdings statement that completely
 690                 # replaces MFHD holdings in 853/863, etc.
 691                 $holdings_stmt = $txt->subfield('a');
 692
 693                 if (defined $txt->subfield('z')) {
 694                     $holdings_stmt .= ' -- ' . $txt->subfield('z');
 695                 }
 696
 697                 printf("# format_holdings() returning %s txt holdings\n",
 698                        $cap_to_txt{$field});
 699                 return $holdings_stmt;
 700             }
 701
 702             # If there are non-$80 subfields in the textual holdings
 703             # then we need to keep track of the subfields, so we can
 704             # intersperse the textual holdings in with the the calculated
 705             # holdings from the 853/863 fields.
 706             foreach my $linkid ($txt->subfield('8')) {
 707                 $txt_link_ids{$linkid} = $txt;
 708             }
 709         }
 710     }
 711
 712     # Now loop through all the captions, finding the corresponding
 713     # holdings statements (either MFHD or textual), and build up the
 714     # complete formatted holdings statement. The textual holdings statements
 715     # have either the same link id field as a caption, which means that
 716     # the text holdings win, or they have ids that are interfiled with
 717     # the captions, which mean they go into the middle.
 718
 719     my @ids = sort($self->caption_link_ids($field), keys %txt_link_ids);
 720     foreach my $cap_id (@ids) {
 721         my $last_txt = undef;
 722
 723         if (exists $txt_link_ids{$cap_id}) {
 724             # there's a textual holding statement with this caption ID,
 725             # so just use that. This covers both the "replaces" and
 726             # the "supplements" holdings information options.
 727
 728             # a single textual holdings statement can replace multiple
 729             # captions. If the _last_ caption we saw had a textual
 730             # holdings statement, and this caption has the same one, then
 731             # we don't add the holdings again.
 732             if (!defined $last_txt || ($last_txt != $txt_link_ids{$cap_id})) {
 733                 my $txt = $txt_link_ids{$cap_id};
 734                 $holdings_stmt .= ',' if $holdings_stmt;
 735                 $holdings_stmt .= $txt->subfield('a');
 736                 if (defined $txt->subfield('z')) {
 737                     $holdings_stmt .= ' -- ' . $txt->subfield('z');
 738                 }
 739
 740                 $last_txt = $txt;
 741             }
 742             next;
 743         }
 744
 745         # We found a caption that doesn't have a corresponding textual
 746         # holdings statement, so reset $last_txt to undef.
 747         $last_txt = undef;
 748
 749         my @holdings = $self->holdings($holdings_field, $cap_id);
 750
 751         next unless scalar @holdings;
 752
 753         # XXX Need to format compressed holdings. see code in test.pl
 754         # for example. Try to do it without indexing?
 755         $holdings_stmt .= ',' if $holdings_stmt;
 756
 757         if ($self->compressible) {
 758             $start = $l = shift @holdings;
 759             $holdings_stmt .= $l->format;
 760
 761             while (my $h = shift @holdings) {
 762                 if (!$h->matches($l->next)) {
 763                     # this item is not part of the current run,
 764                     # close out the run and record this item
 765                     if ($l != $start) {
 766                         $holdings_stmt .= '-' . $l->format;
 767                     }
 768
 769                     $holdings_stmt .= ',' . $h->format;
 770                     $start = $h
 771                 } elsif (!scalar(@holdings) || defined($h->subfield('z'))) {
 772                     # This is the end of the holdings for this caption
 773                     # or this item has a public note that we want
 774                     # to display
 775                     $holdings_stmt .= '-' . $h->format;
 776                 }
 777
 778                 if (defined $h->subfield('z')) {
 779                     $holdings_stmt .= ' -- ' . $h->subfield('z');
 780                 }
 781
 782                 $l = $h;
 783             }
 784         } else {
 785             $holdings_stmt .= ',' if $holdings_stmt;
 786             $holdings_stmt .= (shift @holdings)->format;
 787             foreach my $h (@holdings) {
 788                 $holdings_stmt .= ',' . $h->format;
 789                 if (defined $h->subfield('z')) {
 790                     $holdings_stmt .= ' -- ' . $h->subfield('z');
 791                 }
 792             }
 793         }
 794     }
 795
 796     return $holdings_stmt;
 797 }
 798
 799 1;