Open-ILS/src/perlmods/lib/OpenILS/Application/Cat/Merge.pm

   1 use strict; use warnings;
   2 package OpenILS::Application::Cat::Merge;
   3 use base qw/OpenILS::Application/;
   4 use OpenSRF::Application;
   5 use OpenILS::Application::AppUtils;
   6 use OpenSRF::EX qw(:try);
   7 use OpenILS::Utils::Fieldmapper;
   8 use OpenILS::Event;
   9 use OpenSRF::Utils::Logger qw($logger);
  10 use Data::Dumper;
  11 my $U = "OpenILS::Application::AppUtils";
  12
  13 my $storage;
  14
  15
  16 # removes items from an array and returns the removed items
  17 # example : my @d = rgrep(sub { $_ =~ /o/ }, \@a);
  18 # there's surely a smarter way to do this
  19 sub rgrep {
  20    my( $sub, $arr ) = @_;
  21    my @del;
  22    for( my $i = 0; $i < @$arr; $i++ ) {
  23       my $a = $$arr[$i];
  24       local $_ = $a;
  25       if($sub->()) {
  26          splice(@$arr, $i--, 1);
  27          push( @del, $a );
  28       }
  29    }
  30    return @del;
  31 }
  32
  33
  34
  35 # takes a master record and a list of
  36 # sub-records to merge into the master record
  37 sub merge_records {
  38     my( $editor, $master, $records ) = @_;
  39
  40     # bib records are global objects, so no org context required.
  41     return (undef, $editor->die_event)
  42         unless $editor->allowed('MERGE_BIB_RECORDS');
  43
  44     my $vol;
  45     my $evt;
  46
  47     my %r = map { $_ => 1 } ($master, @$records); # unique the ids
  48     my @recs = keys %r;
  49
  50     my $reqr = $editor->requestor;
  51     $logger->activity("merge: user ".$reqr->id." merging bib records: @recs with master = $master");
  52
  53     # -----------------------------------------------------------
  54     # collect all of the volumes, merge any with duplicate
  55     # labels, then move all of the volumes to the master record
  56     # -----------------------------------------------------------
  57     my @volumes;
  58     for (@recs) {
  59         my $vs = $editor->search_asset_call_number({record => $_, deleted=>'f'});
  60         push( @volumes, @$vs );
  61     }
  62
  63     $logger->info("merge: merge recovered ".scalar(@volumes)." total volumes");
  64
  65     my @trimmed;
  66     # de-duplicate any volumes with the same label and owning_lib
  67
  68     my %seen_vols;
  69
  70     for my $v (@volumes) {
  71         my $l = $v->label;
  72         my $o = $v->owning_lib;
  73
  74         if($seen_vols{$v->id}) {
  75             $logger->debug("merge: skipping ".$v->id." since it's already been merged");
  76             next;
  77         }
  78
  79         $seen_vols{$v->id} = 1;
  80
  81         $logger->debug("merge: [".$v->id."] looking for dupes with label $l and owning_lib $o");
  82
  83         my @dups;
  84         for my $vv (@volumes) {
  85             if( $vv->label eq $v->label and $vv->owning_lib == $v->owning_lib ) {
  86                 $logger->debug("merge: pushing dupe volume ".$vv->id) if @dups;
  87                 push( @dups, $vv );
  88                 $seen_vols{$vv->id} = 1;
  89             }
  90         }
  91
  92         if( @dups == 1 ) {
  93             $logger->debug("merge: pushing unique volume into trimmed volume set: ".$v->id);
  94             push( @trimmed, @dups );
  95
  96         } else {
  97             my($vol, $e) = merge_volumes($editor, \@dups);
  98             return $e if $e;
  99             $logger->debug("merge: pushing vol-merged volume into trimmed volume set: ".$vol->id);
 100             push(@trimmed, $vol);
 101         }
 102     }
 103
 104     my $s = 'merge: trimmed volume set contains the following vols: ';
 105     $s .= 'id = '.$_->id .' : record = '.$_->record.' | ' for @trimmed;
 106     $logger->debug($s);
 107
 108     # make all the volumes point to the master record
 109     my $stat;
 110     for $vol (@trimmed) {
 111         if( $vol->record ne $master ) {
 112
 113             $logger->debug("merge: moving volume ".
 114                 $vol->id." from record ".$vol->record. " to $master");
 115
 116             $vol->editor( $editor->requestor->id );
 117             $vol->edit_date('now');
 118             $vol->record( $master );
 119             $editor->update_asset_call_number($vol)
 120                 or return $editor->die_event;
 121         }
 122     }
 123
 124     # cycle through and delete the non-master records
 125     for my $rec (@recs) {
 126
 127         my $record = $editor->retrieve_biblio_record_entry($rec)
 128             or return $editor->die_event;
 129
 130         $logger->debug("merge: seeing if record $rec needs to be deleted or un-deleted");
 131
 132         if( $rec == $master ) {
 133             # make sure the master record is not deleted
 134             if( $U->is_true($record->deleted) ) {
 135                 $logger->info("merge: master record is marked as deleted...un-deleting.");
 136                 $record->deleted('f');
 137                 $record->editor($reqr->id);
 138                 $record->edit_date('now');
 139                 $editor->update_biblio_record_entry($record)
 140                     or return $editor->die_event;
 141             }
 142
 143         } else {
 144             $logger->info("merge: deleting record $rec");
 145             $record->deleted('t');
 146             $record->editor($reqr->id);
 147             $record->edit_date('now');
 148             $editor->update_biblio_record_entry($record)
 149                 or return $editor->die_event;
 150         }
 151     }
 152
 153     return undef;
 154 }
 155
 156
 157
 158 # takes a list of volume objects, picks the volume with most
 159 # copies and moves all copies attached to the other volumes
 160 # into said volume.  all other volumes are deleted
 161 sub merge_volumes {
 162     my( $editor, $volumes, $master ) = @_;
 163     my %copies;
 164     my $evt;
 165
 166     return ($$volumes[0]) if !$master and @$volumes == 1;
 167
 168     return ($$volumes[0]) if
 169         $master and @$volumes == 1
 170         and $master->id == $$volumes[0]->id;
 171
 172     $logger->debug("merge: fetching copies for volume list of size ".scalar(@$volumes));
 173
 174     # collect all of the copies attached to the selected volumes
 175     for( @$volumes ) {
 176         $copies{$_->id} = $editor->search_asset_copy({call_number=>$_->id, deleted=>'f'});
 177         $logger->debug("merge: found ".scalar(@{$copies{$_->id}})." copies for volume ".$_->id);
 178     }
 179
 180     my $bigcn;
 181     if( $master ) {
 182
 183         # the caller has chosen the master record
 184         $bigcn = $master->id;
 185         push( @$volumes, $master );
 186
 187     } else {
 188
 189         # find the CN with the most copies and make it the master CN
 190         my $big = 0;
 191         for my $cn (keys %copies) {
 192             my $count = scalar(@{$copies{$cn}});
 193             if( $count > $big ) {
 194                 $big = $count;
 195                 $bigcn = $cn;
 196             }
 197         }
 198     }
 199
 200     $bigcn = $$volumes[0]->id unless $bigcn;
 201
 202     $logger->info("merge: merge using volume $bigcn as the master");
 203
 204     # now move all of the copies to the new volume
 205     for my $cn (keys %copies) {
 206         next if $cn == $bigcn;
 207         for my $copy (@{$copies{$cn}}) {
 208             $logger->debug("merge: setting call_number to $bigcn for copy ".$copy->id);
 209             $copy->call_number($bigcn);
 210             $copy->editor($editor->requestor->id);
 211             $copy->edit_date('now');
 212             $editor->update_asset_copy($copy) or return (undef, $editor->die_event);
 213         }
 214     }
 215
 216     for( @$volumes ) {
 217         next if $_->id == $bigcn;
 218         $logger->debug("merge: marking call_number as deleted: ".$_->id);
 219         $_->deleted('t');
 220         $_->editor($editor->requestor->id);
 221         $_->edit_date('now');
 222         $editor->update_asset_call_number($_) or return (undef, $editor->die_event);
 223         merge_volume_holds($editor, $bigcn, $_->id);
 224     }
 225
 226     my ($mvol) = grep { $_->id == $bigcn } @$volumes;
 227     $logger->debug("merge: returning master volume ".$mvol->id);
 228     return ($mvol);
 229 }
 230
 231 sub merge_volume_holds {
 232     my($e, $master_id, $vol_id) = @_;
 233
 234     my $holds = $e->search_action_hold_request(
 235         {   cancel_time => undef,
 236             fulfillment_time => undef,
 237             hold_type => 'V',
 238             target => $vol_id
 239         }
 240     );
 241
 242     for my $hold (@$holds) {
 243
 244         $logger->info("Changing hold ".$hold->id.
 245             " target from ".$hold->target." to $master_id in volume merge");
 246
 247         $hold->target($master_id);
 248         unless($e->update_action_hold_request($hold)) {
 249             my $evt = $e->event;
 250             $logger->error("Error updating hold ". $evt->textcode .":". $evt->desc .":". $evt->stacktrace);
 251         }
 252     }
 253
 254     return undef;
 255 }
 256
 257
 258 1;
 259
 260