[Koha-cvs] CVS: koha/misc merge_authority.pl,1.1.2.1,1.1.2.2
Paul POULAIN
tipaul at users.sourceforge.net
Tue Mar 8 12:08:37 CET 2005
Update of /cvsroot/koha/koha/misc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv27378/misc
Modified Files:
Tag: rel_2_2
merge_authority.pl
Log Message:
updating merge_authority to have a "batch mode" in this mode all .authid files stored in $KOHAROOT/localfiles/modified_authorities are managed : the corresponding biblios are updated with the modified authority content.
This script can now be put in crontab.
Index: merge_authority.pl
===================================================================
RCS file: /cvsroot/koha/koha/misc/merge_authority.pl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -r1.1.2.1 -r1.1.2.2
*** merge_authority.pl 23 Feb 2005 10:35:28 -0000 1.1.2.1
--- merge_authority.pl 8 Mar 2005 11:08:34 -0000 1.1.2.2
***************
*** 14,18 ****
use Getopt::Long;
! my ($version, $verbose, $mergefrom,$mergeto,$noconfirm);
GetOptions(
'h' => \$version,
--- 14,18 ----
use Getopt::Long;
! my ($version, $verbose, $mergefrom,$mergeto,$noconfirm,$batch);
GetOptions(
'h' => \$version,
***************
*** 21,27 ****
'v' => \$verbose,
'n' => \$noconfirm,
);
! if ($version || ($mergefrom eq '')) {
print <<EOF
Script to merge an authority into another
--- 21,28 ----
'v' => \$verbose,
'n' => \$noconfirm,
+ 'b' => \$batch,
);
! if ($version || ($mergefrom eq '' && !$batch)) {
print <<EOF
Script to merge an authority into another
***************
*** 31,34 ****
--- 32,36 ----
\tf : the authority number to merge (the one that can be deleted after the merge).
\tt : the authority number where to merge
+ \tb : batch merging.
\tn : don't ask for confirmation (useful for batch mergings, should not be used on command line)
***************
*** 38,45 ****
Before doing anything, the script will show both authorities and ask for confirmation. Of course, you can merge only 2 authorities of the same kind.
EOF
;#
! die;
! }#/'
my $dbh = C4::Context->dbh;
--- 40,57 ----
Before doing anything, the script will show both authorities and ask for confirmation. Of course, you can merge only 2 authorities of the same kind.
+
+ BATCH MODE :
+ The batch mode is done to report modifs. On every authority modif, a file is generated in KOHAROOT/localfile/modified_authorities/ If this script is called with -b, it parses the directory, finding & updating biblios using the modified authority.
+
+ ./merge_authority.pl -b
+
+ (don't forget to export PERL5LIB and KOHA_CONF. Here is my cron job :
+ SHELL=/bin/bash
+ */5 * * * * export PERL5LIB=/home/httpd/koha;export KOHA_CONF=/etc/mykoha.conf;/home/httpd/koha/scripts/misc/merge_authority.pl -b -n
+
EOF
;#
! exit;
! }#
my $dbh = C4::Context->dbh;
***************
*** 47,116 ****
$|=1; # flushes output
! my $authfrom = AUTHgetauthority($dbh,$mergefrom);
! my $authto = AUTHgetauthority($dbh,$mergeto);
!
! my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
! my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto);
!
! unless ($noconfirm) {
! print "************\n";
! print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$authfrom->as_formatted;
! print "\n*************\n";
! print "Into authority : $mergeto ($authtypecodeto)\n".$authto->as_formatted;
! print "\n\nDo you confirm (enter YES)?";
! my $confirm = <STDIN>;
! chop $confirm;
! unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
! print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
! print "Merge cancelled\n";
! exit;
}
}
! my $starttime = gettimeofday;
! print "Merging\n" unless $noconfirm;
! # search the tag to report
! my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
! $sth->execute($authtypecodefrom);
! my ($auth_tag_to_report) = $sth->fetchrow;
! # my $record_to_report = $authto->field($auth_tag_to_report);
! print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
! my @record_to = $authto->field($auth_tag_to_report)->subfields();
! my @record_from = $authfrom->field($auth_tag_to_report)->subfields();
!
! # search all biblio tags using this authority.
! $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
! $sth->execute($authtypecodefrom);
! my $tags_using_authtype;
! while (my ($tagfield) = $sth->fetchrow) {
! $tags_using_authtype.= "'".$tagfield."',";
! }
! chop $tags_using_authtype;
! # now, find every biblio using this authority
! my $query = "select bibid,tag,tag_indicator,tagorder,subfieldcode,subfieldorder from marc_subfield_table where tag in ($tags_using_authtype) and subfieldcode='9' and subfieldvalue='$mergefrom'";
! $sth = $dbh->prepare($query);
! $sth->execute;
! my $nbdone;
! # and delete entries before recreating them
! while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
! my $biblio = MARCgetbiblio($dbh,$bibid);
! print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
! # now, we know what uses the authority & where.
! # delete all subfields that are in the same tag/tagorder and that are in the authority (& that are not in tab ignore in the biblio)
! # then recreate them with the new authority.
! foreach my $subfield (@record_from) {
! &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield->[0]);
}
! &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9');
! foreach my $subfield (@record_to) {
! &MARCaddsubfield($dbh,$bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
! }
! &MARCaddsubfield($dbh,$bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto);
! my $biblio = MARCgetbiblio($dbh,$bibid);
! print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
! $nbdone++;
! # &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
! }
! my $timeneeded = gettimeofday - $starttime;
! print "$nbdone authorities done in $timeneeded seconds" unless $noconfirm;
\ No newline at end of file
--- 59,157 ----
$|=1; # flushes output
! my $starttime = gettimeofday;
! if ($batch) {
! my @authlist;
! my $cgidir = C4::Context->intranetdir ."/cgi-bin";
! unless (opendir(DIR, "$cgidir/localfile/modified_authorities")) {
! $cgidir = C4::Context->intranetdir;
! opendir(DIR, "$cgidir/localfile/modified_authorities") || die "can't opendir $cgidir/localfile/modified_authorities: $!";
! }
! while (my $authid = readdir(DIR)) {
! if ($authid =~ /\.authid$/) {
! $authid =~ s/\.authid$//;
! print "managing $authid\n" if $verbose;
! my $MARCauth = AUTHgetauthority($dbh,$authid);
! &merge($dbh,$authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
! unlink $cgidir.'/localfile/modified_authorities/'.$authid.'.authid';
! }
}
+ closedir DIR;
+ } else {
+ my $MARCfrom = AUTHgetauthority($dbh,$mergefrom);
+ my $MARCto = AUTHgetauthority($dbh,$mergeto);
+ &merge($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto);
}
! my $timeneeded = gettimeofday - $starttime;
! print "Done in $timeneeded seconds" unless $noconfirm;
! sub merge {
! my ($dbh,$mergefrom,$MARCfrom,$mergeto,$MARCto) = @_;
! my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
! my $authtypecodeto = AUTHfind_authtypecode($dbh,$mergeto);
! # return if authority does not exist
! my @X = $MARCfrom->fields();
! return if $#X == -1;
! my @X = $MARCto->fields();
! return if $#X == -1;
! unless ($noconfirm) {
! print "************\n";
! print "You will merge authority : $mergefrom ($authtypecodefrom)\n".$MARCfrom->as_formatted;
! print "\n*************\n";
! print "Into authority : $mergeto ($authtypecodeto)\n".$MARCto->as_formatted;
! print "\n\nDo you confirm (enter YES)?";
! my $confirm = <STDIN>;
! chop $confirm;
! unless (uc($confirm) eq 'YES' and $authtypecodefrom eq $authtypecodeto) {
! print "IMPOSSIBLE : authorities are not of the same type ($authtypecodefrom vs $authtypecodeto) !!!\n" if $authtypecodefrom ne $authtypecodeto;
! print "Merge cancelled\n";
! exit;
! }
}
! print "Merging\n" unless $noconfirm;
! # search the tag to report
! my $sth = $dbh->prepare("select auth_tag_to_report from auth_types where authtypecode=?");
! $sth->execute($authtypecodefrom);
! my ($auth_tag_to_report) = $sth->fetchrow;
! # my $record_to_report = $MARCto->field($auth_tag_to_report);
! print "Reporting authority tag $auth_tag_to_report :\n" if $verbose;
! my @record_to;
! @record_to = $MARCto->field($auth_tag_to_report)->subfields() if $MARCto->field($auth_tag_to_report);
! my @record_from;
! @record_from = $MARCfrom->field($auth_tag_to_report)->subfields() if $MARCfrom->field($auth_tag_to_report);
!
! # search all biblio tags using this authority.
! $sth = $dbh->prepare("select distinct tagfield from marc_subfield_structure where authtypecode=?");
! $sth->execute($authtypecodefrom);
! my $tags_using_authtype;
! while (my ($tagfield) = $sth->fetchrow) {
! $tags_using_authtype.= "'".$tagfield."',";
! }
! chop $tags_using_authtype;
! # now, find every biblio using this authority
! my $query = "select bibid,tag,tag_indicator,tagorder,subfieldcode,subfieldorder from marc_subfield_table where tag in ($tags_using_authtype) and subfieldcode='9' and subfieldvalue='$mergefrom'";
! $sth = $dbh->prepare($query);
! $sth->execute;
! # my $nbdone;
! # and delete entries before recreating them
! while (my ($bibid,$tag,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder) = $sth->fetchrow) {
! my $biblio = MARCgetbiblio($dbh,$bibid);
! print "BEFORE : ".$biblio->as_formatted."\n" if $verbose;
! # now, we know what uses the authority & where.
! # delete all subfields that are in the same tag/tagorder and that are in the authority (& that are not in tab ignore in the biblio)
! # then recreate them with the new authority.
! foreach my $subfield (@record_from) {
! &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield->[0]);
! }
! &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,'9') unless $mergefrom eq $mergeto;
! foreach my $subfield (@record_to) {
! &MARCaddsubfield($dbh,$bibid,$tag,$tag_indicator,$tagorder,$subfield->[0],$subfieldorder,$subfield->[1]);
! }
! &MARCaddsubfield($dbh,$bibid,$tag,$tag_indicator,$tagorder,'9',$subfieldorder,$mergeto) unless $mergefrom eq $mergeto;
! my $biblio = MARCgetbiblio($dbh,$bibid);
! print "AFTER : ".$biblio->as_formatted."\n" if $verbose;
! # $nbdone++;
! # &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfieldcode,$subfieldorder);
!
! }
! }
\ No newline at end of file
More information about the Koha-cvs
mailing list