misc/link_bibs_to_authorities.pl

   1 #!/usr/bin/perl
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  17
  18 use Modern::Perl;
  19
  20 use Koha::Script;
  21 use C4::Context;
  22 use C4::Biblio qw(
  23     GetFrameworkCode
  24     LinkBibHeadingsToAuthorities
  25     ModBiblio
  26 );
  27 use Koha::Biblios;
  28 use Getopt::Long qw( GetOptions );
  29 use Pod::Usage qw( pod2usage );
  30 use Time::HiRes qw( time );
  31 use POSIX qw( ceil strftime );
  32 use Module::Load::Conditional qw( can_load );
  33
  34 use Koha::Database;
  35 use Koha::SearchEngine;
  36 use Koha::SearchEngine::Indexer;
  37
  38 sub usage {
  39     pod2usage( -verbose => 2 );
  40     exit;
  41 }
  42
  43 $| = 1;
  44
  45 # command-line parameters
  46 my $verbose     = 0;
  47 my $link_report = 0;
  48 my $test_only   = 0;
  49 my $want_help   = 0;
  50 my $auth_limit;
  51 my $bib_limit;
  52 my $commit = 100;
  53 my $tagtolink;
  54 my $allowrelink = C4::Context->preference("LinkerRelink") // '';
  55
  56 my $result = GetOptions(
  57     'v|verbose'      => \$verbose,
  58     't|test'         => \$test_only,
  59     'l|link-report'  => \$link_report,
  60     'a|auth-limit=s' => \$auth_limit,
  61     'b|bib-limit=s'  => \$bib_limit,
  62     'c|commit=i'     => \$commit,
  63     'g|tagtolink=i'  => \$tagtolink,
  64     'h|help'         => \$want_help
  65 );
  66
  67 binmode( STDOUT, ":encoding(UTF-8)" );
  68
  69 if ( not $result or $want_help ) {
  70     usage();
  71 }
  72
  73 my $linker_module =
  74   "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
  75 unless ( can_load( modules => { $linker_module => undef } ) ) {
  76     $linker_module = 'C4::Linker::Default';
  77     unless ( can_load( modules => { $linker_module => undef } ) ) {
  78         die "Unable to load linker module. Aborting.";
  79     }
  80 }
  81
  82 my $linker = $linker_module->new(
  83     {
  84         'auth_limit' => $auth_limit,
  85         'options'    => C4::Context->preference("LinkerOptions")
  86     }
  87 );
  88
  89 my $num_bibs_processed = 0;
  90 my $num_bibs_modified  = 0;
  91 my $num_bad_bibs       = 0;
  92 my %unlinked_headings;
  93 my %linked_headings;
  94 my %fuzzy_headings;
  95 my $dbh = C4::Context->dbh;
  96 my @updated_biblios = ();
  97 my $indexer = Koha::SearchEngine::Indexer->new({ index => $Koha::SearchEngine::BIBLIOS_INDEX });
  98
  99 my $schema = Koha::Database->schema;
 100 $schema->txn_begin;
 101 process_bibs( $linker, $bib_limit, $auth_limit, $commit, { tagtolink => $tagtolink, allowrelink => $allowrelink });
 102
 103 exit 0;
 104
 105 sub process_bibs {
 106     my ( $linker, $bib_limit, $auth_limit, $commit, $args ) = @_;
 107     my $tagtolink = $args->{tagtolink};
 108     my $allowrelink = $args->{allowrelink};
 109     my $bib_where = '';
 110     my $starttime = time();
 111     if ($bib_limit) {
 112         $bib_where = "WHERE $bib_limit";
 113     }
 114     my $sql =
 115       "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
 116     my $sth = $dbh->prepare($sql);
 117     $sth->execute();
 118     my $linker_args = { tagtolink => $tagtolink, allowrelink => $allowrelink };
 119     while ( my ($biblionumber) = $sth->fetchrow_array() ) {
 120         $num_bibs_processed++;
 121         process_bib( $linker, $biblionumber, $linker_args );
 122
 123         if ( not $test_only and ( $num_bibs_processed % $commit ) == 0 ) {
 124             print_progress_and_commit($num_bibs_processed);
 125         }
 126     }
 127
 128     if ( not $test_only ) {
 129         $schema->txn_commit;
 130         $indexer->index_records( \@updated_biblios, "specialUpdate", "biblioserver" );
 131     }
 132
 133     my $headings_linked   = 0;
 134     my $headings_unlinked = 0;
 135     my $headings_fuzzy    = 0;
 136     for ( values %linked_headings )   { $headings_linked   += $_; }
 137     for ( values %unlinked_headings ) { $headings_unlinked += $_; }
 138     for ( values %fuzzy_headings )    { $headings_fuzzy    += $_; }
 139
 140     my $endtime = time();
 141     my $totaltime = ceil (($endtime - $starttime) * 1000);
 142     $starttime = strftime('%D %T', localtime($starttime));
 143     $endtime = strftime('%D %T', localtime($endtime));
 144
 145     my $summary = <<_SUMMARY_;
 146
 147 Bib authority heading linking report
 148 =======================================================
 149 Linker module:                          $linker_module
 150 Run started at:                         $starttime
 151 Run ended at:                           $endtime
 152 Total run time:                         $totaltime ms
 153 Number of bibs checked:                 $num_bibs_processed
 154 Number of bibs modified:                $num_bibs_modified
 155 Number of bibs with errors:             $num_bad_bibs
 156 Number of headings linked:              $headings_linked
 157 Number of headings unlinked:            $headings_unlinked
 158 Number of headings fuzzily linked:      $headings_fuzzy
 159 _SUMMARY_
 160     $summary .= "\n****  Ran in test mode only  ****\n" if $test_only;
 161     print $summary;
 162
 163     if ($link_report) {
 164         my @keys;
 165         print <<_LINKED_HEADER_;
 166
 167 Linked headings (from most frequent to least):
 168 -------------------------------------------------------
 169
 170 _LINKED_HEADER_
 171
 172         @keys = sort {
 173             $linked_headings{$b} <=> $linked_headings{$a} or "\L$a" cmp "\L$b"
 174         } keys %linked_headings;
 175         foreach my $key (@keys) {
 176             print "$key:\t" . $linked_headings{$key} . " occurrences\n";
 177         }
 178
 179         print <<_UNLINKED_HEADER_;
 180
 181 Unlinked headings (from most frequent to least):
 182 -------------------------------------------------------
 183
 184 _UNLINKED_HEADER_
 185
 186         @keys = sort {
 187             $unlinked_headings{$b} <=> $unlinked_headings{$a}
 188               or "\L$a" cmp "\L$b"
 189         } keys %unlinked_headings;
 190         foreach my $key (@keys) {
 191             print "$key:\t" . $unlinked_headings{$key} . " occurrences\n";
 192         }
 193
 194         print <<_FUZZY_HEADER_;
 195
 196 Fuzzily-matched headings (from most frequent to least):
 197 -------------------------------------------------------
 198
 199 _FUZZY_HEADER_
 200
 201         @keys = sort {
 202             $fuzzy_headings{$b} <=> $fuzzy_headings{$a} or "\L$a" cmp "\L$b"
 203         } keys %fuzzy_headings;
 204         foreach my $key (@keys) {
 205             print "$key:\t" . $fuzzy_headings{$key} . " occurrences\n";
 206         }
 207         print $summary;
 208     }
 209 }
 210
 211 sub process_bib {
 212     my $linker       = shift;
 213     my $biblionumber = shift;
 214     my $args = shift;
 215     my $tagtolink    = $args->{tagtolink};
 216     my $allowrelink = $args->{allowrelink};
 217     my $biblio = Koha::Biblios->find($biblionumber);
 218     my $record;
 219     eval { $record = $biblio->metadata->record; };
 220     unless ( defined $record ) {
 221         warn "Could not retrieve bib $biblionumber from the database - record is corrupt.";
 222         $num_bad_bibs++;
 223         return;
 224     }
 225
 226     my $frameworkcode = GetFrameworkCode($biblionumber);
 227
 228     my ( $headings_changed, $results );
 229
 230     eval {
 231         ( $headings_changed, $results ) =
 232             LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, $allowrelink, $tagtolink );
 233     };
 234     if ($@) {
 235         warn "Error while searching for authorities for biblionumber $biblionumber at " . localtime(time);
 236         $num_bad_bibs++;
 237         return;
 238     }
 239
 240     foreach my $key ( keys %{ $results->{'unlinked'} } ) {
 241         $unlinked_headings{$key} += $results->{'unlinked'}->{$key};
 242     }
 243     foreach my $key ( keys %{ $results->{'linked'} } ) {
 244         $linked_headings{$key} += $results->{'linked'}->{$key};
 245     }
 246     foreach my $key ( keys %{ $results->{'fuzzy'} } ) {
 247         $fuzzy_headings{$key} += $results->{'fuzzy'}->{$key};
 248     }
 249
 250     if ($headings_changed) {
 251         if ($verbose) {
 252             my $title = substr( $record->title, 0, 20 );
 253             printf(
 254                 "Bib %12d (%-20s): %3d headings changed\n",
 255                 $biblionumber,
 256                 $title,
 257                 $headings_changed
 258             );
 259         }
 260         if ( not $test_only ) {
 261             ModBiblio( $record, $biblionumber, $frameworkcode, {
 262                 disable_autolink => 1,
 263                 skip_holds_queue => 1,
 264                 skip_record_index =>1
 265             });
 266             push @updated_biblios, $biblionumber;
 267             #Last param is to note ModBiblio was called from linking script and bib should not be linked again
 268             $num_bibs_modified++;
 269         }
 270     }
 271 }
 272
 273 sub print_progress_and_commit {
 274     my $recs = shift;
 275     $schema->txn_commit();
 276     $indexer->index_records( \@updated_biblios, "specialUpdate", "biblioserver" );
 277     @updated_biblios = ();
 278     $schema->txn_begin();
 279     print "... processed $recs records\n";
 280 }
 281
 282 =head1 NAME
 283
 284 link_bibs_to_authorities.pl
 285
 286 =head1 SYNOPSIS
 287
 288   link_bibs_to_authorities.pl
 289   link_bibs_to_authorities.pl -v
 290   link_bibs_to_authorities.pl -l
 291   link_bibs_to_authorities.pl --commit=1000
 292   link_bibs_to_authorities.pl --auth-limit=STRING
 293   link_bibs_to_authorities.pl --bib-limit=STRING
 294   link_bibs_to_authorities.pl -g=700
 295
 296 =head1 DESCRIPTION
 297
 298 This batch job checks each bib record in the Koha database and attempts to link
 299 each of its headings to the matching authority record.
 300
 301 =over 8
 302
 303 =item B<--help>
 304
 305 Prints this help
 306
 307 =item B<-v|--verbose>
 308
 309 Provide verbose log information (print the number of headings changed for each
 310 bib record).
 311
 312 =item B<-l|--link-report>
 313
 314 Provide a report of all the headings that were processed: which were matched,
 315 which were not, etc.
 316
 317 =item B<--auth-limit=S>
 318
 319 Only process those headings which match an authority record that matches the
 320 user-specified WHERE clause.
 321
 322 =item B<--bib-limit=S>
 323
 324 Only process those bib records that match the user-specified WHERE clause.
 325
 326 =item B<--commit=N>
 327
 328 Commit the results to the database after every N records are processed.
 329
 330 =item B<-g=N>
 331
 332 Only process those headings found in MARC field N.
 333
 334 =item B<--test>
 335
 336 Only test the authority linking and report the results; do not change the bib
 337 records.
 338
 339 =back
 340
 341 =cut