[Koha-cvs] koha/misc check_suggestions.pl delete_authority.pl [rel_2_2]
paul poulain
paul at koha-fr.org
Thu Feb 2 17:02:39 CET 2006
CVSROOT: /cvsroot/koha
Module name: koha
Branch: rel_2_2
Changes by: paul poulain <tipaul at savannah.gnu.org> 06/02/02 16:02:39
Added files:
misc : check_suggestions.pl delete_authority.pl
Log message:
2 new scripts :
* check_suggestion.pl, that send a mail to the librarian when a suggestion is pending
* delete_authority.pl, that deletes all entries of an authority in a biblio.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/koha/misc/check_suggestions.pl?only_with_tag=rel_2_2&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/koha/misc/delete_authority.pl?only_with_tag=rel_2_2&rev=1.1.2.1
Patches:
Index: koha/misc/check_suggestions.pl
diff -u /dev/null koha/misc/check_suggestions.pl:1.1.2.1
--- /dev/null Thu Feb 2 16:02:39 2006
+++ koha/misc/check_suggestions.pl Thu Feb 2 16:02:39 2006
@@ -0,0 +1,112 @@
+#!/usr/bin/perl -w
+#-----------------------------------
+# Script Name: check_suggestions.pl
+# Script Version: 1.0
+# Date: 2006/1/15
+# author : Paul Poulain (paul at koha-fr.org)
+# Description:
+# This script send a mail to librarians that have a suggestion to check
+# The mail is sent to the librarian defined in branches table, depending on who
+# wrote the suggestion
+#
+# 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., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use C4::Context;
+use C4::Date;
+use Mail::Sendmail; # comment out if not doing e-mail notices
+use Getopt::Long;
+
+my ($confirm, $nomail);
+GetOptions(
+ 'c' => \$confirm,
+ 'n' => \$nomail,
+);
+unless ($confirm) {
+ print qq|
+This script checks for any pending suggestions and send a mail to the librarian to warn them.
+It checks 'ASKED' suggestions, group them by borrower branch, and send a mail to the mail address in branches
+table
+You MUST edit this script for your library BEFORE you run it for the first time!
+See the comments in the script for directions on changing the script.
+This script has 2 parameters :
+ -c to confirm and remove this help & warning
+ -n to avoid sending any mail. Instead, all mail messages are printed on screen. Usefull for testing purposes.
+
+Do you wish to continue? (y/n)
+|;
+ chomp($_ = <STDIN>);
+ exit unless (/^y/i); # comment these lines out once you've made the changes
+
+}
+#
+# BEGINNING OF PARAMETERS
+#
+my $smtpserver = 'smtp.server.com'; # your smtp server (the server who sent mails)
+my $mailtitle = 'Suggestions to manage'; # the title of the mails
+my $mailtext = "Hello\n\nThere are <suggestion_count> waiting for a decision in Koha ILS\n\n\n";
+#
+# END OF PARAMETERS
+#
+open OUTFILE, ">overdues" or die "Cannot open file overdues: $!";
+
+# set the e-mail server -- comment out if not doing e-mail notices
+unshift @{$Mail::Sendmail::mailcfg{'smtp'}} , $smtpserver;
+# set your own mail server name here
+
+my $dbh = C4::Context->dbh;
+my $sth = $dbh->prepare ("SELECT count(*),branchemail FROM `suggestions`
+left join borrowers on borrowernumber=suggestedby
+left join branches on branches.branchcode=borrowers.branchcode
+WHERE status='ASKED' group by borrowers.branchcode
+");
+
+$sth->execute;
+#
+# my $itemcount = 0;
+# my $row;
+my $count = 0; # to keep track of how many notices are printed
+my $e_count = 0; # and e-mailed
+my $date=localtime;
+my ($suggestion_count,$email);
+
+while (($suggestion_count,$email) = $sth->fetchrow) {
+ my $notice = $mailtext;
+ $notice =~ s/\<suggestion_count\>/$suggestion_count/g;
+
+ # if not using e-mail notices, comment out the following lines
+ if ($email) { # or you might check for borrowers.preferredcont
+ if ($nomail) {
+ print "TO => $email\n";
+ print "SUBJECT => $mailtitle\n";
+ print "MESSAGE => $notice\n";
+ } else {
+ my %mail = ( To => $email,
+ From => 'webmaster@'.$smtpserver,
+ Subject => $mailtitle,
+ Message => $notice,
+ );
+ sendmail(%mail);
+ }
+ $e_count++
+ } else {
+ print OUTFILE $notice;
+ $count++;
+ } # and comment this one out, too, if not using e-mail
+
+}
+$sth->finish;
+close OUTFILE;
Index: koha/misc/delete_authority.pl
diff -u /dev/null koha/misc/delete_authority.pl:1.1.2.1
--- /dev/null Thu Feb 2 16:02:39 2006
+++ koha/misc/delete_authority.pl Thu Feb 2 16:02:39 2006
@@ -0,0 +1,139 @@
+#!/usr/bin/perl
+# script that rebuild thesaurus from biblio table.
+
+use strict;
+
+# Koha modules used
+use MARC::File::USMARC;
+use MARC::Record;
+use MARC::Batch;
+use C4::Context;
+use C4::Biblio;
+use C4::AuthoritiesMarc;
+use Time::HiRes qw(gettimeofday);
+
+use Getopt::Long;
+my ($version, $verbose, $mergefrom,$mergeto,$noconfirm,$batch);
+GetOptions(
+ 'h' => \$version,
+ 'f:s' => \$mergefrom,
+ 'v' => \$verbose,
+ 'n' => \$noconfirm,
+ 'b' => \$batch,
+);
+
+if ($version || ($mergefrom eq '' && !$batch)) {
+ print <<EOF
+Script to merge an authority into another
+parameters :
+\th : this version/help screen
+\tv : verbose mode (show many things on screen)
+\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)
+
+All biblios with the authority in -t will be modified and the authority entry removed
+SAMPLE :
+./delete_authority.pl -f 2457
+
+BATCH MODE :
+./delete_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/delete_authority.pl -b -n
+
+EOF
+;#
+exit;
+}#
+
+my $dbh = C4::Context->dbh;
+# my @subf = $subfields =~ /(##\d\d\d##.)/g;
+
+$|=1; # flushes output
+my $starttime = gettimeofday;
+if ($batch) {
+ my @authlist;
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+ unless (opendir(DIR, "$cgidir/localfile/deleted_authorities")) {
+ $cgidir = C4::Context->intranetdir;
+ opendir(DIR, "$cgidir/localfile/deleted_authorities") || die "can't opendir $cgidir/localfile/deleted_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/deleted_authorities/'.$authid.'.authid';
+ }
+ }
+ closedir DIR;
+} else {
+ my $MARCfrom = AUTHgetauthority($dbh,$mergefrom);
+ &del_auth($dbh,$mergefrom,$MARCfrom);
+}
+my $timeneeded = gettimeofday - $starttime;
+print "Done in $timeneeded seconds" unless $noconfirm;
+
+sub del_auth {
+ my ($dbh,$mergefrom,$MARCfrom) = @_;
+ # return if authority does not exist
+ my $authtypecodefrom = AUTHfind_authtypecode($dbh,$mergefrom);
+ my @X = $MARCfrom->fields();
+ return if $#X == -1;
+ unless ($noconfirm) {
+ print "************\n";
+ print "You will delete authority : $mergefrom \n".$MARCfrom->as_formatted;
+ print "\n*************\n";
+ print "\n\nDo you confirm (enter YES)?";
+ my $confirm = <STDIN>;
+ chop $confirm;
+ unless (uc($confirm) eq 'YES') {
+ print "Deletion cancelled\n";
+ exit;
+ }
+ }
+ print "Deleting\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 "Deleting authority tag $auth_tag_to_report :\n" if $verbose;
+ 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
+ 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');
+ 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