From 8ecf19717582f9e45da2a5f1967a8b60f25b51cb Mon Sep 17 00:00:00 2001 From: Chris Cormack Date: Mon, 15 Sep 2014 14:48:30 +1200 Subject: [PATCH] Bug 12919 : Module to facilitate sending new (or updated or deleted) cataloguing records somewhere --- C4/RecordExporter.pm | 324 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 C4/RecordExporter.pm diff --git a/C4/RecordExporter.pm b/C4/RecordExporter.pm new file mode 100644 index 0000000..2a98835 --- /dev/null +++ b/C4/RecordExporter.pm @@ -0,0 +1,324 @@ +package C4::RecordExporter; + +# Copyright 2012 Catalyst IT Limited +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 3 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use Carp; +use C4::Context; +use File::Temp qw/ tempfile /; +use C4::Context; +use C4::Biblio; +use C4::Record; +use MIME::Lite; +use Data::Dumper; + +use vars qw($VERSION @ISA @EXPORT); + +BEGIN { + + # set the version for version checking + $VERSION = 3.01; + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw(&export_and_mail_new + export_and_mail_deleted); +} + +=head1 NAME + +C4::ExportRecord - Koha module for dealing with exporting records to a file + +=head1 SYNOPSIS + + use C4::ExportRecord; + +=head1 DESCRIPTION + +The functions in this module deal with creating and emailing marc files + +=head1 FUNCTIONS + +=cut + +=head2 export_and_mail_new + + export_and_mail_new($date,$to,$verbose, $export_items, $not_loan, $format, $filename, @not_itypes) + +Given a date and an email address this will export all records created since +the date and mail them as an attachment, called C<$filename>, to the $to +address. C<@not_itypes> is an array of item type codes to exclude from the +results. + +Format options are: + +=over + +=item marc + +The attachment is binary MARC of the whole record. + +=item isbn + +The attachment is list of all the ISBNs (could be considered a CSV with one column.) + +=back + +=cut + +sub export_and_mail_new { + my ( $date, $to, $verbose, $export_items, $not_loan, $format, $filename, @not_itypes ) + = @_; + return unless $to; # bail if we have no email address + my $tmp_filename = + export_newrecords( $date, $verbose, $export_items, $not_loan, $format, + @not_itypes ); + my $subject = "Records created since $date"; + _mail( $tmp_filename, $to, $subject, + $filename, 'New records' ); +} + +=head2 export_and_mail_deleted + + export_and_mail_deleted($date,$address,$verbose,$lost); + +Given a date and a mailing address this will export all biblio deleted since +the date and mail them to the address. If $lost is set, it will also include +all biblio who have all their items lost. + +=cut + +sub export_and_mail_deleted { + my ( $date, $to, $verbose, $lost, $format,$filename, @not_itypes ) = @_; + return unless $to; + my $tmp_filename = + export_deletedrecords( $date, $verbose, $lost, $format, @not_itypes ); + my $subject = "Records deleted since $date"; + _mail( $tmp_filename, $to, $subject, + $filename, 'Deleted records' ); +} + +=head2 export_newcords { + + my $filename = export_newrecords($date,$verbose, $export_items, $not_loan, $format, @not_itypes); + +Given a date, it will export all records created since then to a temp file and return the filename of +the file. If export_items is set it will attach the item data also + +=cut + +sub export_newrecords { + my ($date,$verbose, $export_items, $not_loan, $format, @not_itypes) = @_; + my $context = C4::Context->new(); + my $dbh = $context->dbh(); + my $sth; + my $query = q{SELECT biblio.biblionumber FROM items JOIN biblio USING(biblionumber) WHERE biblio.datecreated >= ? }; + if ( $not_loan || @not_itypes ) { + if ( $not_loan ) { + $query .= ' AND items.notforloan != ? '; + } + if ( @not_itypes ) { + $query .= " AND items.itype NOT IN (". join(', ', ('?') x @not_itypes) . ')' ; + } + $sth = $dbh->prepare($query); + if ( $not_loan && @not_itypes ) { + $sth->execute($date, $not_loan, @not_itypes) + } + elsif ( $not_loan ) { + $sth->execute($date, $not_loan) + } + elsif ( @not_itypes ) { + $sth->execute($date, @not_itypes) + } + else { + die $sth->err_str; # no point trying to do anything else, bail out now + } + } + else { + $sth = $dbh->prepare($query); + $sth->execute($date) + || die $sth->err_str; # no point trying to do anything else, bail out now + } + + my ( $fh, $filename ) = tempfile(); + binmode( $fh, ":encoding(UTF-8)" ); + while ( my $biblionumber = $sth->fetchrow_hashref() ) { + my $record; + eval { $record = GetMarcBiblio( $biblionumber->{'biblionumber'} ); }; + + # FIXME: decide how to handle records GetMarcBiblio can't parse or retrieve + if ($@) { + print "Biblio number " + . $biblionumber->{'biblionumber'} + . " can not be retrieved $@ \n" + if $verbose; + next; + } + if ( not defined $record ) { + print "Biblio number " + . $biblionumber->{'biblionumber'} + . " can not be retrieved \n" + if $verbose; + next; + } + C4::Biblio::EmbedItemsInMarcBiblio( $record, $biblionumber ) + if $export_items; + + print $fh record_as_format($format, $record); + + } + close $fh; + return $filename; +} + +=head2 export_deletedcords { + + my $filename = export_deletedrecords ($date,$verbose,$lost); + +Given a date, it will export all records deleted since then to a temp file and return the filename of +the file. If $lost is set it will also export those with all items marked lost + +=cut + +sub export_deletedrecords { + my ( $date, $verbose, $export_items, $format, @itypes ) = @_; + my $context = C4::Context->new(); + my $dbh = $context->dbh(); + my $sth; + my $query = +"SELECT biblionumber,marcxml FROM deleteditems JOIN deletedbiblioitems USING(biblionumber) WHERE deletedbiblioitems.timestamp >= ?"; + if (@itypes) { + $query .= " AND deleteditems.itype NOT IN (" + . join( ', ', ('?') x @itypes ) . ')'; + $sth = $dbh->prepare($query); + $sth->execute( $date, @itypes ); + } + else { + $sth = $dbh->prepare($query); + $sth->execute($date) + || die + $sth->err_str; # no point trying to do anything else, bail out now + } + + my ( $fh, $filename ) = tempfile(); + binmode( $fh, ":encoding(UTF-8)" ); + while ( my $biblio = $sth->fetchrow_hashref() ) { + my ( $error, $record ) = marcxml2marc( $biblio->{'marcxml'}, 'UTF-8' ); + print $fh record_as_format( $format, $record ); + } + close $fh; + return $filename; +} + +=head2 record_as_format + + $out = record_as_format($format, $record); + +Given a C, this outputs the required information from it in a +format determined from C<$format>. + +C<$format> can be: + +=over + +=item B + +Regular USMARC. + +=item B + +Text columns of ISBN values from the record. If there are multiple ones, it +will return them all. They will be cleaned a little bit, too. + +=back + +=cut + +sub record_as_format { + my ($format, $record) = @_; + + if ($format eq 'marc') { + # Simple enough that there's no point making a sub. + return $record->as_usmarc(); + } elsif ($format eq 'isbn') { + return get_isbns($record); + } else { + croak "Unknown format specified: $format"; + } +} + +=head2 get_isbns + + $out = get_isbns($record); + +Given a C, this will extract the ISBN values from it, clean them +up a bit, and return them as a newline-separated string. + +=cut + +sub get_isbns { + my ($record) = @_; + + my $res = ''; + my @fields = $record->field('020'); + foreach my $f (@fields) { + my $isbn = $f->subfield('a'); + next if !$isbn; + # We clean this by removing everything that's not a number or a space, + # then take the first series of 9-13 consecutive digits we find + $isbn =~ s/[^0-9 ]//g; + $isbn =~ m/(\d{9,13})/; + $res .= "$1\n" if $1; + } + return $res; +} + +sub _mail { + my ( $filename, $to, $subject, $attachment_name, $body ) = @_; + my $context = C4::Context->new(); + my $msg = MIME::Lite->new( + From => $context->preference('KohaAdminEmailAddress'), + To => $to, + Subject => $subject, + Type => 'multipart/mixed', + ); + $msg->attach( + Type => 'TEXT', + Data => $body, + ); + $msg->attach( + Type => 'bin', + Path => $filename, + Filename => $attachment_name, + Disposition => 'attachement' + ); + $msg->send_by_sendmail(FromSender => $context->preference('KohaAdminEmailAddress')) +} + +1; +__END__ + +=head1 AUTHOR + +Koha Development Team + +=head1 SEE ALSO + +C4::Biblio(3) + +=cut -- 2.1.0