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