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