Bug 11081: Port Koha::Contrib::Tamil indexer into Koha code base
[koha.git] / Koha / Indexer / RecordReader.pm
1 package Koha::Indexer::RecordReader;
2
3 use Moose;
4
5 with 'MooseX::RW::Reader';
6
7
8 use Modern::Perl;
9 use utf8;
10 use Moose::Util::TypeConstraints;
11 use MARC::Record;
12 use MARC::File::XML;
13 use C4::Context;
14 use C4::Biblio;
15 use C4::Items;
16
17
18 subtype 'Koha::RecordType'
19     => as 'Str',
20     => where { /biblio|authority/i },
21     => message { "$_ is not a valid Koha::RecordType (biblio or authority" };
22
23 subtype 'Koha::RecordSelect'
24     => as 'Str',
25     => where { /all|queue|queue_update|queue_delete/ },
26     => message {
27         "$_ is not a valide Koha::RecordSelect " .
28         "(all or queue or queue_update or queue_delete)"
29     };
30
31
32 has source => (
33     is       => 'rw',
34     isa      => 'Koha::RecordType',
35     required => 1,
36     default  => 'biblio',
37 );
38
39 has select => (
40     is       => 'rw',
41     isa      => 'Koha::RecordSelect',
42     required => 1,
43     default  => 'all',
44 );
45
46 has xml => ( is => 'rw', isa => 'Bool', default => '0' );
47
48 has sth => ( is => 'rw' );
49
50 # Last returned record biblionumber;
51 has id => ( is => 'rw' );
52
53 # Biblio records normalizer, if necessary
54 has normalizer => ( is => 'rw' );
55
56 # Read all records? (or queued records)
57 has allrecords => ( is => 'rw', isa => 'Bool', default => 1 );
58
59 # Mark as done an entry is Zebra queue
60 has sth_queue_done => ( is => 'rw' );
61
62 # Items tag
63 has itemtag => ( is => 'rw' );
64
65 # Las returned record frameworkcode
66 # FIXME: a KohaRecord class should contain this information
67 has frameworkcode => ( is => 'rw', isa => 'Str' );
68
69
70 sub BUILD {
71     my $self = shift;
72     my $dbh  = C4::Context->dbh();
73
74     # Tag containing items
75     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",'');
76     $self->itemtag($itemtag);
77
78     if ( $self->source =~ /biblio/i &&
79          C4::Context->preference('IncludeSeeFromInSearches') )
80     {
81         require Koha::RecordProcessor;
82         my $normalizer = Koha::RecordProcessor->new( { filters => 'EmbedSeeFromHeadings' } );
83         $self->normalizer($normalizer);
84         # Necessary for as_xml method
85         MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') );
86     }
87
88     my $operation = $self->select =~ /update/i
89                     ? 'specialUpdate'
90                     : 'recordDelete';
91     $self->allrecords( $self->select =~ /all/i ? 1 : 0 );
92     my $sql =
93         $self->source =~ /biblio/i
94             ? $self->allrecords
95                 ? "SELECT NULL, biblionumber FROM biblio"
96                 : "SELECT id, biblio_auth_number FROM zebraqueue
97                    WHERE server = 'biblioserver'
98                      AND operation = '$operation' AND done = 0"
99             : $self->allrecords
100                 ? "SELECT NULL, authid FROM auth_header"
101                 : "SELECT id, biblio_auth_number FROM zebraqueue
102                    WHERE server = 'authorityserver'
103                      AND operation = '$operation' AND done = 0";
104     my $sth = $dbh->prepare( $sql );
105     $sth->execute();
106     $self->sth( $sth );
107
108     unless ( $self->allrecords ) {
109         $self->sth_queue_done( $dbh->prepare(
110             "UPDATE zebraqueue SET done=1 WHERE id=?" ) );
111     }
112
113     __PACKAGE__->meta->add_method( 'get' =>
114         $self->source =~ /biblio/i
115             ? $self->xml && !$self->normalizer
116               ? \&get_biblio_xml
117               : \&get_biblio_marc
118             : $self->xml
119               ? \&get_auth_xml
120               : \&get_auth_marc
121     );
122 }
123
124
125
126 sub read {
127     my $self = shift;
128     while ( my ($queue_id, $id) = $self->sth->fetchrow ) {
129         # Suppress entry in zebraqueue table
130         $self->sth_queue_done->execute($queue_id) if $queue_id;
131         if ( my $record = $self->get( $id ) ) {
132             $record = $self->normalizer->process($record) if $self->normalizer;
133             $self->count($self->count+1);
134             $self->id( $id );
135             return $record;
136         }
137     }
138     return 0;
139 }
140
141
142
143 sub get_biblio_xml {
144     my ( $self, $id ) = @_;
145     my$dbh = C4::Context->dbh();
146     my $sth = $dbh->prepare(
147         "SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
148     $sth->execute( $id );
149     my ($marcxml) = $sth->fetchrow;
150
151     # If biblio isn't found in biblioitems, it is searched in
152     # deletedbilioitems. Usefull for delete Zebra requests
153     unless ( $marcxml ) {
154         $sth = $dbh->prepare(
155             "SELECT marcxml FROM deletedbiblioitems WHERE biblionumber=? ");
156         $sth->execute( $id );
157         ($marcxml) = $sth->fetchrow;
158     }
159
160     # Items extraction
161     # FIXME: It slows down drastically biblio records export
162     {
163         my @items = @{ $dbh->selectall_arrayref(
164             "SELECT * FROM items WHERE biblionumber=$id",
165             {Slice => {} } ) };
166         if (@items){
167             my $record = MARC::Record->new;
168             $record->encoding('UTF-8');
169             my @itemsrecord;
170             foreach my $item (@items) {
171                 my $record = Item2Marc($item, $id);
172                 push @itemsrecord, $record->field($self->itemtag);
173             }
174             $record->insert_fields_ordered(@itemsrecord);
175             my $itemsxml = $record->as_xml_record();
176             $marcxml =
177                 substr($marcxml, 0, length($marcxml)-10) .
178                 substr($itemsxml, index($itemsxml, "</leader>\n", 0) + 10);
179         }
180     }
181     return $marcxml;
182 }
183
184
185 # Get biblio record, if the record doesn't exist in biblioitems, it is searched
186 # in deletedbiblioitems.
187 sub get_biblio_marc {
188     my ( $self, $id ) = @_;
189
190     my $dbh = C4::Context->dbh();
191     my $sth = $dbh->prepare(
192         "SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
193     $sth->execute( $id );
194     my ($marcxml) = $sth->fetchrow;
195
196     unless ( $marcxml ) {
197         $sth = $dbh->prepare(
198             "SELECT marcxml FROM deletedbiblioitems WHERE biblionumber=? ");
199         $sth->execute( $id );
200         ($marcxml) = $sth->fetchrow;
201     }
202
203     $marcxml =~ s/[^\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
204     my $record = MARC::Record->new();
205     if ($marcxml) {
206         $record = eval {
207             MARC::Record::new_from_xml( $marcxml, "utf8" ) };
208         if ($@) { warn " problem with: $id : $@ \n$marcxml"; }
209
210         # Items extraction if Koha v3.4 and above
211         # FIXME: It slows down drastically biblio records export
212         if ( $self->itemsextraction ) {
213             my @items = @{ $dbh->selectall_arrayref(
214                 "SELECT * FROM items WHERE biblionumber=$id",
215                 {Slice => {} } ) };
216             if (@items){
217                 my @itemsrecord;
218                 foreach my $item (@items) {
219                     my $record = Item2Marc($item, $id);
220                     push @itemsrecord, $record->field($self->itemtag);
221                 }
222                 $record->insert_fields_ordered(@itemsrecord);
223             }
224         }
225         return $record;
226     }
227     return;
228 }
229
230
231 sub get_auth_xml {
232     my ( $self, $id ) = @_;
233
234     my $dbh = C4::Context->dbh();
235     my $sth = $dbh->prepare(
236         "select marcxml from auth_header where authid=? "  );
237     $sth->execute( $id );
238     my ($xml) = $sth->fetchrow;
239
240     # If authority isn't found we build a mimimalist record
241     # Usefull for delete Zebra requests
242     unless ( $xml ) {
243         return
244             "<record
245                xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
246                xsi:schemaLocation=\"http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd\"
247                xmlns=\"http://www.loc.gov/MARC21/slim\">
248              <leader>                        </leader>
249              <controlfield tag=\"001\">$id</controlfield>
250              </record>\n";
251     }
252
253     my $new_xml = '';
254     foreach ( split /\n/, $xml ) {
255         next if /^<collection|^<\/collection/;
256         $new_xml .= "$_\n";
257     }
258     return $new_xml;
259 }
260
261
262 no Moose;
263 1;