misc/link_bibs_to_authorities.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN {
   7
   8     # find Koha's Perl modules
   9     # test carefully before changing this
  10     use FindBin ();
  11     eval { require "$FindBin::Bin/kohalib.pl" };
  12 }
  13
  14 use Koha::Script;
  15 use C4::Context;
  16 use C4::Biblio qw(
  17     GetFrameworkCode
  18     GetMarcBiblio
  19     LinkBibHeadingsToAuthorities
  20     ModBiblio
  21 );
  22 use Getopt::Long qw( GetOptions );
  23 use Pod::Usage qw( pod2usage );
  24 use Time::HiRes qw( time );
  25 use POSIX qw( ceil strftime );
  26 use Module::Load::Conditional qw( can_load );
  27
  28 sub usage {
  29     pod2usage( -verbose => 2 );
  30     exit;
  31 }
  32
  33 $| = 1;
  34
  35 # command-line parameters
  36 my $verbose     = 0;
  37 my $link_report = 0;
  38 my $test_only   = 0;
  39 my $want_help   = 0;
  40 my $auth_limit;
  41 my $bib_limit;
  42 my $commit = 100;
  43 my $tagtolink;
  44 my $allowrelink = C4::Context->preference("CatalogModuleRelink") || '';
  45
  46 my $result = GetOptions(
  47     'v|verbose'      => \$verbose,
  48     't|test'         => \$test_only,
  49     'l|link-report'  => \$link_report,
  50     'a|auth-limit=s' => \$auth_limit,
  51     'b|bib-limit=s'  => \$bib_limit,
  52     'c|commit=i'     => \$commit,
  53     'g|tagtolink=i'  => \$tagtolink,
  54     'h|help'         => \$want_help
  55 );
  56
  57 binmode( STDOUT, ":encoding(UTF-8)" );
  58
  59 if ( not $result or $want_help ) {
  60     usage();
  61 }
  62
  63 my $linker_module =
  64   "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' );
  65 unless ( can_load( modules => { $linker_module => undef } ) ) {
  66     $linker_module = 'C4::Linker::Default';
  67     unless ( can_load( modules => { $linker_module => undef } ) ) {
  68         die "Unable to load linker module. Aborting.";
  69     }
  70 }
  71
  72 my $linker = $linker_module->new(
  73     {
  74         'auth_limit' => $auth_limit,
  75         'options'    => C4::Context->preference("LinkerOptions")
  76     }
  77 );
  78
  79 my $num_bibs_processed = 0;
  80 my $num_bibs_modified  = 0;
  81 my $num_bad_bibs       = 0;
  82 my %unlinked_headings;
  83 my %linked_headings;
  84 my %fuzzy_headings;
  85 my $dbh = C4::Context->dbh;
  86 $dbh->{AutoCommit} = 0;
  87 process_bibs( $linker, $bib_limit, $auth_limit, $commit, { tagtolink => $tagtolink, allowrelink => $allowrelink });
  88 $dbh->commit();
  89
  90 exit 0;
  91
  92 sub process_bibs {
  93     my ( $linker, $bib_limit, $auth_limit, $commit, $args ) = @_;
  94     my $tagtolink = $args->{tagtolink};
  95     my $allowrelink = $args->{allowrelink};
  96     my $bib_where = '';
  97     my $starttime = time();
  98     if ($bib_limit) {
  99         $bib_where = "WHERE $bib_limit";
 100     }
 101     my $sql =
 102       "SELECT biblionumber FROM biblio $bib_where ORDER BY biblionumber ASC";
 103     my $sth = $dbh->prepare($sql);
 104     $sth->execute();
 105     my $linker_args = { tagtolink => $tagtolink, allowrelink => $allowrelink };
 106     while ( my ($biblionumber) = $sth->fetchrow_array() ) {
 107         $num_bibs_processed++;
 108         process_bib( $linker, $biblionumber, $linker_args );
 109
 110         if ( not $test_only and ( $num_bibs_processed % $commit ) == 0 ) {
 111             print_progress_and_commit($num_bibs_processed);
 112         }
 113     }
 114
 115     if ( not $test_only ) {
 116         $dbh->commit;
 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 $bib = GetMarcBiblio({ biblionumber => $biblionumber });
 204     unless ( defined $bib ) {
 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, $bib, $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( $bib->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( $bib, $biblionumber, $frameworkcode, { disable_autolink => 1 });
 237             #Last param is to note ModBiblio was called from linking script and bib should not be linked again
 238             $num_bibs_modified++;
 239         }
 240     }
 241 }
 242
 243 sub print_progress_and_commit {
 244     my $recs = shift;
 245     $dbh->commit();
 246     print "... processed $recs records\n";
 247 }
 248
 249 =head1 NAME
 250
 251 link_bibs_to_authorities.pl
 252
 253 =head1 SYNOPSIS
 254
 255   link_bibs_to_authorities.pl
 256   link_bibs_to_authorities.pl -v
 257   link_bibs_to_authorities.pl -l
 258   link_bibs_to_authorities.pl --commit=1000
 259   link_bibs_to_authorities.pl --auth-limit=STRING
 260   link_bibs_to_authorities.pl --bib-limit=STRING
 261   link_bibs_to_authorities.pl -g=700
 262
 263 =head1 DESCRIPTION
 264
 265 This batch job checks each bib record in the Koha database and attempts to link
 266 each of its headings to the matching authority record.
 267
 268 =over 8
 269
 270 =item B<--help>
 271
 272 Prints this help
 273
 274 =item B<-v|--verbose>
 275
 276 Provide verbose log information (print the number of headings changed for each
 277 bib record).
 278
 279 =item B<-l|--link-report>
 280
 281 Provide a report of all the headings that were processed: which were matched,
 282 which were not, etc.
 283
 284 =item B<--auth-limit=S>
 285
 286 Only process those headings which match an authority record that matches the
 287 user-specified WHERE clause.
 288
 289 =item B<--bib-limit=S>
 290
 291 Only process those bib records that match the user-specified WHERE clause.
 292
 293 =item B<--commit=N>
 294
 295 Commit the results to the database after every N records are processed.
 296
 297 =item B<-g=N>
 298
 299 Only process those headings found in MARC field N.
 300
 301 =item B<--test>
 302
 303 Only test the authority linking and report the results; do not change the bib
 304 records.
 305
 306 =back
 307
 308 =cut