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