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;