Attachment #4733 for bug #6094

View | Details | Raw Unified | Return to bug 6094
Collapse All | Expand All




    $sth->execute($authid);
}

=head2 ModAuthority

  $authid= &ModAuthority($authid,$record,$authtypecode)

Modifies authority record, optionally updates attached biblios.

=cut

sub ModAuthority {
  my ($authid,$record,$authtypecode)=@_; # deprecated $merge parameter removed

  my $dbh=C4::Context->dbh;
  #Now rewrite the $record to table with an add
  my $oldrecord=GetAuthority($authid);
  $authid=AddAuthority($record,$authid,$authtypecode);

  # If a library thinks that updating all biblios is a long process and wishes
  # to leave that to a cron job, use misc/migration_tools/merge_authority.pl.
  # In that case set system preference "dontmerge" to 1. Otherwise biblios will
  # be updated.
  unless(C4::Context->preference('dontmerge') eq '1'){
      &merge($authid,$oldrecord,$authid,$record);
  } else {
      # save the file in /var/tmp/modified_authorities
      my $dir=  "/var/tmp/modified_authorities";
      unless(-d $dir) {
	mkdir $dir; system "chmod 777 $dir";
              closedir(DIR);
      }
      my $filename = "$dir/$authid.authid";
      open AUTH, '>', $filename;
      open AUTH, "> $filename";
      print AUTH $authid;
      close AUTH;
  }




./merge_authority.pl -f 2457 -t 531

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.
Make sure that if this script runs in batch mode, the process has sufficient permissions for removing files from /var/tmp/modified_authorities.
EOF
;#
die;

print "Merging\n" unless $noconfirm;
if ($batch) {
  my @authlist;
  my $dir= "/var/tmp/modified_authorities";
  my $rv=opendir(DIR, $dir);
  print "Cannot open /var/tmp/modified_authorities!\n" unless $rv;
  while ($rv && (my $authid = readdir(DIR))) {
  } 
  while (my $authid = readdir(DIR)) {
    if ($authid =~ /\.authid$/) {
      $authid =~ s/\.authid$//;
      print "managing $authid\n" if $verbose;
      my $MARCauth = GetAuthority($authid) ;
      next unless ($MARCauth);
      merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
      unlink $dir.'/'.$authid.'.authid';
      print "Warning: File $authid.authid could not be removed\n"
        if -e $dir.'/'.$authid.'.authid';
    }
  }
  closedir DIR if $rv;
} else {
  my $MARCfrom = GetAuthority($mergefrom);
  my $MARCto = GetAuthority($mergeto);
- 

Return to bug 6094

Lines 734-761 sub DelAuthority { Link Here

(-)a/C4/AuthoritiesMarc.pm (-13 / +21 lines)
734	$sth->execute($authid);	734	$sth->execute($authid);
735	}	735	}
736		736
		737	=head2 ModAuthority
		738
		739	$authid= &ModAuthority($authid,$record,$authtypecode)
		740
		741	Modifies authority record, optionally updates attached biblios.
		742
		743	=cut
		744
737	sub ModAuthority {	745	sub ModAuthority {
738	my ($authid,$record,$authtypecode,$merge)=@_;	746	my ($authid,$record,$authtypecode)=@_; # deprecated $merge parameter removed
		747
739	my $dbh=C4::Context->dbh;	748	my $dbh=C4::Context->dbh;
740	#Now rewrite the $record to table with an add	749	#Now rewrite the $record to table with an add
741	my $oldrecord=GetAuthority($authid);	750	my $oldrecord=GetAuthority($authid);
742	$authid=AddAuthority($record,$authid,$authtypecode);	751	$authid=AddAuthority($record,$authid,$authtypecode);
743		752
744	### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p	753	# If a library thinks that updating all biblios is a long process and wishes
745	### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated	754	# to leave that to a cron job, use misc/migration_tools/merge_authority.pl.
746	### the $merge flag is now depreceated and will be removed at code cleaning	755	# In that case set system preference "dontmerge" to 1. Otherwise biblios will
747	if (C4::Context->preference('MergeAuthoritiesOnUpdate') ){	756	# be updated.
		757	unless(C4::Context->preference('dontmerge') eq '1'){
748	&merge($authid,$oldrecord,$authid,$record);	758	&merge($authid,$oldrecord,$authid,$record);
749	} else {	759	} else {
750	# save the file in tmp/modified_authorities	760	# save the file in /var/tmp/modified_authorities
751	my $cgidir = C4::Context->intranetdir ."/cgi-bin";	761	my $dir= "/var/tmp/modified_authorities";
752	unless (opendir(DIR,"$cgidir")) {	762	unless(-d $dir) {
753	$cgidir = C4::Context->intranetdir."/";	763	mkdir $dir; system "chmod 777 $dir";
754	closedir(DIR);
755	}	764	}
756		765	my $filename = "$dir/$authid.authid";
757	my $filename = $cgidir."/tmp/modified_authorities/$authid.authid";	766	open AUTH, '>', $filename;
758	open AUTH, "> $filename";
759	print AUTH $authid;	767	print AUTH $authid;
760	close AUTH;	768	close AUTH;
761	}	769	}

Lines 44-49 SAMPLE : Link Here

(-)a/misc/migration_tools/merge_authority.pl (-9 / +9 lines)
44	./merge_authority.pl -f 2457 -t 531	44	./merge_authority.pl -f 2457 -t 531
45		45
46	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.	46	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.
		47	Make sure that if this script runs in batch mode, the process has sufficient permissions for removing files from /var/tmp/modified_authorities.
47	EOF	48	EOF
48	;#	49	;#
49	die;	50	die;
Lines 76-97 my $starttime = gettimeofday; Link Here
76	print "Merging\n" unless $noconfirm;	77	print "Merging\n" unless $noconfirm;
77	if ($batch) {	78	if ($batch) {
78	my @authlist;	79	my @authlist;
79	my $cgidir = C4::Context->intranetdir ."/cgi-bin";	80	my $dir= "/var/tmp/modified_authorities";
80	unless (opendir(DIR, "$cgidir/tmp/modified_authorities")) {	81	my $rv=opendir(DIR, $dir);
81	$cgidir = C4::Context->intranetdir;	82	print "Cannot open /var/tmp/modified_authorities!\n" unless $rv;
82	opendir(DIR, "$cgidir/tmp/modified_authorities") \|\| die "can't opendir $cgidir/tmp/modified_authorities: $!";	83	while ($rv && (my $authid = readdir(DIR))) {
83	}
84	while (my $authid = readdir(DIR)) {
85	if ($authid =~ /\.authid$/) {	84	if ($authid =~ /\.authid$/) {
86	$authid =~ s/\.authid$//;	85	$authid =~ s/\.authid$//;
87	print "managing $authid\n" if $verbose;	86	print "managing $authid\n" if $verbose;
88	my $MARCauth = GetAuthority($authid) ;	87	my $MARCauth = GetAuthority($authid) ;
89	next unless ($MARCauth);	88	next unless ($MARCauth);
90	merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);	89	merge($authid,$MARCauth,$authid,$MARCauth) if ($MARCauth);
91	unlink $cgidir.'/tmp/modified_authorities/'.$authid.'.authid';	90	unlink $dir.'/'.$authid.'.authid';
		91	print "Warning: File $authid.authid could not be removed\n"
		92	if -e $dir.'/'.$authid.'.authid';
92	}	93	}
93	}	94	}
94	closedir DIR;	95	closedir DIR if $rv;
95	} else {	96	} else {
96	my $MARCfrom = GetAuthority($mergefrom);	97	my $MARCfrom = GetAuthority($mergefrom);
97	my $MARCto = GetAuthority($mergeto);	98	my $MARCto = GetAuthority($mergeto);
98	-