cataloguing/merge.pl

   1 #!/usr/bin/perl
   2
   3
   4 # Copyright 2009 BibLibre
   5 # Parts Copyright Catalyst IT 2011
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it
  10 # under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but
  15 # WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  21
  22 use strict;
  23 #use warnings; FIXME - Bug 2505
  24 use CGI qw ( -utf8 );
  25 use C4::Output;
  26 use C4::Auth;
  27 use C4::Items;
  28 use C4::Biblio;
  29 use C4::Serials;
  30 use C4::Koha;
  31 use C4::Reserves qw/MergeHolds/;
  32 use C4::Acquisition qw/ModOrder GetOrdersByBiblionumber/;
  33 use Koha::MetadataRecord;
  34
  35 my $input = new CGI;
  36 my @biblionumber = $input->param('biblionumber');
  37 my $merge = $input->param('merge');
  38
  39 my @errors;
  40
  41 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
  42     {
  43         template_name   => "cataloguing/merge.tt",
  44         query           => $input,
  45         type            => "intranet",
  46         authnotrequired => 0,
  47         flagsrequired   => { editcatalogue => 'edit_catalogue' },
  48     }
  49 );
  50
  51 #------------------------
  52 # Merging
  53 #------------------------
  54 if ($merge) {
  55
  56     my $dbh = C4::Context->dbh;
  57     my $sth;
  58
  59     # Creating a new record from the html code
  60     my $record       = TransformHtmlToMarc( $input );
  61     my $tobiblio     =  $input->param('biblio1');
  62     my $frombiblio   =  $input->param('biblio2');
  63
  64     # Rewriting the leader
  65     $record->leader(GetMarcBiblio($tobiblio)->leader());
  66
  67     my $frameworkcode = $input->param('frameworkcode');
  68     my @notmoveditems;
  69
  70     # Modifying the reference record
  71     ModBiblio($record, $tobiblio, $frameworkcode);
  72
  73     # Moving items from the other record to the reference record
  74     # Also moving orders from the other record to the reference record, only if the order is linked to an item of the other record
  75     my $itemnumbers = get_itemnumbers_of($frombiblio);
  76     foreach my $itloop ($itemnumbers->{$frombiblio}) {
  77     foreach my $itemnumber (@$itloop) {
  78         my $res = MoveItemFromBiblio($itemnumber, $frombiblio, $tobiblio);
  79         if (not defined $res) {
  80             push @notmoveditems, $itemnumber;
  81         }
  82     }
  83     }
  84     # If some items could not be moved :
  85     if (scalar(@notmoveditems) > 0) {
  86         my $itemlist = join(' ',@notmoveditems);
  87         push @errors, { code => "CANNOT_MOVE", value => $itemlist };
  88     }
  89
  90     # Moving subscriptions from the other record to the reference record
  91     my $subcount = CountSubscriptionFromBiblionumber($frombiblio);
  92     if ($subcount > 0) {
  93     $sth = $dbh->prepare("UPDATE subscription SET biblionumber = ? WHERE biblionumber = ?");
  94     $sth->execute($tobiblio, $frombiblio);
  95
  96     $sth = $dbh->prepare("UPDATE subscriptionhistory SET biblionumber = ? WHERE biblionumber = ?");
  97     $sth->execute($tobiblio, $frombiblio);
  98
  99     }
 100
 101     # Moving serials
 102     $sth = $dbh->prepare("UPDATE serial SET biblionumber = ? WHERE biblionumber = ?");
 103     $sth->execute($tobiblio, $frombiblio);
 104
 105     # TODO : Moving reserves
 106
 107     # Moving orders (orders linked to items of frombiblio have already been moved by MoveItemFromBiblio)
 108     my @allorders = GetOrdersByBiblionumber($frombiblio);
 109     my @tobiblioitem = GetBiblioItemByBiblioNumber ($tobiblio);
 110     my $tobiblioitem_biblioitemnumber = $tobiblioitem [0]-> {biblioitemnumber };
 111     foreach my $myorder (@allorders) {
 112         $myorder->{'biblionumber'} = $tobiblio;
 113         ModOrder ($myorder);
 114     # TODO : add error control (in ModOrder?)
 115     }
 116
 117     # Deleting the other record
 118     if (scalar(@errors) == 0) {
 119     # Move holds
 120     MergeHolds($dbh,$tobiblio,$frombiblio);
 121     my $error = DelBiblio($frombiblio);
 122     push @errors, $error if ($error);
 123     }
 124
 125     # Parameters
 126     $template->param(
 127     result => 1,
 128     biblio1 => $input->param('biblio1')
 129     );
 130
 131 #-------------------------
 132 # Show records to merge
 133 #-------------------------
 134 } else {
 135     my $mergereference = $input->param('mergereference');
 136     my $biblionumber = $input->param('biblionumber');
 137
 138     if (scalar(@biblionumber) != 2) {
 139         push @errors, { code => "WRONG_COUNT", value => scalar(@biblionumber) };
 140     }
 141     else {
 142         my $data1 = GetBiblioData($biblionumber[0]);
 143         my $record1 = GetMarcBiblio($biblionumber[0]);
 144
 145         my $data2 = GetBiblioData($biblionumber[1]);
 146         my $record2 = GetMarcBiblio($biblionumber[1]);
 147
 148         # Checks if both records use the same framework
 149         my $frameworkcode1 = &GetFrameworkCode($biblionumber[0]);
 150         my $frameworkcode2 = &GetFrameworkCode($biblionumber[1]);
 151
 152
 153         my $subtitle1 = GetRecordValue('subtitle', $record1, $frameworkcode1);
 154         my $subtitle2 = GetRecordValue('subtitle', $record2, $frameworkcode1);
 155
 156         if ($mergereference) {
 157
 158             my $framework;
 159             if ($frameworkcode1 ne $frameworkcode2) {
 160                 $framework = $input->param('frameworkcode')
 161                   or push @errors, "Famework not selected.";
 162             } else {
 163                 $framework = $frameworkcode1;
 164             }
 165
 166             # Getting MARC Structure
 167             my $tagslib = GetMarcStructure(1, $framework);
 168
 169             my $notreference = ($biblionumber[0] == $mergereference) ? $biblionumber[1] : $biblionumber[0];
 170
 171             # Creating a loop for display
 172
 173             my $recordObj1 = new Koha::MetadataRecord({ 'record' => GetMarcBiblio($mergereference), 'schema' => lc C4::Context->preference('marcflavour') });
 174             my $recordObj2 = new Koha::MetadataRecord({ 'record' => GetMarcBiblio($notreference), 'schema' => lc C4::Context->preference('marcflavour') });
 175
 176             my @record1 = $recordObj1->createMergeHash($tagslib);
 177             my @record2 = $recordObj2->createMergeHash($tagslib);
 178
 179             # Parameters
 180             $template->param(
 181                 biblio1 => $mergereference,
 182                 biblio2 => $notreference,
 183                 mergereference => $mergereference,
 184                 record1 => @record1,
 185                 record2 => @record2,
 186                 framework => $framework,
 187             );
 188         }
 189         else {
 190
 191         # Ask the user to choose which record will be the kept
 192             $template->param(
 193                 choosereference => 1,
 194                 biblio1 => $biblionumber[0],
 195                 biblio2 => $biblionumber[1],
 196                 title1 => $data1->{'title'},
 197                 subtitle1 => $subtitle1,
 198                 title2 => $data2->{'title'},
 199                 subtitle2 => $subtitle2
 200             );
 201             if ($frameworkcode1 ne $frameworkcode2) {
 202                 my $frameworks = getframeworks;
 203                 my @frameworkselect;
 204                 foreach my $thisframeworkcode ( keys %$frameworks ) {
 205                     my %row = (
 206                         value         => $thisframeworkcode,
 207                         frameworktext => $frameworks->{$thisframeworkcode}->{'frameworktext'},
 208                     );
 209                     if ($frameworkcode1 eq $thisframeworkcode){
 210                         $row{'selected'} = 1;
 211                         }
 212                     push @frameworkselect, \%row;
 213                 }
 214                 $template->param(
 215                     frameworkselect => \@frameworkselect,
 216                     frameworkcode1 => $frameworkcode1,
 217                     frameworkcode2 => $frameworkcode2,
 218                 );
 219             }
 220         }
 221     }
 222 }
 223
 224 if (@errors) {
 225     # Errors
 226     $template->param( errors  => \@errors );
 227 }
 228
 229 output_html_with_http_headers $input, $cookie, $template->output;
 230 exit;
 231
 232 =head1 FUNCTIONS
 233
 234 =cut
 235
 236 # ------------------------
 237 # Functions
 238 # ------------------------