From 3920ca325879430afb7c1e3d70151ae984a90567 Mon Sep 17 00:00:00 2001 From: tipaul Date: Thu, 2 Feb 2006 16:02:39 +0000 Subject: [PATCH] 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. --- misc/check_suggestions.pl | 112 ++++++++++++++++++++++++++++++ misc/delete_authority.pl | 139 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 251 insertions(+) create mode 100755 misc/check_suggestions.pl create mode 100644 misc/delete_authority.pl diff --git a/misc/check_suggestions.pl b/misc/check_suggestions.pl new file mode 100755 index 0000000000..2de6d792b8 --- /dev/null +++ b/misc/check_suggestions.pl @@ -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@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($_ = ); + 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 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/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; diff --git a/misc/delete_authority.pl b/misc/delete_authority.pl new file mode 100644 index 0000000000..d957fe80af --- /dev/null +++ b/misc/delete_authority.pl @@ -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 <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 = ; + 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 -- 2.39.5