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