Bug 17702: Add UI to manage account credit types
[koha.git] / misc / migration_tools / create_analytical_rel.pl
blob2de9c23d45757992c2f9b5acc15d7c3baed479f9
1 #!/usr/bin/perl
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" };
12 use Koha::Script;
13 use C4::Context;
14 use C4::Biblio;
15 use C4::Items;
16 use Koha::Items;
17 use Getopt::Long;
19 $| = 1;
21 # command-line parameters
22 my $want_help = 0;
23 my $do_update = 0;
24 my $wherestrings;
26 my $result = GetOptions(
27 'run-update' => \$do_update,
28 'where=s@' => \$wherestrings,
29 'h|help' => \$want_help,
32 if (not $result or $want_help or not $do_update) {
33 print_usage();
34 exit 0;
37 my $num_bibs_processed = 0;
38 my $num_bibs_modified = 0;
39 my $num_noitem_forbarcode = 0;
40 my $num_nobarcode_inhostfield =0;
41 my $num_hostfields_unabletomodify =0;
42 my $num_bad_bibs = 0;
43 my $dbh = C4::Context->dbh;
44 $dbh->{AutoCommit} = 0;
46 process_bibs();
47 $dbh->commit();
49 exit 0;
51 sub process_bibs {
52 my $sql = "SELECT biblionumber FROM biblio JOIN biblioitems USING (biblionumber)";
53 $sql.="WHERE ". join(" AND ",@$wherestrings) if ($wherestrings);
54 $sql.="ORDER BY biblionumber ASC";
55 my $sth = $dbh->prepare($sql);
56 eval{$sth->execute();};
57 if ($@){ die "error $@";};
58 while (my ($biblionumber) = $sth->fetchrow_array()) {
59 $num_bibs_processed++;
60 process_bib($biblionumber);
62 if (($num_bibs_processed % 100) == 0) {
63 print_progress_and_commit($num_bibs_processed);
67 $dbh->commit;
69 print <<_SUMMARY_;
71 Create Analytical records relationships report
72 -----------------------------------------------
73 Number of bibs checked: $num_bibs_processed
74 Number of bibs modified: $num_bibs_modified
75 Number of hostfields with no barcodes: $num_nobarcode_inhostfield
76 Number of barcodes not found: $num_noitem_forbarcode
77 Number of hostfields unable to modify: $num_hostfields_unabletomodify
78 Number of bibs with errors: $num_bad_bibs
79 _SUMMARY_
82 sub process_bib {
83 my $biblionumber = shift;
85 my $bib = GetMarcBiblio({ biblionumber => $biblionumber });
86 unless (defined $bib) {
87 print "\nCould not retrieve bib $biblionumber from the database - record is corrupt.\n";
88 $num_bad_bibs++;
89 return;
91 #loop through each host field and populate subfield 0 and 9
92 my $analyticfield = '773';
93 foreach my $hostfield ( $bib->field($analyticfield) ) {
94 if(my $barcode = $hostfield->subfield('o')){
95 my $item = Koha::Items->find({ barcode => $barcode });
96 if ($item) {
97 my $modif;
98 if ( $hostfield->subfield('0') ne $biblionumber ) {
99 $hostfield->update( '0', $biblionumber );
100 $modif = 1;
102 if ( $hostfield->subfield('9') ne $item->itemnumber ) {
103 $hostfield->update( '9', $item->itemnumber );
104 $modif = 1;
106 if ($modif) {
107 $num_bibs_modified++;
108 my $modresult = ModBiblio( $bib, $biblionumber, '' );
109 warn "Modifying biblio $biblionumber";
110 if ( !$modresult ) {
111 warn "Unable to modify biblio $biblionumber with update host field";
112 $num_hostfields_unabletomodify++;
116 else {
117 warn "No item record found for barcode $barcode";
118 $num_noitem_forbarcode++;
120 } else{
121 warn "No barcode in host field for biblionumber $biblionumber";
122 $num_nobarcode_inhostfield++;
127 sub print_progress_and_commit {
128 my $recs = shift;
129 $dbh->commit();
130 print "... processed $recs records\n";
133 sub print_usage {
134 print <<_USAGE_;
135 $0: establish relationship to host items
137 Based on barcode in host field populates subfield 0 with host biblionumber and subfield 9 with host itemnumber.
139 Subfield 0 and 9 are used in Koha screns to display relationships between analytical records and host bibs and items.
141 NOT usable with UNIMARC data. You can use it only if you have tag 461 with also an items id (like barcode or item numbers). In UNIMARC this situation is very rare. If you have data coded in this way, send a mail to koha-dev mailing list and ask for the feature.
143 Parameters:
144 --run-update run the synchronization
145 --where condition selects the biblios on a criterium (Repeatable)
146 --help or -h show this message.
147 _USAGE_