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