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 = $biblio->metadata->record;
 205     unless ( defined $record ) {
 206         print
 207 "\nCould not retrieve bib $biblionumber from the database - record is corrupt.\n";
 208         $num_bad_bibs++;
 209         return;
 210     }
 211
 212     my $frameworkcode = GetFrameworkCode($biblionumber);
 213
 214     my ( $headings_changed, $results ) =
 215       LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, $allowrelink, $tagtolink );
 216     foreach my $key ( keys %{ $results->{'unlinked'} } ) {
 217         $unlinked_headings{$key} += $results->{'unlinked'}->{$key};
 218     }
 219     foreach my $key ( keys %{ $results->{'linked'} } ) {
 220         $linked_headings{$key} += $results->{'linked'}->{$key};
 221     }
 222     foreach my $key ( keys %{ $results->{'fuzzy'} } ) {
 223         $fuzzy_headings{$key} += $results->{'fuzzy'}->{$key};
 224     }
 225
 226     if ($headings_changed) {
 227         if ($verbose) {
 228             my $title = substr( $record->title, 0, 20 );
 229             printf(
 230                 "Bib %12d (%-20s): %3d headings changed\n",
 231                 $biblionumber,
 232                 $title,
 233                 $headings_changed
 234             );
 235         }
 236         if ( not $test_only ) {
 237             ModBiblio( $record, $biblionumber, $frameworkcode, {
 238                 disable_autolink => 1,
 239                 skip_holds_queue => 1,
 240                 skip_record_index =>1
 241             });
 242             push @updated_biblios, $biblionumber;
 243             #Last param is to note ModBiblio was called from linking script and bib should not be linked again
 244             $num_bibs_modified++;
 245         }
 246     }
 247 }
 248
 249 sub print_progress_and_commit {
 250     my $recs = shift;
 251     $schema->txn_commit();
 252     $indexer->index_records( \@updated_biblios, "specialUpdate", "biblioserver" );
 253     @updated_biblios = ();
 254     $schema->txn_begin();
 255     print "... processed $recs records\n";
 256 }
 257
 258 =head1 NAME
 259
 260 link_bibs_to_authorities.pl
 261
 262 =head1 SYNOPSIS
 263
 264   link_bibs_to_authorities.pl
 265   link_bibs_to_authorities.pl -v
 266   link_bibs_to_authorities.pl -l
 267   link_bibs_to_authorities.pl --commit=1000
 268   link_bibs_to_authorities.pl --auth-limit=STRING
 269   link_bibs_to_authorities.pl --bib-limit=STRING
 270   link_bibs_to_authorities.pl -g=700
 271
 272 =head1 DESCRIPTION
 273
 274 This batch job checks each bib record in the Koha database and attempts to link
 275 each of its headings to the matching authority record.
 276
 277 =over 8
 278
 279 =item B<--help>
 280
 281 Prints this help
 282
 283 =item B<-v|--verbose>
 284
 285 Provide verbose log information (print the number of headings changed for each
 286 bib record).
 287
 288 =item B<-l|--link-report>
 289
 290 Provide a report of all the headings that were processed: which were matched,
 291 which were not, etc.
 292
 293 =item B<--auth-limit=S>
 294
 295 Only process those headings which match an authority record that matches the
 296 user-specified WHERE clause.
 297
 298 =item B<--bib-limit=S>
 299
 300 Only process those bib records that match the user-specified WHERE clause.
 301
 302 =item B<--commit=N>
 303
 304 Commit the results to the database after every N records are processed.
 305
 306 =item B<-g=N>
 307
 308 Only process those headings found in MARC field N.
 309
 310 =item B<--test>
 311
 312 Only test the authority linking and report the results; do not change the bib
 313 records.
 314
 315 =back
 316
 317 =cut