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-27
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 |
|
|
24 |
use CGI qw ( -utf8 ); |
22 |
use CGI qw ( -utf8 ); |
|
|
23 |
|
25 |
use C4::Output; |
24 |
use C4::Output; |
26 |
use C4::Auth; |
25 |
use C4::Auth; |
27 |
use C4::Items; |
26 |
use C4::Items; |
Lines 33-39
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; |
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 |
# ------------------------ |