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