Merge remote-tracking branch 'origin/new/bug_9053' into 3.10.x
This commit is contained in:
Paul Poulain
commit
dcfde3f38f
|
|
@ -576,12 +576,12 @@ our $PERL_DEPS = {
|
|||
},
|
||||
'DBD::Mock' => {
|
||||
'usage' => 'Core',
|
||||
'required' => '0',
|
||||
'required' => '1',
|
||||
'min_ver' => '1.39'
|
||||
},
|
||||
'Test::MockModule' => {
|
||||
'usage' => 'Core',
|
||||
'required' => '0',
|
||||
'required' => '1',
|
||||
'min_ver' => '0.05',
|
||||
},
|
||||
'Test::Warn' => {
|
||||
|
|
|
|||
|
|
@ -440,6 +440,7 @@ my %default_values_for_mod_from_marc = (
|
|||
booksellerid => undef,
|
||||
ccode => undef,
|
||||
'items.cn_source' => undef,
|
||||
coded_location_qualifier => undef,
|
||||
copynumber => undef,
|
||||
damaged => 0,
|
||||
# dateaccessioned => undef,
|
||||
|
|
@ -2077,6 +2078,7 @@ sub _koha_new_item {
|
|||
itemlost = ?,
|
||||
wthdrawn = ?,
|
||||
itemcallnumber = ?,
|
||||
coded_location_qualifier = ?,
|
||||
restricted = ?,
|
||||
itemnotes = ?,
|
||||
holdingbranch = ?,
|
||||
|
|
@ -2118,6 +2120,7 @@ sub _koha_new_item {
|
|||
$item->{'itemlost'},
|
||||
$item->{'wthdrawn'},
|
||||
$item->{'itemcallnumber'},
|
||||
$item->{'coded_location_qualifier'},
|
||||
$item->{'restricted'},
|
||||
$item->{'itemnotes'},
|
||||
$item->{'holdingbranch'},
|
||||
|
|
|
|||
|
|
@ -1799,7 +1799,7 @@ sub searchResults {
|
|||
else {
|
||||
|
||||
# item is on order
|
||||
if ( $item->{notforloan} == -1 ) {
|
||||
if ( $item->{notforloan} < 0 ) {
|
||||
$ordered_count++;
|
||||
}
|
||||
|
||||
|
|
@ -1837,7 +1837,7 @@ sub searchResults {
|
|||
if ( $item->{wthdrawn}
|
||||
|| $item->{itemlost}
|
||||
|| $item->{damaged}
|
||||
|| $item->{notforloan} > 0
|
||||
|| $item->{notforloan}
|
||||
|| $reservestatus eq 'Waiting'
|
||||
|| ($transfertwhen ne ''))
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1047,6 +1047,7 @@ CREATE TABLE `items` ( -- holdings/item information
|
|||
`itemlost` tinyint(1) NOT NULL default 0, -- authorized value defining this item as lost (MARC21 952$1)
|
||||
`wthdrawn` tinyint(1) NOT NULL default 0, -- authorized value defining this item as withdrawn (MARC21 952$0)
|
||||
`itemcallnumber` varchar(255) default NULL, -- call number for this item (MARC21 952$o)
|
||||
`coded_location_qualifier` varchar(10) default NULL, -- coded location qualifier(MARC21 952$f)
|
||||
`issues` smallint(6) default NULL, -- number of times this item has been checked out/issued
|
||||
`renewals` smallint(6) default NULL, -- number of times this item has been renewed
|
||||
`reserves` smallint(6) default NULL, -- number of times this item has been placed on hold/reserved
|
||||
|
|
|
|||
|
|
@ -6041,6 +6041,14 @@ if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
|
|||
SetVersion ($DBversion);
|
||||
}
|
||||
|
||||
$DBversion = "3.09.00.064";
|
||||
if (C4::Context->preference("Version") < TransformToNum($DBversion)) {
|
||||
$dbh->do('ALTER TABLE items ADD coded_location_qualifier varchar(10) default NULL');
|
||||
print "Upgrade to $DBversion done (Bug 6428: Added coded_location_qualifier to the items table)\n";
|
||||
SetVersion ($DBversion);
|
||||
}
|
||||
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 TableExists($table)
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ the kohaversion is divided in 4 parts :
|
|||
use strict;
|
||||
|
||||
sub kohaversion {
|
||||
our $VERSION = '3.09.00.063';
|
||||
our $VERSION = '3.09.00.064';
|
||||
# version needs to be set this way
|
||||
# so that it can be picked up by Makefile.PL
|
||||
# during install
|
||||
|
|
|
|||
|
|
@ -1,360 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# This script loops through each overdue item, determines the fine,
|
||||
# and updates the total amount of fines due by each user. It relies on
|
||||
# the existence of /tmp/fines, which is created by ???
|
||||
# Doesnt really rely on it, it relys on being able to write to /tmp/
|
||||
# It creates the fines file
|
||||
#
|
||||
# This script is meant to be run nightly out of cron.
|
||||
|
||||
# Copyright 2000-2002 Katipo Communications
|
||||
#
|
||||
# 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.,
|
||||
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||
|
||||
# $Id: sendoverdues.pl,v 1.1.2.1 2007/03/26 22:38:09 tgarip1957 Exp $
|
||||
|
||||
#use strict;
|
||||
#use warnings; FIXME - Bug 2505
|
||||
|
||||
BEGIN {
|
||||
# find Koha's Perl modules
|
||||
# test carefully before changing this
|
||||
use FindBin;
|
||||
eval { require "$FindBin::Bin/../kohalib.pl" };
|
||||
}
|
||||
|
||||
use C4::Context;
|
||||
use C4::Search;
|
||||
use C4::Circulation;
|
||||
use C4::Members;
|
||||
use C4::Dates qw/format_date/;
|
||||
use HTML::Template::Pro;
|
||||
use Mail::Sendmail;
|
||||
use Mail::RFC822::Address;
|
||||
use C4::SMS;
|
||||
use Carp;
|
||||
use utf8;
|
||||
my ($res,$ua);##variables for SMS
|
||||
|
||||
my $date=get_today();
|
||||
my $dbh = C4::Context->dbh;
|
||||
|
||||
|
||||
|
||||
notifyOverdues();
|
||||
|
||||
sub notifyOverdues {
|
||||
# Look up the overdues for today.
|
||||
# Capture overdues which fall on our dates of interest.
|
||||
|
||||
####################################################################################################
|
||||
# Creating a big hash of available templates
|
||||
my %email;
|
||||
%email->{'template'}='email-2.txt';
|
||||
my %sms;
|
||||
%sms->{'template'}='sms-2.txt';
|
||||
|
||||
|
||||
my %firstReminder->{'email'} = \%email;
|
||||
%firstReminder->{'sms'} = \%sms;
|
||||
|
||||
my %email2;
|
||||
%email2->{'template'}='email-7.txt';
|
||||
my %secondReminder->{'email'} = \%email2;
|
||||
my %sms2;
|
||||
%sms2->{'template'}='sms-7.txt';
|
||||
%secondReminder->{'sms'} = \%sms2;
|
||||
my %letter2;
|
||||
%letter2->{'template'}='letter-7.html';
|
||||
%secondReminder->{'letter'} = \%letter2;
|
||||
|
||||
|
||||
my %email3;
|
||||
%email3->{'template'}='email-29.txt';
|
||||
my %sms3;
|
||||
%sms3->{'template'}='sms-29.txt';
|
||||
my %letter3;
|
||||
%letter3->{'template'}='letter-29.html';
|
||||
|
||||
my %finalReminder->{'email'} = \%email3;
|
||||
%finalReminder->{'letter'} = \%letter3;
|
||||
%finalReminder->{'sms'} = \%sms3;
|
||||
|
||||
my %actions;
|
||||
%actions->{'1'}=\%firstReminder;
|
||||
%actions->{'3'}=\%secondReminder;###This was 7 days changed to 3 days
|
||||
%actions->{'20'}=\%finalReminder;###This was 29 days changed to 20 days
|
||||
|
||||
##################################################################################################################
|
||||
my @overdues2;#an array for each actiondate
|
||||
my @overdues7;
|
||||
my @overdues29;
|
||||
my $filename;
|
||||
|
||||
|
||||
|
||||
# Retrieve an array of overdues.
|
||||
my ($count, $overduesReference) = Getoverdues();
|
||||
my @overdues=@$overduesReference;
|
||||
|
||||
|
||||
# We're going to build a hash of arrays, containing the items requiring action.
|
||||
# ->borrowernumber, date, @overdues
|
||||
my %actionItems;
|
||||
|
||||
|
||||
foreach my $overdue (@overdues) {
|
||||
my $due_day=$overdue->{'date_due'};
|
||||
|
||||
my $difference=DATE_subtract($date,$due_day);
|
||||
# If does this item fall on a day of interest?
|
||||
$overdue->{'difference'}=$difference;
|
||||
foreach my $actiondate (keys(%actions)) {
|
||||
if ($actiondate == $difference) {
|
||||
$filename='overdues'.$actiondate;
|
||||
push @$$filename,$overdue;
|
||||
#print "$actiondate,-,$overdue->{borrowernumber}\n";
|
||||
}
|
||||
$actionItems{$actiondate} = \@$$filename;
|
||||
}
|
||||
}
|
||||
|
||||
# We now have a hash containing overdues which need actioning, we can step through each set.
|
||||
# Work from earilest to latest. We only wish to send the most urgent message.
|
||||
my %messages;
|
||||
my %borritem;
|
||||
|
||||
foreach my $actiondate (keys %actions) {
|
||||
# print "\n\nThe following items are $actiondate days overdue.\n";
|
||||
my $items = $actionItems{$actiondate};
|
||||
$filename='overdues'.$actiondate;
|
||||
foreach my $overdue (@$$filename) {
|
||||
# Detemine which borrower is responsible for this overdue;
|
||||
# if the offender is a child, then the guarantor is the person to notify
|
||||
my $borrowernumber=$overdue->{borrowernumber};
|
||||
|
||||
my $borrower=responsibleBorrower($borrowernumber);
|
||||
my ($method, $address) = preferedContactMethod($borrower);
|
||||
if ($method && $address) {
|
||||
|
||||
# Do we have to send something, using this method on this day?
|
||||
if (%actions->{$actiondate}->{$method}->{'template'}) {
|
||||
my $intranetdir=C4::Context->config('intranetdir');
|
||||
# Template the message
|
||||
my $template = HTML::Template::Pro->new(filename => $intranetdir.'/scripts/misc/notifys/templates/'.%actions->{$actiondate}->{$method}->{'template'}, die_on_bad_params => 0);
|
||||
my @bookdetails;
|
||||
my %row_data;
|
||||
my $item = getiteminformation("", $overdue->{'itemnumber'});
|
||||
$row_data{'BARCODE'}=$item->{'barcode'};
|
||||
|
||||
my $title=substr($item->{'title'},0,25)."...";
|
||||
|
||||
$title=changecharacter($title);
|
||||
$row_data{'TITLE'}=$title;
|
||||
$row_data{'DATE_DUE'}=format_date($overdue->{'date_due'});
|
||||
$row_data{'cardnumber'}=$borrower->{'cardnumber'};
|
||||
push(@bookdetails, \%row_data);
|
||||
$template->param(BOOKDETAILS => \@bookdetails);
|
||||
my $name= "$borrower->{'firstname'} $borrower->{'surname'}";
|
||||
$template->param(NAME=> $name);
|
||||
%messages->{$borrower->{'borrowernumber'}} = $template->output();
|
||||
if ($method eq 'email') {
|
||||
$result = sendEmail($address, 'library@library.neu.edu.tr', 'Overdue Library Items', %messages->{$borrowernumber});
|
||||
logContact($borrowernumber, $method, $address, $result, %messages->{$borrowernumber});
|
||||
}
|
||||
elsif ($method eq 'sms') {
|
||||
$result = sendSMS($address, %messages->{$borrowernumber});
|
||||
logContact($borrowernumber, $method, $address, $result, %messages->{$borrowernumber});
|
||||
}
|
||||
elsif ($method eq 'letter') {
|
||||
$result = printLetter($address, %messages->{$borrowernumber});
|
||||
}
|
||||
}##template exists
|
||||
}else{
|
||||
print "$borrowernumber has an overdue item, but no means of contact\n";
|
||||
}##$method
|
||||
|
||||
|
||||
} #end of 'foreach overdue'
|
||||
|
||||
} # end of foreach actiondate
|
||||
}
|
||||
|
||||
sub responsibleBorrower {
|
||||
# Given an overdue item, return the details of the borrower responible as a hash of database columns.
|
||||
my $borrowernumber=shift;
|
||||
|
||||
if ($borrowernumber) {
|
||||
my $borrower=BorType($borrowernumber);
|
||||
# Overdue books assigned to children have notices sent to the guarantor.
|
||||
if ($borrower->{'categorycode'} eq 'C') {
|
||||
my $guarantor=BorType($borrower->{'guarantor'});
|
||||
$borrower = $guarantor;
|
||||
}
|
||||
|
||||
return $borrower;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
sub preferedContactMethod {
|
||||
# Given a reference to borrower details, in the format
|
||||
# returned by BorType(), determine the prefered contact method, and address to use.
|
||||
my $borrower=$_[0];
|
||||
my $borrcat = getborrowercategoryinfo($borrower->{'categorycode'});
|
||||
if( !$borrcat->{'overduenoticerequired'}){
|
||||
return (undef,undef);
|
||||
}
|
||||
my $method='';
|
||||
my $address='';
|
||||
## if borrower has a phone set that as our preferrred contact
|
||||
if ($borrower->{'phoneday'}) {
|
||||
if (parse_phone($borrower->{phoneday})){
|
||||
$address = parse_phone($borrower->{phoneday});
|
||||
$method="sms";
|
||||
return ($method, $address);
|
||||
}
|
||||
}
|
||||
|
||||
if (($borrower->{'emailaddress'}) and (Mail::RFC822::Address::valid($borrower->{'emailaddress'}))) {
|
||||
$address = $borrower->{'emailaddress'};
|
||||
$method="email";
|
||||
return ($method, $address);
|
||||
}
|
||||
|
||||
if ($borrower->{'streetaddress'}) {
|
||||
$address = mailingAddress($borrower);
|
||||
$method = 'letter';
|
||||
}
|
||||
#print "$method, $address\n";
|
||||
return ($method, $address);
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
sub logContact {
|
||||
# Given the details of an attempt to contact a borrower,
|
||||
# log them in the attempted_contacts table of the koha database.
|
||||
my ($borrowernumber, $method, $address, $result, $message) = @_;
|
||||
|
||||
my $querystring = " insert into attempted_contacts
|
||||
(borrowernumber, method, address, result, message, date)
|
||||
values (?, ?, ?, ?, ?, now())";
|
||||
my $sth= $dbh->prepare($querystring);
|
||||
$sth->execute($borrowernumber, $method, $address, $result, $message);
|
||||
$sth->finish();
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
sub mailingAddress {
|
||||
# Given a hash of borrower information, such as that returned by BorType,
|
||||
# return a mailing address.
|
||||
my $borrower=$_[0];
|
||||
|
||||
my $address = $borrower->{'firstname'}."\n".
|
||||
$borrower->{'streetaddress'}."\n".
|
||||
$borrower->{'streetcity'};
|
||||
|
||||
return $address;
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub sendEmail {
|
||||
# Given an email address, and a subject and message, attempt to send email.
|
||||
|
||||
my $to=$_[0];
|
||||
my $from=$_[1];
|
||||
my $subject=$_[2];
|
||||
my $message=$_[3];
|
||||
# print "in email area";
|
||||
|
||||
# print "\nSending Email To: $to\n$message\n";
|
||||
|
||||
my %mail = ( To => $to,
|
||||
CC => 'library@library.neu.edu.tr',
|
||||
From => $from,
|
||||
Subject => $subject,
|
||||
Message => $message);
|
||||
|
||||
|
||||
if (not(sendmail %mail)) {
|
||||
carp "sendEmail to $to failed: " . $Mail::Sendmail::error;
|
||||
return 0;
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
sub sendSMS {
|
||||
my ($phone, $message)=@_;
|
||||
($res,$ua)=get_sms_auth() unless $res;
|
||||
# Given a cell number and a message, attempt to send an SMS message.
|
||||
my $sendresult=send_sms($ua,$phone,$message,$res->{pSessionId});
|
||||
my $error=error_codes($sendresult->{pErrCode});
|
||||
return 1 unless $error;
|
||||
return $error;
|
||||
}
|
||||
|
||||
|
||||
sub printLetter {
|
||||
print "letter\n";
|
||||
# Print a letter
|
||||
# FIXME - decide where to print
|
||||
return 1;
|
||||
}
|
||||
sub changecharacter {
|
||||
my ($string)=@_;
|
||||
$_=$string;
|
||||
|
||||
s/ş/s/g;
|
||||
s/Ş/S/g;
|
||||
s/ü/u/g;
|
||||
s/Ü/U/g;
|
||||
s/ç/c/g;
|
||||
s/Ç/C/g;
|
||||
s/ö/o/g;
|
||||
s/Ö/O/g;
|
||||
s/ı/i/g;
|
||||
s/İ/I/g;
|
||||
s/ğ/g/g;
|
||||
s/Ğ/G/g;
|
||||
$string=$_;
|
||||
return $string;
|
||||
}
|
||||
$dbh->disconnect();
|
||||
|
||||
Loading…
Reference in New Issue