#!/usr/bin/perl # # Copyright (C) 2012 FCT/UNL # # This file is part of Koha. # # Koha is free software; you can redistribute it and/or modify it under the # terms of the GNU General Public License as published by the Free Software # Foundation; either version 2 of the License, or (at your option) any later # version. # # Koha is distributed in the hope that it will be useful, but WITHOUT ANY # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR # A PARTICULAR PURPOSE. See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with Koha; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. use strict; use warnings; BEGIN { # find Koha's Perl modules # test carefully before changing this use FindBin; eval { require "$FindBin::Bin/../kohalib.pl" }; } # possible modules to use use Getopt::Long; use C4::Context; use C4::Biblio; use Pod::Usage; sub usage { pod2usage( -verbose => 2 ); exit; } # Database handle my $dbh = C4::Context->dbh; # Benchmarking variables my $startime = time(); my $totalcount = 0; # Options my $biblionumber = ''; my $whereclause = ''; my $help; my $outfile; my $default_unimarc_language = C4::Context->preference("UNIMARCField100Language"); GetOptions( 'o|output:s' => \$outfile, 'b|biblionumber:s' => \$biblionumber, 'h|help' => \$help, ); usage() if $help; # Add filter search by biblionumber(s) if any was given if ($biblionumber) { $whereclause = "WHERE `biblionumber` IN ( $biblionumber )"; } # Output log or STDOUT if (defined $outfile) { open(OUT, ">$outfile") || die ("Cannot open output file"); } else { open(OUT, ">&STDOUT") || die ("Couldn't duplicate STDOUT: $!"); } # Fetch info from the search my $sth1 = $dbh->prepare("SELECT biblionumber, frameworkcode FROM biblio $whereclause"); $sth1->execute(); # Process each MARC biblio record while (my ($biblionumber, $frameworkcode) = $sth1->fetchrow_array){ # Get MARC biblio record my $record = GetMarcBiblio($biblionumber); # Retrieve subfield 100$a my $subfield = $record->subfield('100', 'a'); # Update the hardcoded 'fre' language code for the one set as UNIMARC default $subfield =~ s/fre/$default_unimarc_language/g; # Print output for the currect record print OUT "Biblionumber: $biblionumber, New 100\$a value: '$subfield'\n"; # Update field 100 with the new subfield a value $record->field('100')->update('a' => $subfield); # Save record to the database ModBiblioMarc($record, $biblionumber, $frameworkcode); $totalcount++; } # Benchmarking my $endtime = time(); my $time = $endtime-$startime; my $averagetime = 0; unless ($time == 0) { $averagetime = $totalcount / $time; }; print OUT "\nUpdated $totalcount records in $time seconds\n"; if (defined $outfile) { close(OUT); } =head1 NAME update_unimarc_100a_language.pl =head1 SYNOPSIS Update all biblio records' field 100a language value with the one defined in the "UNIMARC field 100 default language" system preference. =head1 DESCRIPTION Due to bug 8347, Koha forced UNIMARC 100 field code language to 'fre' This script aims to replace the value on all the records, or in a given set of records, for a new value defined by the new system preference "UNIMARC field 100 default language". =over 8 =item B<-help> Prints this help =item B<-b> Limits the action to a fixed set of comma separated biblionumber values Update record with biblionumber 1: update_unimarc_100a_language.pl -biblionumber=1 (or -b=1) Update records with biblionumbers 1, 2 and 3: update_unimarc_100a_language.pl -biblionumber=1,2,3 (or -b=1,2,3) =item B<-o> Sets the output of the script to a given file. Helpful for verification purposes on big sets of records Update records with script output being sent to file update_unimarc_100a_language.pl -output=file.txt (or -o=file.txt) =back =cut