Line 0
Link Here
|
0 |
- |
1 |
package C4::RecordExporter; |
|
|
2 |
|
3 |
# Copyright 2012 Catalyst IT Limited |
4 |
# |
5 |
# This file is part of Koha. |
6 |
# |
7 |
# Koha is free software; you can redistribute it and/or modify it under the |
8 |
# terms of the GNU General Public License as published by the Free Software |
9 |
# Foundation; either version 3 of the License, or (at your option) any later |
10 |
# version. |
11 |
# |
12 |
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY |
13 |
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
14 |
# A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
15 |
# |
16 |
# You should have received a copy of the GNU General Public License along |
17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
19 |
|
20 |
use strict; |
21 |
use warnings; |
22 |
use Carp; |
23 |
use C4::Context; |
24 |
use File::Temp qw/ tempfile /; |
25 |
use C4::Context; |
26 |
use C4::Biblio; |
27 |
use C4::Record; |
28 |
use MIME::Lite; |
29 |
use Data::Dumper; |
30 |
|
31 |
use vars qw($VERSION @ISA @EXPORT); |
32 |
|
33 |
BEGIN { |
34 |
|
35 |
# set the version for version checking |
36 |
$VERSION = 3.01; |
37 |
require Exporter; |
38 |
@ISA = qw(Exporter); |
39 |
@EXPORT = qw(&export_and_mail_new |
40 |
export_and_mail_deleted); |
41 |
} |
42 |
|
43 |
=head1 NAME |
44 |
|
45 |
C4::ExportRecord - Koha module for dealing with exporting records to a file |
46 |
|
47 |
=head1 SYNOPSIS |
48 |
|
49 |
use C4::ExportRecord; |
50 |
|
51 |
=head1 DESCRIPTION |
52 |
|
53 |
The functions in this module deal with creating and emailing marc files |
54 |
|
55 |
=head1 FUNCTIONS |
56 |
|
57 |
=cut |
58 |
|
59 |
=head2 export_and_mail_new |
60 |
|
61 |
export_and_mail_new($date,$to,$verbose, $export_items, $not_loan, $format, $filename, @not_itypes) |
62 |
|
63 |
Given a date and an email address this will export all records created since |
64 |
the date and mail them as an attachment, called C<$filename>, to the $to |
65 |
address. C<@not_itypes> is an array of item type codes to exclude from the |
66 |
results. |
67 |
|
68 |
Format options are: |
69 |
|
70 |
=over |
71 |
|
72 |
=item marc |
73 |
|
74 |
The attachment is binary MARC of the whole record. |
75 |
|
76 |
=item isbn |
77 |
|
78 |
The attachment is list of all the ISBNs (could be considered a CSV with one column.) |
79 |
|
80 |
=back |
81 |
|
82 |
=cut |
83 |
|
84 |
sub export_and_mail_new { |
85 |
my ( $date, $to, $verbose, $export_items, $not_loan, $format, $filename, @not_itypes ) |
86 |
= @_; |
87 |
return unless $to; # bail if we have no email address |
88 |
my $tmp_filename = |
89 |
export_newrecords( $date, $verbose, $export_items, $not_loan, $format, |
90 |
@not_itypes ); |
91 |
my $subject = "Records created since $date"; |
92 |
_mail( $tmp_filename, $to, $subject, |
93 |
$filename, 'New records' ); |
94 |
} |
95 |
|
96 |
=head2 export_and_mail_deleted |
97 |
|
98 |
export_and_mail_deleted($date,$address,$verbose,$lost); |
99 |
|
100 |
Given a date and a mailing address this will export all biblio deleted since |
101 |
the date and mail them to the address. If $lost is set, it will also include |
102 |
all biblio who have all their items lost. |
103 |
|
104 |
=cut |
105 |
|
106 |
sub export_and_mail_deleted { |
107 |
my ( $date, $to, $verbose, $lost, $format,$filename, @not_itypes ) = @_; |
108 |
return unless $to; |
109 |
my $tmp_filename = |
110 |
export_deletedrecords( $date, $verbose, $lost, $format, @not_itypes ); |
111 |
my $subject = "Records deleted since $date"; |
112 |
_mail( $tmp_filename, $to, $subject, |
113 |
$filename, 'Deleted records' ); |
114 |
} |
115 |
|
116 |
=head2 export_newcords { |
117 |
|
118 |
my $filename = export_newrecords($date,$verbose, $export_items, $not_loan, $format, @not_itypes); |
119 |
|
120 |
Given a date, it will export all records created since then to a temp file and return the filename of |
121 |
the file. If export_items is set it will attach the item data also |
122 |
|
123 |
=cut |
124 |
|
125 |
sub export_newrecords { |
126 |
my ($date,$verbose, $export_items, $not_loan, $format, @not_itypes) = @_; |
127 |
my $context = C4::Context->new(); |
128 |
my $dbh = $context->dbh(); |
129 |
my $sth; |
130 |
my $query = q{SELECT biblio.biblionumber FROM items JOIN biblio USING(biblionumber) WHERE biblio.datecreated >= ? }; |
131 |
if ( $not_loan || @not_itypes ) { |
132 |
if ( $not_loan ) { |
133 |
$query .= ' AND items.notforloan != ? '; |
134 |
} |
135 |
if ( @not_itypes ) { |
136 |
$query .= " AND items.itype NOT IN (". join(', ', ('?') x @not_itypes) . ')' ; |
137 |
} |
138 |
$sth = $dbh->prepare($query); |
139 |
if ( $not_loan && @not_itypes ) { |
140 |
$sth->execute($date, $not_loan, @not_itypes) |
141 |
} |
142 |
elsif ( $not_loan ) { |
143 |
$sth->execute($date, $not_loan) |
144 |
} |
145 |
elsif ( @not_itypes ) { |
146 |
$sth->execute($date, @not_itypes) |
147 |
} |
148 |
else { |
149 |
die $sth->err_str; # no point trying to do anything else, bail out now |
150 |
} |
151 |
} |
152 |
else { |
153 |
$sth = $dbh->prepare($query); |
154 |
$sth->execute($date) |
155 |
|| die $sth->err_str; # no point trying to do anything else, bail out now |
156 |
} |
157 |
|
158 |
my ( $fh, $filename ) = tempfile(); |
159 |
binmode( $fh, ":encoding(UTF-8)" ); |
160 |
while ( my $biblionumber = $sth->fetchrow_hashref() ) { |
161 |
my $record; |
162 |
eval { $record = GetMarcBiblio( $biblionumber->{'biblionumber'} ); }; |
163 |
|
164 |
# FIXME: decide how to handle records GetMarcBiblio can't parse or retrieve |
165 |
if ($@) { |
166 |
print "Biblio number " |
167 |
. $biblionumber->{'biblionumber'} |
168 |
. " can not be retrieved $@ \n" |
169 |
if $verbose; |
170 |
next; |
171 |
} |
172 |
if ( not defined $record ) { |
173 |
print "Biblio number " |
174 |
. $biblionumber->{'biblionumber'} |
175 |
. " can not be retrieved \n" |
176 |
if $verbose; |
177 |
next; |
178 |
} |
179 |
C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber ) |
180 |
if $export_items; |
181 |
|
182 |
print $fh record_as_format($format, $record); |
183 |
|
184 |
} |
185 |
close $fh; |
186 |
return $filename; |
187 |
} |
188 |
|
189 |
=head2 export_deletedcords { |
190 |
|
191 |
my $filename = export_deletedrecords ($date,$verbose,$lost); |
192 |
|
193 |
Given a date, it will export all records deleted since then to a temp file and return the filename of |
194 |
the file. If $lost is set it will also export those with all items marked lost |
195 |
|
196 |
=cut |
197 |
|
198 |
sub export_deletedrecords { |
199 |
my ( $date, $verbose, $export_items, $format, @itypes ) = @_; |
200 |
my $context = C4::Context->new(); |
201 |
my $dbh = $context->dbh(); |
202 |
my $sth; |
203 |
my $query = |
204 |
"SELECT biblionumber,marcxml FROM deleteditems JOIN deletedbiblioitems USING(biblionumber) WHERE deletedbiblioitems.timestamp >= ?"; |
205 |
if (@itypes) { |
206 |
$query .= " AND deleteditems.itype NOT IN (" |
207 |
. join( ', ', ('?') x @itypes ) . ')'; |
208 |
$sth = $dbh->prepare($query); |
209 |
$sth->execute( $date, @itypes ); |
210 |
} |
211 |
else { |
212 |
$sth = $dbh->prepare($query); |
213 |
$sth->execute($date) |
214 |
|| die |
215 |
$sth->err_str; # no point trying to do anything else, bail out now |
216 |
} |
217 |
|
218 |
my ( $fh, $filename ) = tempfile(); |
219 |
binmode( $fh, ":encoding(UTF-8)" ); |
220 |
while ( my $biblio = $sth->fetchrow_hashref() ) { |
221 |
my ( $error, $record ) = marcxml2marc( $biblio->{'marcxml'}, 'UTF-8' ); |
222 |
print $fh record_as_format( $format, $record ); |
223 |
} |
224 |
close $fh; |
225 |
return $filename; |
226 |
} |
227 |
|
228 |
=head2 record_as_format |
229 |
|
230 |
$out = record_as_format($format, $record); |
231 |
|
232 |
Given a C<MARC::Record>, this outputs the required information from it in a |
233 |
format determined from C<$format>. |
234 |
|
235 |
C<$format> can be: |
236 |
|
237 |
=over |
238 |
|
239 |
=item B<marc> |
240 |
|
241 |
Regular USMARC. |
242 |
|
243 |
=item B<isbn> |
244 |
|
245 |
Text columns of ISBN values from the record. If there are multiple ones, it |
246 |
will return them all. They will be cleaned a little bit, too. |
247 |
|
248 |
=back |
249 |
|
250 |
=cut |
251 |
|
252 |
sub record_as_format { |
253 |
my ($format, $record) = @_; |
254 |
|
255 |
if ($format eq 'marc') { |
256 |
# Simple enough that there's no point making a sub. |
257 |
return $record->as_usmarc(); |
258 |
} elsif ($format eq 'isbn') { |
259 |
return get_isbns($record); |
260 |
} else { |
261 |
croak "Unknown format specified: $format"; |
262 |
} |
263 |
} |
264 |
|
265 |
=head2 get_isbns |
266 |
|
267 |
$out = get_isbns($record); |
268 |
|
269 |
Given a C<MARC::Record>, this will extract the ISBN values from it, clean them |
270 |
up a bit, and return them as a newline-separated string. |
271 |
|
272 |
=cut |
273 |
|
274 |
sub get_isbns { |
275 |
my ($record) = @_; |
276 |
|
277 |
my $res = ''; |
278 |
my @fields = $record->field('020'); |
279 |
foreach my $f (@fields) { |
280 |
my $isbn = $f->subfield('a'); |
281 |
next if !$isbn; |
282 |
# We clean this by removing everything that's not a number or a space, |
283 |
# then take the first series of 9-13 consecutive digits we find |
284 |
$isbn =~ s/[^0-9 ]//g; |
285 |
$isbn =~ m/(\d{9,13})/; |
286 |
$res .= "$1\n" if $1; |
287 |
} |
288 |
return $res; |
289 |
} |
290 |
|
291 |
sub _mail { |
292 |
my ( $filename, $to, $subject, $attachment_name, $body ) = @_; |
293 |
my $context = C4::Context->new(); |
294 |
my $msg = MIME::Lite->new( |
295 |
From => $context->preference('KohaAdminEmailAddress'), |
296 |
To => $to, |
297 |
Subject => $subject, |
298 |
Type => 'multipart/mixed', |
299 |
); |
300 |
$msg->attach( |
301 |
Type => 'TEXT', |
302 |
Data => $body, |
303 |
); |
304 |
$msg->attach( |
305 |
Type => 'bin', |
306 |
Path => $filename, |
307 |
Filename => $attachment_name, |
308 |
Disposition => 'attachement' |
309 |
); |
310 |
$msg->send_by_sendmail(FromSender => $context->preference('KohaAdminEmailAddress')) |
311 |
} |
312 |
|
313 |
1; |
314 |
__END__ |
315 |
|
316 |
=head1 AUTHOR |
317 |
|
318 |
Koha Development Team <http://koha-community.org/> |
319 |
|
320 |
=head1 SEE ALSO |
321 |
|
322 |
C4::Biblio(3) |
323 |
|
324 |
=cut |