Merge remote-tracking branch 'kc/new/enh/bug_4877' into kcmaster
[wip/koha-chris_n.git] / misc / link_bibs_to_authorities.pl
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
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 }