Bug 6942 - Add link to manual to help/authorities/authorities-home.tt
[wip/koha-chris_n.git] / 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
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
23 use C4::Biblio;
24 use C4::Koha;
25 use C4::Charset;
26 use MARC::File::USMARC;
27 use C4::ImportBatch;
28
29 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
30
31 BEGIN {
32         # set the version for version checking
33         $VERSION = 0.02;
34         require Exporter;
35         @ISA = qw(Exporter);
36         @EXPORT = qw(&ImportBreeding &BreedingSearch);
37 }
38
39 =head1 NAME
40
41 C4::Breeding : module to add biblios to import_records via
42                the breeding/reservoir API.
43
44 =head1 SYNOPSIS
45
46     use C4::Scan;
47     &ImportBreeding($marcrecords,$overwrite_biblio,$filename,$z3950random,$batch_type);
48
49     C<$marcrecord> => the MARC::Record
50     C<$overwrite_biblio> => if set to 1 a biblio with the same ISBN will be overwritted.
51                                 if set to 0 a biblio with the same isbn will be ignored (the previous will be kept)
52                                 if set to -1 the biblio will be added anyway (more than 1 biblio with the same ISBN 
53                                 possible in the breeding
54     C<$encoding> => USMARC
55                         or UNIMARC. used for char_decoding.
56                         If not present, the parameter marcflavour is used instead
57     C<$z3950random> => the random value created during a z3950 search result.
58
59 =head1 DESCRIPTION
60
61     ImportBreeding import MARC records in the reservoir (import_records/import_batches tables).
62     the records can be properly encoded or not, we try to reencode them in utf-8 if needed.
63     works perfectly with BNF server, that sends UNIMARC latin1 records. Should work with other servers too.
64
65 =head2 ImportBreeding
66
67         ImportBreeding($marcrecords,$overwrite_biblio,$filename,$encoding,$z3950random,$batch_type);
68
69         TODO description
70
71 =cut
72
73 sub ImportBreeding {
74     my ($marcrecords,$overwrite_biblio,$filename,$encoding,$z3950random,$batch_type) = @_;
75     my @marcarray = split /\x1D/, $marcrecords;
76     
77     my $dbh = C4::Context->dbh;
78     
79     my $batch_id = 0;
80     if ($batch_type eq 'z3950') {
81         $batch_id = GetZ3950BatchId($filename);
82     } else {
83         # create a new one
84         $batch_id = AddImportBatch('create_new', 'staging', 'batch', $filename, '');
85     }
86     my $searchisbn = $dbh->prepare("select biblioitemnumber from biblioitems where isbn=?");
87     my $searchissn = $dbh->prepare("select biblioitemnumber from biblioitems where issn=?");
88     # FIXME -- not sure that this kind of checking is actually needed
89     my $searchbreeding = $dbh->prepare("select import_record_id from import_biblios where isbn=? and title=?");
90     
91 #     $encoding = C4::Context->preference("marcflavour") unless $encoding;
92     # fields used for import results
93     my $imported=0;
94     my $alreadyindb = 0;
95     my $alreadyinfarm = 0;
96     my $notmarcrecord = 0;
97     my $breedingid;
98     for (my $i=0;$i<=$#marcarray;$i++) {
99         my ($marcrecord, $charset_result, $charset_errors);
100         ($marcrecord, $charset_result, $charset_errors) = 
101             MarcToUTF8Record($marcarray[$i]."\x1D", C4::Context->preference("marcflavour"), $encoding);
102         
103 #         warn "$i : $marcarray[$i]";
104         # FIXME - currently this does nothing 
105         my @warnings = $marcrecord->warnings();
106         
107         if (scalar($marcrecord->fields()) == 0) {
108             $notmarcrecord++;
109         } else {
110             my $oldbiblio = TransformMarcToKoha($dbh,$marcrecord,'');
111             # if isbn found and biblio does not exist, add it. If isbn found and biblio exists, 
112             # overwrite or ignore depending on user choice
113             # drop every "special" char : spaces, - ...
114             $oldbiblio->{isbn} = C4::Koha::_isbn_cleanup($oldbiblio->{isbn}); # FIXME C4::Koha::_isbn_cleanup should be public
115             # search if biblio exists
116             my $biblioitemnumber;
117             if ($oldbiblio->{isbn}) {
118                 $searchisbn->execute($oldbiblio->{isbn});
119                 ($biblioitemnumber) = $searchisbn->fetchrow;
120             } else {
121                 if ($oldbiblio->{issn}) {
122                     $searchissn->execute($oldbiblio->{issn});
123                         ($biblioitemnumber) = $searchissn->fetchrow;
124                 }
125             }
126             if ($biblioitemnumber && $overwrite_biblio ne 2) {
127                 $alreadyindb++;
128             } else {
129                 # FIXME - in context of batch load,
130                 # rejecting records because already present in the reservoir
131                 # not correct in every case.
132                 # search in breeding farm
133                 if ($oldbiblio->{isbn}) {
134                     $searchbreeding->execute($oldbiblio->{isbn},$oldbiblio->{title});
135                     ($breedingid) = $searchbreeding->fetchrow;
136                 } elsif ($oldbiblio->{issn}){
137                     $searchbreeding->execute($oldbiblio->{issn},$oldbiblio->{title});
138                     ($breedingid) = $searchbreeding->fetchrow;
139                 }
140                 if ($breedingid && $overwrite_biblio eq '0') {
141                     $alreadyinfarm++;
142                 } else {
143                     if ($breedingid && $overwrite_biblio eq '1') {
144                         ModBiblioInBatch($breedingid, $marcrecord);
145                     } else {
146                         my $import_id = AddBiblioToBatch($batch_id, $imported, $marcrecord, $encoding, $z3950random);
147                         $breedingid = $import_id;
148                     }
149                     $imported++;
150                 }
151             }
152         }
153     }
154     return ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid);
155 }
156
157
158 =head2 BreedingSearch
159
160 ($count, @results) = &BreedingSearch($title,$isbn,$random);
161 C<$title> contains the title,
162 C<$isbn> contains isbn or issn,
163 C<$random> contains the random seed from a z3950 search.
164
165 C<$count> is the number of items in C<@results>. C<@results> is an
166 array of references-to-hash; the keys are the items from the C<import_records> and
167 C<import_biblios> tables of the Koha database.
168
169 =cut
170
171 sub BreedingSearch {
172     my ($search,$isbn,$z3950random) = @_;
173     my $dbh   = C4::Context->dbh;
174     my $count = 0;
175     my ($query,@bind);
176     my $sth;
177     my @results;
178
179     $query = "SELECT import_record_id, file_name, isbn, title, author
180               FROM  import_biblios 
181               JOIN import_records USING (import_record_id)
182               JOIN import_batches USING (import_batch_id)
183               WHERE ";
184     if ($z3950random) {
185         $query .= "z3950random = ?";
186         @bind=($z3950random);
187     } else {
188         $search =~ s/(\s+)/\%/g;
189         @bind=();
190     if ($search) {
191             $query .= "title like ? OR author like ?";
192             push(@bind,"%$search%", "%$search%");
193         }
194         if ($search && $isbn) {
195             $query .= " and ";
196         }
197         if ($isbn) {
198             $query .= "isbn like ?";
199             push(@bind,"$isbn%");
200         }
201     }
202     $sth   = $dbh->prepare($query);
203     $sth->execute(@bind);
204     while (my $data = $sth->fetchrow_hashref) {
205             $results[$count] = $data;
206             # FIXME - hack to reflect difference in name 
207             # of columns in old marc_breeding and import_records
208             # There needs to be more separation between column names and 
209             # field names used in the templates </soapbox>
210             $data->{'file'} = $data->{'file_name'};
211             $data->{'id'} = $data->{'import_record_id'};
212             $count++;
213     } # while
214
215     $sth->finish;
216     return($count, @results);
217 } # sub breedingsearch
218
219 1;
220 __END__
221