misc/link_bibs_to_authorities.pl

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