misc/link_bibs_to_authorities.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 #use warnings; FIXME - Bug 2505
   5 BEGIN {
   6     # find Koha's Perl modules
   7     # test carefully before changing this
   8     use FindBin;
   9     eval { require "$FindBin::Bin/kohalib.pl" };
  10 }
  11
  12 use C4::Context;
  13 use C4::Biblio;
  14 use Getopt::Long;
  15
  16 $| = 1;
  17
  18 # command-line parameters
  19 my $verbose   = 0;
  20 my $test_only = 0;
  21 my $want_help = 0;
  22
  23 my $result = GetOptions(
  24     'verbose'       => \$verbose,
  25     'test'          => \$test_only,
  26     'h|help'        => \$want_help
  27 );
  28
  29 if (not $result or $want_help) {
  30     print_usage();
  31     exit 0;
  32 }
  33
  34 my $num_bibs_processed = 0;
  35 my $num_bibs_modified = 0;
  36 my $num_bad_bibs = 0;
  37 my $dbh = C4::Context->dbh;
  38 $dbh->{AutoCommit} = 0;
  39 process_bibs();
  40 $dbh->commit();
  41
  42 exit 0;
  43
  44 sub process_bibs {
  45     my $sql = "SELECT biblionumber FROM biblio ORDER BY biblionumber ASC";
  46     my $sth = $dbh->prepare($sql);
  47     $sth->execute();
  48     while (my ($biblionumber) = $sth->fetchrow_array()) {
  49         $num_bibs_processed++;
  50         process_bib($biblionumber);
  51
  52         if (not $test_only and ($num_bibs_processed % 100) == 0) {
  53             print_progress_and_commit($num_bibs_processed);
  54         }
  55     }
  56
  57     if (not $test_only) {
  58         $dbh->commit;
  59     }
  60
  61     print <<_SUMMARY_;
  62
  63 Bib authority heading linking report
  64 ------------------------------------
  65 Number of bibs checked:       $num_bibs_processed
  66 Number of bibs modified:      $num_bibs_modified
  67 Number of bibs with errors:   $num_bad_bibs
  68 _SUMMARY_
  69 }
  70
  71 sub process_bib {
  72     my $biblionumber = shift;
  73
  74     my $bib = GetMarcBiblio($biblionumber);
  75     unless (defined $bib) {
  76         print "\nCould not retrieve bib $biblionumber from the database - record is corrupt.\n";
  77         $num_bad_bibs++;
  78         return;
  79     }
  80
  81     my $headings_changed = LinkBibHeadingsToAuthorities($bib);
  82
  83     if ($headings_changed) {
  84         if ($verbose) {
  85             my $title = substr($bib->title, 0, 20);
  86             print "Bib $biblionumber ($title): $headings_changed headings changed\n";
  87         }
  88         if (not $test_only) {
  89             # delete any item tags
  90             my ($itemtag, $itemsubfield) = GetMarcFromKohaField("items.itemnumber", '');
  91             foreach my $field ($bib->field($itemtag)) {
  92                 $bib->delete_field($field);
  93             }
  94             ModBiblio($bib, $biblionumber, GetFrameworkCode($biblionumber));
  95             $num_bibs_modified++;
  96         }
  97     }
  98 }
  99
 100 sub print_progress_and_commit {
 101     my $recs = shift;
 102     $dbh->commit();
 103     print "... processed $recs records\n";
 104 }
 105
 106 sub print_usage {
 107     print <<_USAGE_;
 108 $0: link headings in bib records to authorities.
 109
 110 This batch job checks each bib record in the Koha
 111 database and attempts to link each of its headings
 112 to the matching authority record.
 113
 114 Parameters:
 115     --verbose               print the number of headings changed
 116                             for each bib
 117     --test                  only test the authority linking
 118                             and report the results; do not
 119                             change the bib records.
 120     --help or -h            show this message.
 121 _USAGE_
 122 }