View | Details | Raw Unified | Return to bug 12919
Collapse All | Expand All

(-)a/C4/RecordExporter.pm (-1 / +324 lines)
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

Return to bug 12919