| Lines 1-6
          
      
      
        Link Here | 
        
          | 1 | #!/usr/bin/perl | 1 | #!/usr/bin/perl | 
        
          | 2 |  | 2 |  | 
            
              | 3 |  |  |  | 
        
          | 4 | # Copyright 2009 BibLibre | 3 | # Copyright 2009 BibLibre | 
        
          | 5 | # Parts Copyright Catalyst IT 2011 | 4 | # Parts Copyright Catalyst IT 2011 | 
        
          | 6 | # | 5 | # | 
  
    | Lines 19-26
          
      
      
        Link Here | 
        
          | 19 | # with Koha; if not, write to the Free Software Foundation, Inc., | 18 | # with Koha; if not, write to the Free Software Foundation, Inc., | 
        
          | 20 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | 19 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | 
        
          | 21 |  | 20 |  | 
          
            
              | 22 | use strict; | 21 | use Modern::Perl; | 
            
              | 23 | #use warnings; FIXME - Bug 2505 | 22 |  | 
        
          | 24 | use CGI; | 23 | use CGI; | 
        
          | 25 | use C4::Output; | 24 | use C4::Output; | 
        
          | 26 | use C4::Auth; | 25 | use C4::Auth; | 
  
    | Lines 33-46
          use C4::Acquisition qw/ModOrder GetOrdersByBiblionumber/;
      
      
        Link Here | 
        
          | 33 | use Koha::MetadataRecord; | 32 | use Koha::MetadataRecord; | 
        
          | 34 |  | 33 |  | 
        
          | 35 | my $input = new CGI; | 34 | my $input = new CGI; | 
          
            
              | 36 | my @biblionumber = $input->param('biblionumber'); | 35 | my @biblionumbers = $input->param('biblionumber'); | 
        
          | 37 | my $merge = $input->param('merge'); | 36 | my $merge = $input->param('merge'); | 
        
          | 38 |  | 37 |  | 
        
          | 39 | my @errors; | 38 | my @errors; | 
        
          | 40 |  | 39 |  | 
        
          | 41 | my ( $template, $loggedinuser, $cookie ) = get_template_and_user( | 40 | my ( $template, $loggedinuser, $cookie ) = get_template_and_user( | 
        
          | 42 |     { | 41 |     { | 
          
            
              | 43 |         template_name   => "cataloguing/merge.tmpl", | 42 |         template_name   => "cataloguing/merge.tt", | 
        
          | 44 |         query           => $input, | 43 |         query           => $input, | 
        
          | 45 |         type            => "intranet", | 44 |         type            => "intranet", | 
        
          | 46 |         authnotrequired => 0, | 45 |         authnotrequired => 0, | 
  
    | Lines 54-81
          my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
      
      
        Link Here | 
        
          | 54 | if ($merge) { | 53 | if ($merge) { | 
        
          | 55 |  | 54 |  | 
        
          | 56 |     my $dbh = C4::Context->dbh; | 55 |     my $dbh = C4::Context->dbh; | 
            
              | 57 |     my $sth; |  |  | 
        
          | 58 |  | 56 |  | 
        
          | 59 |     # Creating a new record from the html code | 57 |     # Creating a new record from the html code | 
        
          | 60 |     my $record       = TransformHtmlToMarc( $input ); | 58 |     my $record       = TransformHtmlToMarc( $input ); | 
          
            
              | 61 |     my $tobiblio     =  $input->param('biblio1'); | 59 |     my $ref_biblionumber = $input->param('ref_biblionumber'); | 
            
              | 62 |     my $frombiblio   =  $input->param('biblio2'); | 60 |     @biblionumbers = grep { $_ != $ref_biblionumber } @biblionumbers; | 
            
              |  |  | 61 |  | 
            
              | 62 |     # prepare report | 
            
              | 63 |     my @report_records; | 
            
              | 64 |     my $report_fields_str = $input->param('report_fields'); | 
            
              | 65 |     $report_fields_str ||= C4::Context->preference('MergeReportFields'); | 
            
              | 66 |     my @report_fields; | 
            
              | 67 |     foreach my $field_str (split /,/, $report_fields_str) { | 
            
              | 68 |         if ($field_str =~ /(\d{3})([0-9a-z]*)/) { | 
            
              | 69 |             my ($field, $subfields) = ($1, $2); | 
            
              | 70 |             push @report_fields, { | 
            
              | 71 |                 tag => $field, | 
            
              | 72 |                 subfields => [ split //, $subfields ] | 
            
              | 73 |             } | 
            
              | 74 |         } | 
            
              | 75 |     } | 
        
          | 63 |  | 76 |  | 
        
          | 64 |     # Rewriting the leader | 77 |     # Rewriting the leader | 
          
            
              | 65 |     $record->leader(GetMarcBiblio($tobiblio)->leader()); | 78 |     $record->leader(GetMarcBiblio($ref_biblionumber)->leader()); | 
        
          | 66 |  | 79 |  | 
        
          | 67 |     my $frameworkcode = $input->param('frameworkcode'); | 80 |     my $frameworkcode = $input->param('frameworkcode'); | 
        
          | 68 |     my @notmoveditems; | 81 |     my @notmoveditems; | 
        
          | 69 |  | 82 |  | 
        
          | 70 |     # Modifying the reference record | 83 |     # Modifying the reference record | 
          
            
              | 71 |     ModBiblio($record, $tobiblio, $frameworkcode); | 84 |     ModBiblio($record, $ref_biblionumber, $frameworkcode); | 
        
          | 72 |  | 85 |  | 
        
          | 73 |     # Moving items from the other record to the reference record | 86 |     # 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 | 87 |     foreach my $biblionumber (@biblionumbers) { | 
            
              | 75 |     my $itemnumbers = get_itemnumbers_of($frombiblio); | 88 |         my $itemnumbers = get_itemnumbers_of($biblionumber); | 
            
              | 76 |     foreach my $itloop ($itemnumbers->{$frombiblio}) { | 89 |         foreach my $itemnumber (@{ $itemnumbers->{$biblionumber} }) { | 
            
              | 77 |     foreach my $itemnumber (@$itloop) { | 90 |         my $res = MoveItemFromBiblio($itemnumber, $biblionumber, $ref_biblionumber); | 
            
              | 78 |         my $res = MoveItemFromBiblio($itemnumber, $frombiblio, $tobiblio); |  |  | 
        
          | 79 |         if (not defined $res) { | 91 |         if (not defined $res) { | 
        
          | 80 |             push @notmoveditems, $itemnumber; | 92 |             push @notmoveditems, $itemnumber; | 
        
          | 81 |         } | 93 |         } | 
  
    | Lines 87-223
          if ($merge) {
      
      
        Link Here | 
        
          | 87 |         push @errors, { code => "CANNOT_MOVE", value => $itemlist }; | 99 |         push @errors, { code => "CANNOT_MOVE", value => $itemlist }; | 
        
          | 88 |     } | 100 |     } | 
        
          | 89 |  | 101 |  | 
          
            
              | 90 |     # Moving subscriptions from the other record to the reference record | 102 |     my $sth_subscription = $dbh->prepare(" | 
            
              | 91 |     my $subcount = CountSubscriptionFromBiblionumber($frombiblio); | 103 |         UPDATE subscription SET biblionumber = ? WHERE biblionumber = ? | 
            
              | 92 |     if ($subcount > 0) { | 104 |     "); | 
            
              | 93 |     $sth = $dbh->prepare("UPDATE subscription SET biblionumber = ? WHERE biblionumber = ?"); | 105 |     my $sth_subscriptionhistory = $dbh->prepare(" | 
            
              | 94 |     $sth->execute($tobiblio, $frombiblio); | 106 |         UPDATE subscriptionhistory SET biblionumber = ? WHERE biblionumber = ? | 
            
              | 95 |  | 107 |     "); | 
            
              | 96 |     $sth = $dbh->prepare("UPDATE subscriptionhistory SET biblionumber = ? WHERE biblionumber = ?"); | 108 |     my $sth_serial = $dbh->prepare(" | 
            
              | 97 |     $sth->execute($tobiblio, $frombiblio); | 109 |         UPDATE serial SET biblionumber = ? WHERE biblionumber = ? | 
            
              | 98 |  | 110 |     "); | 
            
              |  |  | 111 |  | 
            
              | 112 |     my $report_header = {}; | 
            
              | 113 |     foreach my $biblionumber ($ref_biblionumber, @biblionumbers) { | 
            
              | 114 |         # build report | 
            
              | 115 |         my $marcrecord = GetMarcBiblio($biblionumber); | 
            
              | 116 |         my %report_record = ( | 
            
              | 117 |             biblionumber => $biblionumber, | 
            
              | 118 |             fields => {}, | 
            
              | 119 |         ); | 
            
              | 120 |         foreach my $field (@report_fields) { | 
            
              | 121 |             my @marcfields = $marcrecord->field($field->{tag}); | 
            
              | 122 |             foreach my $marcfield (@marcfields) { | 
            
              | 123 |                 my $tag = $marcfield->tag(); | 
            
              | 124 |                 my %subfields; | 
            
              | 125 |                 if (scalar @{$field->{subfields}}) { | 
            
              | 126 |                     foreach my $subfield (@{$field->{subfields}}) { | 
            
              | 127 |                         my @values = $marcfield->subfield($subfield); | 
            
              | 128 |                         $report_header->{ $tag . $subfield } = 1; | 
            
              | 129 |                         push @{ $report_record{fields}->{$tag . $subfield} }, @values; | 
            
              | 130 |                     } | 
            
              | 131 |                 } elsif ($field->{tag} gt '009') { | 
            
              | 132 |                     my @marcsubfields = $marcfield->subfields(); | 
            
              | 133 |                     foreach my $marcsubfield (@marcsubfields) { | 
            
              | 134 |                         my ($code, $value) = @$marcsubfield; | 
            
              | 135 |                         $report_header->{ $tag . $code } = 1; | 
            
              | 136 |                         push @{ $report_record{fields}->{ $tag . $code } }, $value; | 
            
              | 137 |                     } | 
            
              | 138 |                 } else { | 
            
              | 139 |                     $report_header->{ $tag . '@' } = 1; | 
            
              | 140 |                     push @{ $report_record{fields}->{ $tag .'@' } }, $marcfield->data(); | 
            
              | 141 |                 } | 
            
              | 142 |             } | 
            
              | 143 |         } | 
            
              | 144 |         push @report_records, \%report_record; | 
        
          | 99 |     } | 145 |     } | 
        
          | 100 |  | 146 |  | 
          
            
              | 101 |     # Moving serials | 147 |     foreach my $biblionumber (@biblionumbers) { | 
            
              | 102 |     $sth = $dbh->prepare("UPDATE serial SET biblionumber = ? WHERE biblionumber = ?"); | 148 |         # Moving subscriptions from the other record to the reference record | 
            
              | 103 |     $sth->execute($tobiblio, $frombiblio); | 149 |         my $subcount = CountSubscriptionFromBiblionumber($biblionumber); | 
            
              |  |  | 150 |         if ($subcount > 0) { | 
            
              | 151 |             $sth_subscription->execute($ref_biblionumber, $biblionumber); | 
            
              | 152 |             $sth_subscriptionhistory->execute($ref_biblionumber, $biblionumber); | 
            
              | 153 |         } | 
        
          | 104 |  | 154 |  | 
          
            
              | 105 |     # TODO : Moving reserves | 155 |     # Moving serials | 
            
              |  |  | 156 |         $sth_serial->execute($ref_biblionumber, $biblionumber); | 
        
          | 106 |  | 157 |  | 
        
          | 107 |     # Moving orders (orders linked to items of frombiblio have already been moved by MoveItemFromBiblio) | 158 |     # Moving orders (orders linked to items of frombiblio have already been moved by MoveItemFromBiblio) | 
          
            
              | 108 |     my @allorders = GetOrdersByBiblionumber($frombiblio); | 159 |     my @allorders = GetOrdersByBiblionumber($biblionumber); | 
            
              | 109 |     my @tobiblioitem = GetBiblioItemByBiblioNumber ($tobiblio); | 160 |     my @tobiblioitem = GetBiblioItemByBiblioNumber ($ref_biblionumber); | 
        
          | 110 |     my $tobiblioitem_biblioitemnumber = $tobiblioitem [0]-> {biblioitemnumber }; | 161 |     my $tobiblioitem_biblioitemnumber = $tobiblioitem [0]-> {biblioitemnumber }; | 
        
          | 111 |     foreach my $myorder (@allorders) { | 162 |     foreach my $myorder (@allorders) { | 
          
            
              | 112 |         $myorder->{'biblionumber'} = $tobiblio; | 163 |         $myorder->{'biblionumber'} = $ref_biblionumber; | 
        
          | 113 |         ModOrder ($myorder); | 164 |         ModOrder ($myorder); | 
        
          | 114 |     # TODO : add error control (in ModOrder?) | 165 |     # TODO : add error control (in ModOrder?) | 
        
          | 115 |     } | 166 |     } | 
        
          | 116 |  | 167 |  | 
          
            
              | 117 |     # Deleting the other record | 168 |     # Deleting the other records | 
        
          | 118 |     if (scalar(@errors) == 0) { | 169 |     if (scalar(@errors) == 0) { | 
          
            
              | 119 |     # Move holds | 170 |         # Move holds | 
            
              | 120 |     MergeHolds($dbh,$tobiblio,$frombiblio); | 171 |         MergeHolds($dbh, $ref_biblionumber, $biblionumber); | 
            
              | 121 |     my $error = DelBiblio($frombiblio); | 172 |         my $error = DelBiblio($biblionumber); | 
            
              | 122 |     push @errors, $error if ($error); | 173 |         push @errors, $error if ($error); | 
        
          | 123 |     } | 174 |     } | 
            
              |  |  | 175 | } | 
        
          | 124 |  | 176 |  | 
        
          | 125 |     # Parameters | 177 |     # Parameters | 
        
          | 126 |     $template->param( | 178 |     $template->param( | 
          
            
              | 127 |     result => 1, | 179 |         result => 1, | 
            
              | 128 |     biblio1 => $input->param('biblio1') | 180 |         report_records => \@report_records, | 
            
              |  |  | 181 |         report_header => $report_header, | 
            
              | 182 |         ref_biblionumber => $input->param('ref_biblionumber') | 
        
          | 129 |     ); | 183 |     ); | 
        
          | 130 |  | 184 |  | 
        
          | 131 | #------------------------- | 185 | #------------------------- | 
        
          | 132 | # Show records to merge | 186 | # Show records to merge | 
        
          | 133 | #------------------------- | 187 | #------------------------- | 
        
          | 134 | } else { | 188 | } else { | 
          
            
              | 135 |     my $mergereference = $input->param('mergereference'); | 189 |     my $ref_biblionumber = $input->param('ref_biblionumber'); | 
            
              | 136 |     my $biblionumber = $input->param('biblionumber'); | 190 |  | 
            
              | 137 |  | 191 |     if ($ref_biblionumber) { | 
            
              | 138 |     if (scalar(@biblionumber) != 2) { | 192 |         my $framework = $input->param('frameworkcode'); | 
            
              | 139 |         push @errors, { code => "WRONG_COUNT", value => scalar(@biblionumber) }; | 193 |         $framework //= GetFrameworkCode($ref_biblionumber); | 
            
              | 140 |     } | 194 |  | 
            
              | 141 |     else { | 195 |         # Getting MARC Structure | 
            
              | 142 |         my $data1 = GetBiblioData($biblionumber[0]); | 196 |         my $tagslib = GetMarcStructure(1, $framework); | 
            
              | 143 |         my $record1 = GetMarcBiblio($biblionumber[0]); | 197 |  | 
            
              | 144 |  | 198 |         my $marcflavour = lc(C4::Context->preference('marcflavour')); | 
            
              | 145 |         my $data2 = GetBiblioData($biblionumber[1]); | 199 |  | 
            
              | 146 |         my $record2 = GetMarcBiblio($biblionumber[1]); | 200 |         # Creating a loop for display | 
            
              | 147 |  | 201 |         my @records; | 
            
              | 148 |         # Checks if both records use the same framework | 202 |         foreach my $biblionumber (@biblionumbers) { | 
            
              | 149 |         my $frameworkcode1 = &GetFrameworkCode($biblionumber[0]); | 203 |             my $marcrecord = GetMarcBiblio($biblionumber); | 
            
              | 150 |         my $frameworkcode2 = &GetFrameworkCode($biblionumber[1]); | 204 |             my $frameworkcode = GetFrameworkCode($biblionumber); | 
            
              | 151 |  | 205 |             my $recordObj = new Koha::MetadataRecord({'record' => $marcrecord, schema => $marcflavour}); | 
            
              | 152 |  | 206 |             my $record = { | 
            
              | 153 |         my $subtitle1 = GetRecordValue('subtitle', $record1, $frameworkcode1); | 207 |                 biblionumber => $biblionumber, | 
            
              | 154 |         my $subtitle2 = GetRecordValue('subtitle', $record2, $frameworkcode1); | 208 |                 record => $marcrecord, | 
            
              | 155 |  | 209 |                 frameworkcode => $frameworkcode, | 
            
              | 156 |         if ($mergereference) { | 210 |                 display => $recordObj->createMergeHash($tagslib), | 
            
              | 157 |  | 211 |             }; | 
            
              | 158 |             my $framework; | 212 |             if ($ref_biblionumber and $ref_biblionumber == $biblionumber) { | 
            
              | 159 |             if ($frameworkcode1 ne $frameworkcode2) { | 213 |                 $record->{reference} = 1; | 
            
              | 160 |                 $framework = $input->param('frameworkcode') | 214 |                 $template->param(ref_record => $record); | 
            
              | 161 |                   or push @errors, "Famework not selected."; | 215 |                 unshift @records, $record; | 
        
          | 162 |             } else { | 216 |             } else { | 
          
            
              | 163 |                 $framework = $frameworkcode1; | 217 |                 push @records, $record; | 
        
          | 164 |             } | 218 |             } | 
            
              | 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 |         } | 219 |         } | 
            
              | 189 |         else { |  |  | 
        
          | 190 |  | 220 |  | 
            
              |  |  | 221 |         my ($biblionumbertag) = GetMarcFromKohaField('biblio.biblionumber'); | 
            
              | 222 |  | 
            
              | 223 |         # Parameters | 
            
              | 224 |         $template->param( | 
            
              | 225 |             ref_biblionumber => $ref_biblionumber, | 
            
              | 226 |             records => \@records, | 
            
              | 227 |             ref_record => $records[0], | 
            
              | 228 |             framework => $framework, | 
            
              | 229 |             biblionumbertag => $biblionumbertag, | 
            
              | 230 |             MergeReportFields => C4::Context->preference('MergeReportFields'), | 
            
              | 231 |         ); | 
            
              | 232 |     } else { | 
            
              | 233 |         my @records; | 
            
              | 234 |         foreach my $biblionumber (@biblionumbers) { | 
            
              | 235 |             my $frameworkcode = GetFrameworkCode($biblionumber); | 
            
              | 236 |             my $record = { | 
            
              | 237 |                 biblionumber => $biblionumber, | 
            
              | 238 |                 data => GetBiblioData($biblionumber), | 
            
              | 239 |                 frameworkcode => $frameworkcode, | 
            
              | 240 |             }; | 
            
              | 241 |             push @records, $record; | 
            
              | 242 |         } | 
        
          | 191 |         # Ask the user to choose which record will be the kept | 243 |         # Ask the user to choose which record will be the kept | 
          
            
              | 192 |             $template->param( | 244 |         $template->param( | 
            
              | 193 |                 choosereference => 1, | 245 |             choosereference => 1, | 
            
              | 194 |                 biblio1 => $biblionumber[0], | 246 |             records => \@records, | 
            
              | 195 |                 biblio2 => $biblionumber[1], | 247 |         ); | 
            
              | 196 |                 title1 => $data1->{'title'}, | 248 |  | 
            
              | 197 |                 subtitle1 => $subtitle1, | 249 |         my $frameworks = getframeworks; | 
            
              | 198 |                 title2 => $data2->{'title'}, | 250 |         my @frameworkselect; | 
            
              | 199 |                 subtitle2 => $subtitle2 | 251 |         foreach my $thisframeworkcode ( keys %$frameworks ) { | 
            
              |  |  | 252 |             my %row = ( | 
            
              | 253 |                 value         => $thisframeworkcode, | 
            
              | 254 |                 frameworktext => $frameworks->{$thisframeworkcode}->{'frameworktext'}, | 
        
          | 200 |             ); | 255 |             ); | 
          
            
              | 201 |             if ($frameworkcode1 ne $frameworkcode2) { | 256 |             push @frameworkselect, \%row; | 
            
              | 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 |         } | 257 |         } | 
            
              |  |  | 258 |         $template->param( | 
            
              | 259 |             frameworkselect => \@frameworkselect, | 
            
              | 260 |         ); | 
        
          | 221 |     } | 261 |     } | 
        
          | 222 | } | 262 | } | 
        
          | 223 |  | 263 |  | 
  
    | Lines 228-238
          if (@errors) {
      
      
        Link Here | 
        
          | 228 |  | 268 |  | 
        
          | 229 | output_html_with_http_headers $input, $cookie, $template->output; | 269 | output_html_with_http_headers $input, $cookie, $template->output; | 
        
          | 230 | exit; | 270 | exit; | 
            
              | 231 |  |  |  | 
            
              | 232 | =head1 FUNCTIONS | 
            
              | 233 |  | 
            
              | 234 | =cut | 
            
              | 235 |  | 
            
              | 236 | # ------------------------ | 
            
              | 237 | # Functions | 
            
              | 238 | # ------------------------ |