C4/Breeding.pm

   1 package C4::Breeding;
   2
   3 # Copyright 2000-2002 Katipo Communications
   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 2 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 with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 use C4::Biblio;
  22 use MARC::File::USMARC;
  23 require Exporter;
  24
  25 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  26
  27 # set the version for version checking
  28 $VERSION = 0.01;
  29
  30 =head1 NAME
  31
  32 C4::Breeding : script to add a biblio in marc_breeding table.
  33
  34 =head1 SYNOPSIS
  35
  36         use C4::Scan;
  37         &ImportBreeding($marcrecords,$overwrite_biblio,$filename,$z3950random);
  38
  39         C<$marcrecord> => the MARC::Record
  40         C<$overwrite_biblio> => if set to 1 a biblio with the same ISBN will be overwritted.
  41                                                                 if set to 0 a biblio with the same isbn will be ignored (the previous will be kept)
  42                                                                 if set to -1 the biblio will be added anyway (more than 1 biblio with the same ISBN possible in the breeding
  43         C<$encoding> => USMARC
  44                                                 or UNIMARC. used for char_decoding.
  45                                                 If not present, the parameter marcflavour is used instead
  46         C<$z3950random> => the random value created during a z3950 search result.
  47
  48 =head1 DESCRIPTION
  49
  50 This module doesn't do anything.
  51
  52 =cut
  53
  54 @ISA = qw(Exporter);
  55 @EXPORT = qw(&ImportBreeding);
  56
  57 sub  ImportBreeding {
  58         my ($marcrecords,$overwrite_biblio,$filename,$encoding,$z3950random) = @_;
  59         my @marcarray = split /\x1D/, $marcrecords;
  60         my $dbh = C4::Context->dbh;
  61         my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
  62         my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
  63         my $searchbreeding = $dbh->prepare("select id from marc_breeding
  64 where isbn=? and title=?");
  65         my $insertsql = $dbh->prepare("insert into marc_breeding (file,isbn,title,author,marc,encoding,z3950random) values(?,?,?,?,?,?,?)");
  66         my $replacesql = $dbh->prepare("update marc_breeding set file=?,isbn=?,title=?,author=?,marc=?,encoding=?,z3950random=? where id=?");
  67         $encoding = C4::Context->preference("marcflavour") unless $encoding;
  68         # fields used for import results
  69         my $imported=0;
  70         my $alreadyindb = 0;
  71         my $alreadyinfarm = 0;
  72         my $notmarcrecord = 0;
  73         for (my $i=0;$i<=$#marcarray;$i++) {
  74                 my $marcrecord = MARC::File::USMARC::decode($marcarray[$i]."\x1D");
  75                 my @warnings = $marcrecord->warnings();
  76                 if (ref($marcrecord) eq undef) {
  77                         $notmarcrecord++;
  78                 } else {
  79                         my $oldbiblio = MARCmarc2koha($dbh,$marcrecord);
  80                         $oldbiblio->{title} = char_decode($oldbiblio->{title},$encoding);
  81                         $oldbiblio->{author} = char_decode($oldbiblio->{author},$encoding);
  82                         # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, overwrite or ignore depending on user choice
  83                         # drop every "special" char : spaces, - ...
  84                         $oldbiblio->{isbn} =~ s/ |-|\.//g,
  85                         $oldbiblio->{isbn} = substr($oldbiblio->{isbn},0,10);
  86                         $oldbiblio->{issn} =~ s/ |-|\.//g,
  87                         $oldbiblio->{issn} = substr($oldbiblio->{issn},0,10);
  88                         # search if biblio exists
  89                         my $biblioitemnumber;
  90                         if ($oldbiblio->{isbn}) {
  91                                 $searchisbn->execute($oldbiblio->{isbn});
  92                                 ($biblioitemnumber) = $searchisbn->fetchrow;
  93                         } else {
  94                                 $searchissn->execute($oldbiblio->{issn});
  95                                 ($biblioitemnumber) = $searchissn->fetchrow;
  96                         }
  97                         if ($biblioitemnumber) {
  98                                 $alreadyindb++;
  99                         } else {
 100                                 # search in breeding farm
 101                                 my $breedingid;
 102                                 if ($oldbiblio->{isbn}) {
 103                                         $searchbreeding->execute($oldbiblio->{isbn},$oldbiblio->{title});
 104                                         ($breedingid) = $searchbreeding->fetchrow;
 105                                 } elsif ($oldbiblio->{issn}){
 106                                         $searchbreeding->execute($oldbiblio->{issn},$oldbiblio->{title});
 107                                         ($breedingid) = $searchbreeding->fetchrow;
 108                                 }
 109                                 if ($breedingid && $overwrite_biblio eq 0) {
 110                                         $alreadyinfarm++;
 111                                 } else {
 112                                         my $recoded;
 113                                         $recoded = $marcrecord->as_usmarc();
 114                                         if ($breedingid && $overwrite_biblio eq 1) {
 115                                                 $replacesql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded,$encoding,$z3950random,$breedingid);
 116                                         } else {
 117                                                 $insertsql ->execute($filename,substr($oldbiblio->{isbn}.$oldbiblio->{issn},0,10),$oldbiblio->{title},$oldbiblio->{author},$recoded,$encoding,$z3950random);
 118                                         }
 119                                         $imported++;
 120                                 }
 121                         }
 122                 }
 123         }
 124         return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported);
 125 }
 126
 127 END { }       # module clean-up code here (global destructor)