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

   1 use strict; use warnings;
   2 package OpenILS::Application::Cat::Merge;
   3 use base qw/OpenSRF::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         my $vol;
  42         my $evt;
  43
  44         my %r = map { $_ => 1 } ($master, @$records); # unique the ids
  45         my @recs = keys %r;
  46
  47         my $reqr = $editor->requestor;
  48         $logger->activity("merge: user ".$reqr->id." merging bib records: @recs");
  49
  50         # -----------------------------------------------------------
  51         # collect all of the volumes, merge any with duplicate
  52         # labels, then move all of the volumes to the master record
  53         # -----------------------------------------------------------
  54         my @volumes;
  55         for (@recs) {
  56                 my $vs = $editor->search_asset_call_number({record => $_});
  57                 push( @volumes, @$vs );
  58         }
  59
  60         $logger->info("merge: merge recovered ".scalar(@volumes)." total volumes");
  61
  62         my @trimmed;
  63         # de-duplicate any volumes with the same label and owning_lib
  64         for my $v (@volumes) {
  65                 my $l = $v->label;
  66                 my $o = $v->owning_lib;
  67                 my @dups = rgrep(
  68                         sub { $_->label eq $l and $_->owning_lib == $o }, \@volumes );
  69
  70                 if( @dups == 1 ) {
  71                         push( @trimmed, @dups );
  72
  73                 } else {
  74                         my($vol, $e) = merge_volumes($editor, \@dups);
  75                         return $e if $e;
  76                         push(@trimmed, $vol);
  77                 }
  78         }
  79
  80
  81         # make all the volumes point to the master record
  82         my $stat;
  83         for $vol (@trimmed) {
  84                 if( $vol->record ne $master ) {
  85
  86                         $logger->debug("merge: moving volume ".
  87                                 $vol->id." from record ".$vol->record. " to $master");
  88
  89                         $vol->editor( $editor->requestor->id );
  90                         $vol->edit_date('now');
  91                         $vol->record( $master );
  92                         $editor->update_asset_call_number($vol)
  93                                 or return $editor->event;
  94                 }
  95         }
  96
  97         # cycle through and delete the non-master records
  98         for my $rec (@recs) {
  99
 100                 my ($record, $evt) =
 101                         $editor->retrieve_biblio_record_entry($rec);
 102                 return $evt if $evt;
 103
 104                 $logger->debug("merge: seeing if record $rec needs to be deleted or un-deleted");
 105
 106                 if( $rec == $master ) {
 107                         # make sure the master record is not deleted
 108                         if( $U->is_true($record->deleted) ) {
 109                                 $logger->info("merge: master record is marked as deleted...un-deleting.");
 110                                 $record->deleted('f');
 111                                 $record->editor($reqr->id);
 112                                 $record->edit_date('now');
 113                                 $editor->update_biblio_record_entry($record, {checkperm => 1})
 114                                         or return $editor->event;
 115                         }
 116
 117                 } else {
 118                         $logger->info("merge: deleting record $rec");
 119                         $record->deleted('t');
 120                         $record->editor($reqr->id);
 121                         $record->edit_date('now');
 122                         $editor->update_biblio_record_entry($record, {checkperm => 1})
 123                                 or return $editor->event;
 124                 }
 125         }
 126
 127         return undef;
 128 }
 129
 130
 131
 132 # takes a list of volume objects, picks the volume with most
 133 # copies and moves all copies attached to the other volumes
 134 # into said volume.  all other volumes are deleted
 135 sub merge_volumes {
 136         my( $editor, $volumes, $master ) = @_;
 137         my %copies;
 138         my $evt;
 139
 140         return ($$volumes[0]) if !$master and @$volumes == 1;
 141
 142         return ($$volumes[0]) if
 143                 $master and @$volumes == 1
 144                 and $master->id == $$volumes[0]->id;
 145
 146         $logger->debug("merge: fetching copies for volume list of size ".scalar(@$volumes));
 147
 148         # collect all of the copies attached to the selected volumes
 149         for( @$volumes ) {
 150                 $copies{$_->id} = $editor->search_asset_copy({call_number=>$_->id, deleted=>'f'});
 151                 $logger->debug("merge: found ".scalar(@{$copies{$_->id}})." copies for volume ".$_->id);
 152         }
 153
 154         my $bigcn;
 155         if( $master ) {
 156
 157                 # the caller has chosen the master record
 158                 $bigcn = $master->id;
 159                 push( @$volumes, $master );
 160
 161         } else {
 162
 163                 # find the CN with the most copies and make it the master CN
 164                 my $big = 0;
 165                 for my $cn (keys %copies) {
 166                         my $count = scalar(@{$copies{$cn}});
 167                         if( $count > $big ) {
 168                                 $big = $count;
 169                                 $bigcn = $cn;
 170                         }
 171                 }
 172         }
 173
 174         $bigcn = $$volumes[0]->id unless $bigcn;
 175
 176         $logger->info("merge: merge using volume $bigcn as the master");
 177
 178         # now move all of the copies to the new volume
 179         for my $cn (keys %copies) {
 180                 next if $cn == $bigcn;
 181                 for my $copy (@{$copies{$cn}}) {
 182                         $logger->debug("merge: setting call_number to $bigcn for copy ".$copy->id);
 183                         $copy->call_number($bigcn);
 184                         $copy->editor($editor->requestor->id);
 185                         $copy->edit_date('now');
 186                         $editor->update_asset_copy($copy, {checkperm=>1})
 187                                 or return (undef, $editor->event);
 188                 }
 189         }
 190
 191         for( @$volumes ) {
 192                 next if $_->id == $bigcn;
 193                 $logger->debug("merge: marking call_number as deleted: ".$_->id);
 194                 $_->deleted('t');
 195                 $_->editor($editor->requestor->id);
 196                 $_->edit_date('now');
 197                 $editor->update_asset_call_number($_,{checkperm=>1})
 198                         or return (undef, $editor->event);
 199         }
 200
 201         my ($mvol) = grep { $_->id == $bigcn } @$volumes;
 202         $logger->debug("merge: returning master volume ".$mvol->id);
 203         return ($mvol);
 204 }
 205
 206
 207 1;
 208
 209