[Koha-cvs] CVS: koha/misc merge_authority.pl,1.1.2.1,1.1.2.2

[Paul POULAIN]

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