@@ -, +, @@ base perldoc koha-index perldoc koha-index-daemon MooseX::Getopt MooseX::RW AnyEvent::Processor - Apply the patch - Install dependencies, if necessary - Reindex a whole biblio catalog: koha-index --verbose - Reindex a whole authorities catalog: koha-index --source authority --verbose - Modify 1 biblio record, and index it: koha-index --select queue - Modifiy 1 authority record, and index it: koha-index --select queue --source authority - Run indexing daemon, with a 15s timeout: koha-index-daemon --timeout 15 - Modify a biblio record: wait 15s, and see - Modify an authority record: wait 15s, and see --- C4/Installer/PerlDependencies.pm | 40 ++++++ Koha/Indexer/Daemon.pm | 116 +++++++++++++++++ Koha/Indexer/Indexing.pm | 195 +++++++++++++++++++++++++++++ Koha/Indexer/RecordReader.pm | 263 +++++++++++++++++++++++++++++++++++++++ Koha/Indexer/RecordWriter.pm | 59 +++++++++ misc/bin/koha-index | 79 ++++++++++++ misc/bin/koha-index-daemon | 49 ++++++++ 7 files changed, 801 insertions(+) create mode 100644 Koha/Indexer/Daemon.pm create mode 100644 Koha/Indexer/Indexing.pm create mode 100644 Koha/Indexer/RecordReader.pm create mode 100644 Koha/Indexer/RecordWriter.pm create mode 100755 misc/bin/koha-index create mode 100755 misc/bin/koha-index-daemon --- a/C4/Installer/PerlDependencies.pm +++ a/C4/Installer/PerlDependencies.pm @@ -557,6 +557,36 @@ our $PERL_DEPS = { 'required' => '1', 'min_ver' => '0.02', }, + 'MooseX::Storage' => { + 'usage' => 'Core', + 'required' => '0', + 'min_ver' => '0.30', + }, + 'MooseX::Types' => { + 'usage' => 'Core', + 'required' => '0', + 'min_ver' => '0.30', + }, + 'MooseX::Getopt' => { + 'usage' => 'Command line scripts', + 'required' => '0', + 'min_ver' => '0.46', + }, + 'MooseX::RW' => { + 'usage' => 'Command line scripts', + 'required' => '0', + 'min_ver' => '0.003', + }, + 'String::RewritePrefix' => { + 'usage' => 'Core', + 'required' => '0', + 'min_ver' => '0.006', + }, + 'Time::Progress' => { + 'usage' => 'Core', + 'required' => '0', + 'min_ver' => '1.7', + }, 'DBD::Mock' => { 'usage' => 'Core', 'required' => '1', @@ -617,6 +647,16 @@ our $PERL_DEPS = { 'required' => '0', 'min_ver' => '1', }, + 'AnyEvent::Processor' => { + 'usage' => 'Command line scripts', + 'required' => '0', + 'min_ver' => '0.003', + }, + 'Moose' => { + 'usage' => 'Core', + 'required' => '0', + 'min_ver' => '1.09', + }, 'String::Random' => { 'usage' => 'OpacSelfRegistration', 'required' => '1', --- a/Koha/Indexer/Daemon.pm +++ a/Koha/Indexer/Daemon.pm @@ -0,0 +1,116 @@ +package Koha::Indexer::Daemon; + +use Moose; + +use Modern::Perl; +use utf8; +use AnyEvent; +use Koha::Indexer::Indexing; +use C4::Context; + +with 'MooseX::Getopt'; + + +has name => ( is => 'rw', isa => 'Str' ); + +has directory => ( is => 'rw', isa => 'Str' ); + +has timeout => ( + is => 'rw', + isa => 'Int', + default => 60, +); + +has verbose => ( is => 'rw', isa => 'Bool', default => 0 ); + + +sub BUILD { + my $self = shift; + + say "Starting Koha Indexer Daemon"; + + $self->name( C4::Context->config('database') ); + + my $idle = AnyEvent->timer( + after => $self->timeout, + interval => $self->timeout, + cb => sub { $self->index_zebraqueue(); } + ); + AnyEvent->condvar->recv; +} + + +sub index_zebraqueue { + my $self = shift; + + my $dbh = C4::Context->dbh(); + my $sql = " SELECT COUNT(*), server + FROM zebraqueue + WHERE done = 0 + GROUP BY server "; + my $sth = $dbh->prepare($sql); + $sth->execute(); + my %count = ( biblio => 0, authority => 0 ); + while ( my ($count, $server) = $sth->fetchrow ) { + $server =~ s/server//g; + $count{$server} = $count; + } + + say "[", $self->name, "] Index biblio (", $count{biblio}, ") authority (", + $count{authority}, ")"; + + for my $source (qw/biblio authority/) { + next unless $count{$source}; + my $indexer = Koha::Indexer::Indexing->new( + source => $source, + select => 'queue', + blocking => 1, + keep => 1, + verbose => $self->verbose, + ); + $indexer->directory($self->directory) if $self->directory; + $indexer->run(); + } +} + +no Moose; +__PACKAGE__->meta->make_immutable; +1; + +__END__ +=pod + +=head1 SYNOPSIS + + # Index Koha queued biblio/authority records every minute. + # KOHA_CONF environment variable is used to find which Koha + # instance to use. + # Records are exported from Koha DB into files located in + # the current directory + my $daemon = Koha::Indexer::Daemon->new(); + + my $daemon = Koha::Indexer::Daemon->new( + timeout => 20, + directory => '/home/koha/mylib/tmp', + verbose => 1 ); + +=head1 Attributes + +=over + +=item directory($directory_name) + +Location of the directory where to export biblio/authority records before +sending them to Zebra indexer. + +=item timeout($seconds) + +Number of seconds between indexing. + +=item verbose(0|1) + +Task verbosity. + +=back + +=cut --- a/Koha/Indexer/Indexing.pm +++ a/Koha/Indexer/Indexing.pm @@ -0,0 +1,195 @@ +package Koha::Indexer::Indexing; + +use Moose; + +use Modern::Perl; +use utf8; +use Carp; +use Koha::Indexer::RecordReader; +use Koha::Indexer::RecordWriter; +use AnyEvent::Processor::Conversion; +use File::Path; +use IO::File; +use C4::Context; + + +with 'MooseX::Getopt'; + + +has source => ( + is => 'rw', + isa => 'Koha::RecordType', + default => 'biblio' +); + +has select => ( + is => 'rw', + isa => 'Koha::RecordSelect', + required => 1, + default => 'all', +); + +has directory => ( + is => 'rw', + isa => 'Str', + default => './koha-index', +); + +has keep => ( is => 'rw', isa => 'Bool', default => 0 ); + +has verbose => ( is => 'rw', isa => 'Bool', default => 0 ); + +has help => ( + is => 'rw', + isa => 'Bool', + default => 0, + traits => [ 'NoGetopt' ], +); + +has blocking => ( + is => 'rw', + isa => 'Bool', + default => 0, + traits => [ 'NoGetopt' ], +); + + +sub run { + my $self = shift; + + # Is it a full indexing of all Koha DB records? + my $is_full_indexing = $self->select =~ /all/i; + + # Is it biblio indexing (if not it's authority) + my $is_biblio_indexing = $self->source =~ /biblio/i; + + # STEP 1: All biblio records are exported in a directory + + unless ( -d $self->directory ) { + mkdir $self->directory + or die "Unable to create directory: " . $self->directory; + } + my $from_dir = $self->directory . "/" . $self->source; + mkdir $from_dir; + for my $dir ( ( "$from_dir/update", "$from_dir/delete") ) { + rmtree( $dir ) if -d $dir; + mkdir $dir; + } + + # DOM indexing? otherwise GRS-1 + my $is_dom = $self->source eq 'biblio' + ? 'zebra_bib_index_mode' + : 'zebra_auth_index_mode'; + $is_dom = C4::Context->config($is_dom) || ''; + $is_dom = $is_dom =~ /dom/i ? 1 : 0; + + # STEP 1.1: Records to update + say "Exporting records to update" if $self->verbose; + my $exporter = AnyEvent::Processor::Conversion->new( + reader => Koha::Indexer::RecordReader->new( + source => $self->source, + select => $is_full_indexing ? 'all' : 'queue_update', + xml => '1' + ), + writer => Koha::Indexer::RecordWriter->new( + fh => IO::File->new( "$from_dir/update/records", '>:encoding(utf8)' ), + valid => $is_dom ), + blocking => $self->blocking, + verbose => $self->verbose, + ); + $exporter->run(); + + # STEP 1.2: Record to delete, if zebraqueue + if ( ! $is_full_indexing ) { + say "Exporting records to delete" if $self->verbose; + $exporter = AnyEvent::Processor::Conversion->new( + reader => Koha::Indexer::RecordReader->new( + source => $self->source, + select => 'queue_delete', + xml => '1' + ), + writer => Koha::Indexer::RecordWriter->new( + fh => IO::File->new( "$from_dir/delete/records", '>:encoding(utf8)' ), + valid => $is_dom ), + blocking => $self->blocking, + verbose => $self->verbose, + ); + $exporter->run(); + } + + # STEP 2: Run zebraidx + + my $cmd; + my $zconfig = C4::Context->zebraconfig( + $is_biblio_indexing ? 'biblioserver' : 'authorityserver')->{config}; + my $db_name = $is_biblio_indexing ? 'biblios' : 'authorities'; + my $cmd_base = "zebraidx -c " . $zconfig; + $cmd_base .= " -n" if $is_full_indexing; # No shadow: no indexing daemon + $cmd_base .= $self->verbose ? " -v warning,log" : " -v none"; + $cmd_base .= " -g marcxml"; + $cmd_base .= " -d $db_name"; + + if ( $is_full_indexing ) { + $cmd = "$cmd_base init"; + say $cmd if $self->verbose; + system( $cmd ); + } + + $cmd = "$cmd_base update $from_dir/update"; + say $cmd if $self->verbose; + system( $cmd ); + + if ( ! $is_full_indexing ) { + $cmd = "$cmd_base adelete $from_dir/delete"; + say $cmd if $self->verbose; + system( $cmd ); + my $cmd = "$cmd_base commit"; + say $cmd if $self->verbose; + system( $cmd ); + } + + rmtree( $self->directory ) unless $self->keep; +} + + +no Moose; +__PACKAGE__->meta->make_immutable; + +__END__ +=pod + +=head1 SYNOPSIS + + my $indexer = Koha::Indexer->new( + source => 'biblio', + select => 'queue' + ); + $indexer->run(); + + my $indexer = Koha::Indexer->new( + source => 'authority', + select => 'all', + directory => '/tmp', + verbose => 1, + ); + $indexer->run(); + +=head1 DESCRIPTION + +Indexes Koha biblio/authority records, full indexing or queued record indexing. + + +=head1 Methods + +=over + +=item run + +Runs the indexing task. + +=back + + +=cut + +1; --- a/Koha/Indexer/RecordReader.pm +++ a/Koha/Indexer/RecordReader.pm @@ -0,0 +1,263 @@ +package Koha::Indexer::RecordReader; + +use Moose; + +with 'MooseX::RW::Reader'; + + +use Modern::Perl; +use utf8; +use Moose::Util::TypeConstraints; +use MARC::Record; +use MARC::File::XML; +use C4::Context; +use C4::Biblio; +use C4::Items; + + +subtype 'Koha::RecordType' + => as 'Str', + => where { /biblio|authority/i }, + => message { "$_ is not a valid Koha::RecordType (biblio or authority" }; + +subtype 'Koha::RecordSelect' + => as 'Str', + => where { /all|queue|queue_update|queue_delete/ }, + => message { + "$_ is not a valide Koha::RecordSelect " . + "(all or queue or queue_update or queue_delete)" + }; + + +has source => ( + is => 'rw', + isa => 'Koha::RecordType', + required => 1, + default => 'biblio', +); + +has select => ( + is => 'rw', + isa => 'Koha::RecordSelect', + required => 1, + default => 'all', +); + +has xml => ( is => 'rw', isa => 'Bool', default => '0' ); + +has sth => ( is => 'rw' ); + +# Last returned record biblionumber; +has id => ( is => 'rw' ); + +# Biblio records normalizer, if necessary +has normalizer => ( is => 'rw' ); + +# Read all records? (or queued records) +has allrecords => ( is => 'rw', isa => 'Bool', default => 1 ); + +# Mark as done an entry is Zebra queue +has sth_queue_done => ( is => 'rw' ); + +# Items tag +has itemtag => ( is => 'rw' ); + +# Las returned record frameworkcode +# FIXME: a KohaRecord class should contain this information +has frameworkcode => ( is => 'rw', isa => 'Str' ); + + +sub BUILD { + my $self = shift; + my $dbh = C4::Context->dbh(); + + # Tag containing items + my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",''); + $self->itemtag($itemtag); + + if ( $self->source =~ /biblio/i && + C4::Context->preference('IncludeSeeFromInSearches') ) + { + require Koha::RecordProcessor; + my $normalizer = Koha::RecordProcessor->new( { filters => 'EmbedSeeFromHeadings' } ); + $self->normalizer($normalizer); + # Necessary for as_xml method + MARC::File::XML->default_record_format( C4::Context->preference('marcflavour') ); + } + + my $operation = $self->select =~ /update/i + ? 'specialUpdate' + : 'recordDelete'; + $self->allrecords( $self->select =~ /all/i ? 1 : 0 ); + my $sql = + $self->source =~ /biblio/i + ? $self->allrecords + ? "SELECT NULL, biblionumber FROM biblio" + : "SELECT id, biblio_auth_number FROM zebraqueue + WHERE server = 'biblioserver' + AND operation = '$operation' AND done = 0" + : $self->allrecords + ? "SELECT NULL, authid FROM auth_header" + : "SELECT id, biblio_auth_number FROM zebraqueue + WHERE server = 'authorityserver' + AND operation = '$operation' AND done = 0"; + my $sth = $dbh->prepare( $sql ); + $sth->execute(); + $self->sth( $sth ); + + unless ( $self->allrecords ) { + $self->sth_queue_done( $dbh->prepare( + "UPDATE zebraqueue SET done=1 WHERE id=?" ) ); + } + + __PACKAGE__->meta->add_method( 'get' => + $self->source =~ /biblio/i + ? $self->xml && !$self->normalizer + ? \&get_biblio_xml + : \&get_biblio_marc + : $self->xml + ? \&get_auth_xml + : \&get_auth_marc + ); +} + + + +sub read { + my $self = shift; + while ( my ($queue_id, $id) = $self->sth->fetchrow ) { + # Suppress entry in zebraqueue table + $self->sth_queue_done->execute($queue_id) if $queue_id; + if ( my $record = $self->get( $id ) ) { + $record = $self->normalizer->process($record) if $self->normalizer; + $self->count($self->count+1); + $self->id( $id ); + return $record; + } + } + return 0; +} + + + +sub get_biblio_xml { + my ( $self, $id ) = @_; + my$dbh = C4::Context->dbh(); + my $sth = $dbh->prepare( + "SELECT marcxml FROM biblioitems WHERE biblionumber=? "); + $sth->execute( $id ); + my ($marcxml) = $sth->fetchrow; + + # If biblio isn't found in biblioitems, it is searched in + # deletedbilioitems. Usefull for delete Zebra requests + unless ( $marcxml ) { + $sth = $dbh->prepare( + "SELECT marcxml FROM deletedbiblioitems WHERE biblionumber=? "); + $sth->execute( $id ); + ($marcxml) = $sth->fetchrow; + } + + # Items extraction + # FIXME: It slows down drastically biblio records export + { + my @items = @{ $dbh->selectall_arrayref( + "SELECT * FROM items WHERE biblionumber=$id", + {Slice => {} } ) }; + if (@items){ + my $record = MARC::Record->new; + $record->encoding('UTF-8'); + my @itemsrecord; + foreach my $item (@items) { + my $record = Item2Marc($item, $id); + push @itemsrecord, $record->field($self->itemtag); + } + $record->insert_fields_ordered(@itemsrecord); + my $itemsxml = $record->as_xml_record(); + $marcxml = + substr($marcxml, 0, length($marcxml)-10) . + substr($itemsxml, index($itemsxml, "\n", 0) + 10); + } + } + return $marcxml; +} + + +# Get biblio record, if the record doesn't exist in biblioitems, it is searched +# in deletedbiblioitems. +sub get_biblio_marc { + my ( $self, $id ) = @_; + + my $dbh = C4::Context->dbh(); + my $sth = $dbh->prepare( + "SELECT marcxml FROM biblioitems WHERE biblionumber=? "); + $sth->execute( $id ); + my ($marcxml) = $sth->fetchrow; + + unless ( $marcxml ) { + $sth = $dbh->prepare( + "SELECT marcxml FROM deletedbiblioitems WHERE biblionumber=? "); + $sth->execute( $id ); + ($marcxml) = $sth->fetchrow; + } + + $marcxml =~ s/[^\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g; + my $record = MARC::Record->new(); + if ($marcxml) { + $record = eval { + MARC::Record::new_from_xml( $marcxml, "utf8" ) }; + if ($@) { warn " problem with: $id : $@ \n$marcxml"; } + + # Items extraction if Koha v3.4 and above + # FIXME: It slows down drastically biblio records export + if ( $self->itemsextraction ) { + my @items = @{ $dbh->selectall_arrayref( + "SELECT * FROM items WHERE biblionumber=$id", + {Slice => {} } ) }; + if (@items){ + my @itemsrecord; + foreach my $item (@items) { + my $record = Item2Marc($item, $id); + push @itemsrecord, $record->field($self->itemtag); + } + $record->insert_fields_ordered(@itemsrecord); + } + } + return $record; + } + return; +} + + +sub get_auth_xml { + my ( $self, $id ) = @_; + + my $dbh = C4::Context->dbh(); + my $sth = $dbh->prepare( + "select marcxml from auth_header where authid=? " ); + $sth->execute( $id ); + my ($xml) = $sth->fetchrow; + + # If authority isn't found we build a mimimalist record + # Usefull for delete Zebra requests + unless ( $xml ) { + return + " + + $id + \n"; + } + + my $new_xml = ''; + foreach ( split /\n/, $xml ) { + next if /^ no +has valid => ( + is => 'rw', + isa => 'Bool', + default => 0, +); + + +sub begin { + my $self = shift; + if ( $self->valid ) { + my $fh = $self->fh; + print $fh '', "\n", '', "\n"; + } +} + + +sub end { + my $self = shift; + my $fh = $self->fh; + if ( $self->valid ) { + print $fh '', "\n"; + } + $fh->flush(); +} + + + +# +# Sent record is rather a MARC::Record object or an marcxml string +# +sub write { + my ($self, $record) = @_; + + $self->count( $self->count + 1 ); + + my $fh = $self->fh; + my $xml = ref($record) eq 'MARC::Record' + ? $record->as_xml_record() : $record; + $xml =~ s/<\?xml version="1.0" encoding="UTF-8"\?>\n//g if $self->valid; + print $fh $xml; +} + +__PACKAGE__->meta->make_immutable; + +1; --- a/misc/bin/koha-index +++ a/misc/bin/koha-index @@ -0,0 +1,79 @@ +#!/usr/bin/perl + +package Main; + +use Modern::Perl; +use utf8; +use Koha::Indexer::Indexing; +use Pod::Usage; + +my $indexer = Koha::Indexer::Indexing->new_with_options(); +if ( $indexer->help ) { + pod2usage( -verbose => 99 ); + exit; +} +$indexer->run(); + + +__END__ + +=pod + +=head1 SYNOPSIS + + koha-index + + koha-index --verbose + + koha-index --source biblio --select queue + + koha-index --source authority --select all + + koha-index --select queue --directory /tmp/koha-index-mylib --keep + +=head1 DESCRIPTION + +Index queued biblio/autority record, or reindex the whole DB. Koha standard +environment variables must ne set appropriately: KOHA_CONF and PERL5LIB. + +=head1 OPTIONS + +=over + +=item --source + +Select records to be indexed: C or C. If not specified, +biblio by default. + +=item --select + +Select record to be indexed: C or C. If not specified, C is +selected. If C is selected, zebra database is reset before indexing. + +=item --directory + +Directory where records to be indexed by Zebra are exported. If not specified, +a direcory named C is used, and if necessary created, in the +current directory. In this directory, sub-directories are created containing +records to be updated or deleted by Zebra. If those subdirectories already +exist, they are first emptied. The export directory tree is kept after zebra +indexing. + +=item --keep + +Keep the directory, and its content, where biblio/authority records have been +exported. + +=item --verbose + +Increase the amount of logging. Normally only warnings and errors from the +indexing are shown. + +=back + +=head1 SEE ALSO + +=for :list +* L + +=cut --- a/misc/bin/koha-index-daemon +++ a/misc/bin/koha-index-daemon @@ -0,0 +1,49 @@ +#!/usr/bin/perl + +package Main; + +use Modern::Perl; +use utf8; +use Koha::Indexer::Daemon; +use Pod::Usage; + +Koha::Indexer::Daemon->new_with_options(); + +__END__ + +=pod + +=head1 SYNOPSIS + + koha-index-daemon + + koha-index-daemon --timeout 60 + + koha-index-daemon --timeout 60 --directory /home/mylib/tmp + +=head1 DESCRIPTION + +Examine periodicaly zebraqueue table from a Koha instance and index +bilbio/authority records. + +=head1 OPTIONS + +=over + +=item --timeout + +Specify the daemon timeout in seconds. + +=item --directory + +Directory where to write record exported from Koha DB before sending them to +Zebra. Subdirectories are created. + +=back + +=head1 SEE ALSO + +=for :list +* L + +=cut --