patches from paul
This commit is contained in:
Joshua Ferraro
parent
2e4a11773c
commit
e9ae8c0686
|
|
@ -0,0 +1,380 @@
|
|||
package C4::Z3950;
|
||||
|
||||
# $Id$
|
||||
|
||||
# Routines for handling Z39.50 lookups
|
||||
|
||||
# Koha library project www.koha.org
|
||||
|
||||
# Licensed under the GPL
|
||||
|
||||
|
||||
# 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., 59 Temple Place,
|
||||
# Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
use strict;
|
||||
|
||||
# standard or CPAN modules used
|
||||
use DBI;
|
||||
|
||||
# Koha modules used
|
||||
use C4::Input;
|
||||
use C4::Biblio;
|
||||
|
||||
#------------------
|
||||
|
||||
require Exporter;
|
||||
|
||||
use vars qw($VERSION @ISA @EXPORT);
|
||||
|
||||
# set the version for version checking
|
||||
$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
|
||||
|
||||
=head1 NAME
|
||||
|
||||
C4::Z3950 - Functions dealing with Z39.50 queries
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use C4::Z3950;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module contains functions for looking up Z39.50 servers, and for
|
||||
entering Z39.50 lookup requests.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=over 2
|
||||
|
||||
=cut
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(
|
||||
&getz3950servers
|
||||
&z3950servername
|
||||
&addz3950queue
|
||||
&checkz3950searchdone
|
||||
);
|
||||
|
||||
#------------------------------------------------
|
||||
=item getz3950servers
|
||||
|
||||
@servers= &getz3950servers(checked);
|
||||
|
||||
Returns the list of declared z3950 servers
|
||||
|
||||
C<$checked> should always be true (1) => returns only active servers.
|
||||
If 0 => returns all servers
|
||||
|
||||
=cut
|
||||
sub getz3950servers {
|
||||
my ($checked) = @_;
|
||||
my $dbh = C4::Context->dbh;
|
||||
my $sth;
|
||||
if ($checked) {
|
||||
$sth = $dbh->prepare("select * from z3950servers where checked=1");
|
||||
} else {
|
||||
$sth = $dbh->prepare("select * from z3950servers");
|
||||
}
|
||||
my @result;
|
||||
while ( my ($host, $port, $db, $userid, $password,$servername) = $sth->fetchrow ) {
|
||||
push @result, "$servername/$host\:$port/$db/$userid/$password";
|
||||
} # while
|
||||
return @result;
|
||||
}
|
||||
|
||||
=item z3950servername
|
||||
|
||||
$name = &z3950servername($dbh, $server_id, $default_name);
|
||||
|
||||
Looks up a Z39.50 server by ID number, and returns its full name. If
|
||||
the server is not found, returns C<$default_name>.
|
||||
|
||||
C<$server_id> is the Z39.50 server ID to look up.
|
||||
|
||||
C<$dbh> is ignored.
|
||||
|
||||
=cut
|
||||
#'
|
||||
|
||||
sub z3950servername {
|
||||
# inputs
|
||||
my ($srvid, # server id number
|
||||
$default,)=@_;
|
||||
# return
|
||||
my $longname;
|
||||
#----
|
||||
|
||||
my $dbh = C4::Context->dbh;
|
||||
|
||||
my $sti=$dbh->prepare("select name from z3950servers where id=?");
|
||||
|
||||
$sti->execute($srvid);
|
||||
if ( ! $sti->err ) {
|
||||
($longname)=$sti->fetchrow;
|
||||
}
|
||||
if (! $longname) {
|
||||
$longname="$default";
|
||||
}
|
||||
return $longname;
|
||||
} # sub z3950servername
|
||||
|
||||
#---------------------------------------
|
||||
|
||||
=item addz3950queue
|
||||
|
||||
$errmsg = &addz3950queue($query, $type, $request_id, @servers);
|
||||
|
||||
Adds a Z39.50 search query for the Z39.50 server to look up.
|
||||
|
||||
C<$query> is the term to search for.
|
||||
|
||||
C<$type> is the query type, e.g. C<isbn>, C<lccn>, etc.
|
||||
|
||||
C<$request_id> is a unique string that will identify this query.
|
||||
|
||||
C<@servers> is a list of servers to query (obviously, this can be
|
||||
given either as an array, or as a list of scalars). Each element may
|
||||
be either a Z39.50 server ID from the z3950server table of the Koha
|
||||
database, the string C<DEFAULT> or C<CHECKED>, or a complete server
|
||||
specification containing a colon.
|
||||
|
||||
C<DEFAULT> and C<CHECKED> are synonymous, and refer to those servers
|
||||
in the z3950servers table whose 'checked' field is set and non-NULL.
|
||||
|
||||
Once the query has been submitted to the Z39.50 daemon,
|
||||
C<&addz3950queue> sends a SIGHUP to the daemon to tell it to process
|
||||
this new request.
|
||||
|
||||
C<&addz3950queue> returns an error message. If it was successful, the
|
||||
error message is the empty string.
|
||||
|
||||
=cut
|
||||
#'
|
||||
sub addz3950queue {
|
||||
use strict;
|
||||
# input
|
||||
my (
|
||||
$query, # value to look up
|
||||
$type, # type of value ("isbn", "lccn", "title", "author", "keyword")
|
||||
$requestid, # Unique value to prevent duplicate searches from multiple HTML form submits
|
||||
@z3950list, # list of z3950 servers to query
|
||||
)=@_;
|
||||
# Returns:
|
||||
my $error;
|
||||
|
||||
my (
|
||||
$sth,
|
||||
@serverlist,
|
||||
$server,
|
||||
$failed,
|
||||
$servername,
|
||||
);
|
||||
|
||||
# FIXME - Should be configurable, probably in /etc/koha.conf.
|
||||
my $pidfile='/var/log/koha/processz3950queue.pid';
|
||||
|
||||
$error="";
|
||||
|
||||
my $dbh = C4::Context->dbh;
|
||||
# list of servers: entry can be a fully qualified URL-type entry
|
||||
# or simply just a server ID number.
|
||||
foreach $server (@z3950list) {
|
||||
if ($server =~ /:/ ) {
|
||||
push @serverlist, $server;
|
||||
} elsif ($server eq 'DEFAULT' || $server eq 'CHECKED' ) {
|
||||
$sth=$dbh->prepare("select host,port,db,userid,password ,name,syntax from z3950servers where checked <> 0 ");
|
||||
$sth->execute;
|
||||
while ( my ($host, $port, $db, $userid, $password,$servername,$syntax) = $sth->fetchrow ) {
|
||||
push @serverlist, "$servername/$host\:$port/$db/$userid/$password/$syntax";
|
||||
} # while
|
||||
} else {
|
||||
$sth=$dbh->prepare("select host,port,db,userid,password,syntax from z3950servers where id=? ");
|
||||
$sth->execute($server);
|
||||
my ($host, $port, $db, $userid, $password,$syntax) = $sth->fetchrow;
|
||||
push @serverlist, "$server/$host\:$port/$db/$userid/$password/$syntax";
|
||||
}
|
||||
}
|
||||
|
||||
my $serverlist='';
|
||||
|
||||
$serverlist = join("|", @serverlist);
|
||||
# chop $serverlist;
|
||||
|
||||
# FIXME - Is this test supposed to test whether @serverlist is
|
||||
# empty? If so, then a) there are better ways to do that in
|
||||
# Perl (e.g., "if (@serverlist eq ())"), and b) it doesn't
|
||||
# work anyway, since it checks whether $serverlist is composed
|
||||
# of one or more spaces, which is never the case, not even
|
||||
# when there are 0 or 1 elements in @serverlist.
|
||||
if ( $serverlist !~ /^ +$/ ) {
|
||||
# Don't allow reinsertion of the same request identifier.
|
||||
$sth=$dbh->prepare("select identifier from z3950queue
|
||||
where identifier=?");
|
||||
$sth->execute($requestid);
|
||||
if ( ! $sth->rows) {
|
||||
$sth=$dbh->prepare("insert into z3950queue (term,type,servers, identifier) values (?, ?, ?, ?)");
|
||||
$sth->execute($query, $type, $serverlist, $requestid);
|
||||
if ( -r $pidfile ) {
|
||||
# FIXME - Perl is good at opening files. No need to
|
||||
# spawn a separate 'cat' process.
|
||||
my $pid=`cat $pidfile`;
|
||||
chomp $pid;
|
||||
warn "PID : $pid";
|
||||
# Kill -HUP the Z39.50 daemon to tell it to process
|
||||
# this query.
|
||||
my $processcount=kill 1, $pid;
|
||||
if ($processcount==0) {
|
||||
$error.="Z39.50 search daemon error: no process signalled. ";
|
||||
}
|
||||
} else {
|
||||
# FIXME - Error-checking like this should go close
|
||||
# to the test.
|
||||
$error.="No Z39.50 search daemon running: no file $pidfile. ";
|
||||
} # if $pidfile
|
||||
} else {
|
||||
# FIXME - Error-checking like this should go close
|
||||
# to the test.
|
||||
$error.="Duplicate request ID $requestid. ";
|
||||
} # if rows
|
||||
} else {
|
||||
# FIXME - Error-checking like this should go close to the
|
||||
# test. I.e.,
|
||||
# return "No Z39.50 search servers specified. "
|
||||
# if @serverlist eq ();
|
||||
|
||||
# server list is empty
|
||||
$error.="No Z39.50 search servers specified. ";
|
||||
} # if serverlist empty
|
||||
|
||||
return $error;
|
||||
|
||||
} # sub addz3950queue
|
||||
|
||||
=item &checkz3950searchdone
|
||||
|
||||
$numberpending= & &checkz3950searchdone($random);
|
||||
|
||||
Returns the number of pending z3950 requests
|
||||
|
||||
C<$random> is the random z3950 query number.
|
||||
|
||||
=cut
|
||||
sub checkz3950searchdone {
|
||||
my ($z3950random) = @_;
|
||||
my $dbh = C4::Context->dbh;
|
||||
# first, check that the deamon already created the requests...
|
||||
my $sth = $dbh->prepare("select count(*) from z3950queue,z3950results where z3950queue.id = z3950results.queryid and z3950queue.identifier=?");
|
||||
$sth->execute($z3950random);
|
||||
my ($result) = $sth->fetchrow;
|
||||
if ($result eq 0) { # search not yet begun => should be searches to do !
|
||||
return "??";
|
||||
}
|
||||
# second, count pending requests
|
||||
$sth = $dbh->prepare("select count(*) from z3950queue,z3950results where z3950queue.id = z3950results.queryid and z3950results.enddate is null and z3950queue.identifier=?");
|
||||
$sth->execute($z3950random);
|
||||
($result) = $sth->fetchrow;
|
||||
return $result;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Koha Developement team <info@koha.org>
|
||||
|
||||
=cut
|
||||
|
||||
#--------------------------------------
|
||||
# $Log$
|
||||
# Revision 1.14 2007/03/09 14:31:47 tipaul
|
||||
# rel_3_0 moved to HEAD
|
||||
#
|
||||
# Revision 1.10.10.1 2006/12/22 15:09:54 toins
|
||||
# removing C4::Database;
|
||||
#
|
||||
# Revision 1.10 2003/10/01 15:08:14 tipaul
|
||||
# fix fog bug #622 : processz3950queue fails
|
||||
#
|
||||
# Revision 1.9 2003/04/29 16:50:51 tipaul
|
||||
# really proud of this commit :-)
|
||||
# z3950 search and import seems to works fine.
|
||||
# Let me explain how :
|
||||
# * a "search z3950" button is added in the addbiblio template.
|
||||
# * when clicked, a popup appears and z3950/search.pl is called
|
||||
# * z3950/search.pl calls addz3950search in the DB
|
||||
# * the z3950 daemon retrieve the records and stores them in z3950results AND in marc_breeding table.
|
||||
# * as long as there as searches pending, the popup auto refresh every 2 seconds, and says how many searches are pending.
|
||||
# * when the user clicks on a z3950 result => the parent popup is called with the requested biblio, and auto-filled
|
||||
#
|
||||
# Note :
|
||||
# * character encoding support : (It's a nightmare...) In the z3950servers table, a "encoding" column has been added. You can put "UNIMARC" or "USMARC" in this column. Depending on this, the char_decode in C4::Biblio.pm replaces marc-char-encode by an iso 8859-1 encoding. Note that in the breeding import this value has been added too, for a better support.
|
||||
# * the marc_breeding and z3950* tables have been modified : they have an encoding column and the random z3950 number is stored too for convenience => it's the key I use to list only requested biblios in the popup.
|
||||
#
|
||||
# Revision 1.8 2003/04/29 08:09:45 tipaul
|
||||
# z3950 support is coming...
|
||||
# * adding a syntax column in z3950 table = this column will say wether the z3950 must be called with PerferedRecordsyntax => USMARC or PerferedRecordsyntax => UNIMARC. I tried some french UNIMARC z3950 servers, and some only send USMARC, some only UNIMARC, some can answer with both.
|
||||
# Note this is a 1st draft. More to follow (today ? I hope).
|
||||
#
|
||||
# Revision 1.7 2003/02/19 01:01:06 wolfpac444
|
||||
# Removed the unecessary $dbh argument from being passed.
|
||||
# Resolved a few minor FIXMEs.
|
||||
#
|
||||
# Revision 1.6 2002/10/13 08:30:53 arensb
|
||||
# Deleted unused variables.
|
||||
# Removed trailing whitespace.
|
||||
#
|
||||
# Revision 1.5 2002/10/13 06:13:23 arensb
|
||||
# Removed bogus #! line (this isn't a script!)
|
||||
# Removed unused global variables.
|
||||
# Added POD.
|
||||
# Added some explanatory comments.
|
||||
# Added some FIXME comments.
|
||||
#
|
||||
# Revision 1.4 2002/10/11 12:35:35 arensb
|
||||
# Replaced &requireDBI with C4::Context->dbh
|
||||
#
|
||||
# Revision 1.3 2002/08/14 18:12:52 tonnesen
|
||||
# Added copyright statement to all .pl and .pm files
|
||||
#
|
||||
# Revision 1.2 2002/07/02 20:31:33 tonnesen
|
||||
# module added from rel-1-2 branch
|
||||
#
|
||||
# Revision 1.1.2.5 2002/06/29 17:33:47 amillar
|
||||
# Allow DEFAULT as input to addz3950search.
|
||||
# Check for existence of pid file (cat crashed otherwise).
|
||||
# Return error messages in addz3950search.
|
||||
#
|
||||
# Revision 1.1.2.4 2002/06/28 18:07:27 tonnesen
|
||||
# marcimport.pl will print an error message if it can not signal the
|
||||
# processz3950queue program. The message contains instructions for starting the
|
||||
# daemon.
|
||||
#
|
||||
# Revision 1.1.2.3 2002/06/28 17:45:39 tonnesen
|
||||
# z3950queue now listens for a -HUP signal before processing the queue. Z3950.pm
|
||||
# sends the -HUP signal when queries are added to the queue.
|
||||
#
|
||||
# Revision 1.1.2.2 2002/06/26 20:54:31 tonnesen
|
||||
# use warnings breaks on perl 5.005...
|
||||
#
|
||||
# Revision 1.1.2.1 2002/06/26 07:26:41 amillar
|
||||
# New module for Z39.50 searching
|
||||
#
|
||||
3
about.pl
3
about.pl
|
|
@ -1,4 +1,4 @@
|
|||
<EFBFBD>#!/usr/bin/perl
|
||||
ö#!/usr/bin/perl
|
||||
|
||||
# This file is part of Koha.
|
||||
#
|
||||
|
|
@ -43,7 +43,6 @@ my $perlVersion = $];
|
|||
my $mysqlVersion = `mysql -V`;
|
||||
my $apacheVersion = `httpd -v`;
|
||||
$apacheVersion = `httpd2 -v` unless $apacheVersion;
|
||||
$apacheVersion = `apache2 -v` unless $apacheVersion; # path for ubuntu
|
||||
my $zebraVersion = `zebraidx -V`;
|
||||
|
||||
# $apacheVersion = (`/usr/sbin/apache2 -V`)[0];
|
||||
|
|
|
|||
|
|
@ -162,7 +162,7 @@ elsif ($op eq 'add_validate') {
|
|||
$input->param('branchcode')||''
|
||||
);
|
||||
}
|
||||
$input->redirect('/cgi-bin/koha/aqbookfund.pl');
|
||||
$input->redirect('aqbookfund.pl');
|
||||
# END $OP eq ADD_VALIDATE
|
||||
}
|
||||
################## DELETE_CONFIRM ##################################
|
||||
|
|
|
|||
|
|
@ -234,8 +234,8 @@ for ( my $tabloop = 0 ; $tabloop <= 10 ; $tabloop++ ) {
|
|||
$subfield_data{authority} = $fields[$x_i]->subfield(9);
|
||||
}
|
||||
$subfield_data{marc_value} =
|
||||
GetAuthorisedValueDesc( $fields[$x_i]->tag(),
|
||||
$subf[$i][0], $subf[$i][1], '', $tagslib );
|
||||
get_authorised_value_desc( $tagslib, $fields[$x_i]->tag(),
|
||||
$subf[$i][0], $subf[$i][1], '', $dbh );
|
||||
}
|
||||
$subfield_data{marc_subfield} = $subf[$i][0];
|
||||
$subfield_data{marc_tag} = $fields[$x_i]->tag();
|
||||
|
|
|
|||
|
|
@ -82,8 +82,7 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
|
|||
$template->param( frameworkcode => $frameworkcode, );
|
||||
|
||||
if ( $op ne "do_search" ) {
|
||||
# FIXME : remove sql queries & put that in a specific package (Z3950.pm ?, but it's unused atm)
|
||||
my $sth = $dbh->prepare("SELECT id,host,checked FROM z3950servers ORDER by host");
|
||||
my $sth = $dbh->prepare("select id,host,checked from z3950servers order by host");
|
||||
$sth->execute();
|
||||
my $serverloop = $sth->fetchall_arrayref( {} );
|
||||
$template->param(
|
||||
|
|
|
|||
|
|
@ -117,7 +117,7 @@ while ( my $data = $sth->fetchrow_hashref ) {
|
|||
}
|
||||
|
||||
$template->param(
|
||||
todaysdate => format_date($todaysdate),
|
||||
todaysdate => $todaysdate,
|
||||
overdueloop => \@overduedata
|
||||
);
|
||||
|
||||
|
|
|
|||
|
|
@ -22,14 +22,14 @@
|
|||
<form action="" method="get" name="orderform">
|
||||
<table>
|
||||
<tr>
|
||||
<th>BASKET</th>
|
||||
<th>Summary</th>
|
||||
<th>QTY ordered</th>
|
||||
<th>Est Cost</th>
|
||||
<th>ACTUAL</th>
|
||||
<th>P&P</th>
|
||||
<th>QTY received</th>
|
||||
<th>TOTAL</th>
|
||||
<th class="acquisition">BASKET</th>
|
||||
<th class="acquisition">Summary</th>
|
||||
<th class="acquisition">QTY ordered</th>
|
||||
<th class="acquisition">Est Cost</th>
|
||||
<th class="acquisition">ACTUAL</th>
|
||||
<th class="acquisition">P&P</th>
|
||||
<th class="acquisition">QTY received</th>
|
||||
<th class="acquisition">TOTAL</th>
|
||||
</tr>
|
||||
<!-- TMPL_LOOP NAME="loop_received" -->
|
||||
<tr>
|
||||
|
|
@ -48,12 +48,12 @@
|
|||
</tr>
|
||||
<!-- /TMPL_LOOP -->
|
||||
<tr>
|
||||
<th colspan="3"></th>
|
||||
<th>SUBTOTALS</th>
|
||||
<th><!-- TMPL_VAR NAME="totalprice" --></th>
|
||||
<th><!-- TMPL_VAR NAME="totalfreight" --></th>
|
||||
<th><!-- TMPL_VAR NAME="totalquantity" --></th>
|
||||
<th><!-- TMPL_VAR NAME="tototal" --></th>
|
||||
<th class="acquisition" colspan="3"></th>
|
||||
<th class="acquisition">SUBTOTALS</th>
|
||||
<th class="acquisition"><!-- TMPL_VAR NAME="totalprice" --></th>
|
||||
<th class="acquisition"><!-- TMPL_VAR NAME="totalfreight" --></th>
|
||||
<th class="acquisition"><!-- TMPL_VAR NAME="totalquantity" --></th>
|
||||
<th class="acquisition"><!-- TMPL_VAR NAME="tototal" --></th>
|
||||
</tr>
|
||||
<tr>
|
||||
<td colspan="5">
|
||||
|
|
@ -82,13 +82,13 @@
|
|||
</form>
|
||||
<table> <caption>or select a pending orders</caption>
|
||||
<tr>
|
||||
<th>BASKET</th>
|
||||
<th>Summary</th>
|
||||
<th>QTY Ordered</th>
|
||||
<th>Est. Cost</th>
|
||||
<th>P&P</th>
|
||||
<th>QTY recieved</th>
|
||||
<th>TOTAL</th>
|
||||
<th class="acquisition">BASKET</th>
|
||||
<th class="acquisition">Summary</th>
|
||||
<th class="acquisition">Est. Cost</th>
|
||||
<th class="acquisition">P&P</th>
|
||||
<th class="acquisition">QTY Ordered</th>
|
||||
<th class="acquisition">QTY</th>
|
||||
<th class="acquisition">TOTAL</th>
|
||||
</tr>
|
||||
<!-- TMPL_LOOP NAME="loop_orders" -->
|
||||
<tr>
|
||||
|
|
@ -99,9 +99,9 @@
|
|||
<!-- TMPL_IF NAME="author" --><br />author :<!-- TMPL_VAR NAME="author" --><!--/TMPL_IF-->
|
||||
<!-- TMPL_IF NAME="publishercode" --><br />Publisher :<!-- TMPL_VAR NAME="publishercode" --><!--/TMPL_IF-->
|
||||
</td>
|
||||
<td><!-- TMPL_VAR NAME="quantity" --></td>
|
||||
<td><!-- TMPL_VAR NAME="unitprice" --></td>
|
||||
<td></td>
|
||||
<td><!-- TMPL_VAR NAME="quantity" --></td>
|
||||
<td><!-- TMPL_VAR NAME="quantityrecieved" --></td>
|
||||
<td><!-- TMPL_VAR NAME="ecost" --></td>
|
||||
</tr>
|
||||
|
|
|
|||
|
|
@ -31,7 +31,7 @@
|
|||
<input type="hidden" name="isbn" value="<!-- TMPL_VAR NAME="isbn" -->" />
|
||||
<input type="hidden" name="issn" value="<!-- TMPL_VAR NAME="issn" -->" />
|
||||
<input type="hidden" name="frameworkcode" value="<!-- TMPL_VAR NAME="frameworkcode" -->" />
|
||||
<input type="hidden" name="biblionumber" value="<!-- TMPL_VAR NAME="biblionumber" -->" />
|
||||
<input type="hidden" name="oldbiblionumber" value="<!-- TMPL_VAR NAME="oldbiblionumber" -->" />
|
||||
|
||||
<!-- TMPL_LOOP name="serverloop" -->
|
||||
<p>
|
||||
|
|
|
|||
|
|
@ -731,12 +731,12 @@ function check_input(e){
|
|||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><label>Librarian's notes</label></td>
|
||||
<td><textarea name="internalnotes" cols="30" rows="2"><!-- TMPL_VAR name="internalnotes" --></textarea></td>
|
||||
<td><label>Notes</label></td>
|
||||
<td><textarea name="notes" cols="30" rows="2"><!-- TMPL_VAR name="notes" --></textarea></td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td><label>OPAC's note</label></td>
|
||||
<td><textarea name="notes" cols="30" rows="2"><!-- TMPL_VAR name="notes" --></textarea></td>
|
||||
<td><label>Management Notes</label></td>
|
||||
<td><textarea name="internalnotes" cols="30" rows="2"><!-- TMPL_VAR name="internalnotes" --></textarea></td>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>Patron alert with </td>
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@
|
|||
<textarea name="new" cols="75" rows="10"><!-- TMPL_VAR NAME="new" --></textarea>
|
||||
<p>
|
||||
<input class="button" type="submit" value="Save" />
|
||||
<input class="button" type="button" value="Cancel" onclick="window.location.href='/cgi-bin/koha/tools/koha-news.pl'" />
|
||||
<input class="button" type="button" value="Cancel" onclick="window.location.href='/cgi-bin/koha/tools/opac-news.pl'" />
|
||||
</p>
|
||||
</form>
|
||||
<!-- TMPL_ELSE -->
|
||||
|
|
|
|||
|
|
@ -0,0 +1,23 @@
|
|||
<!-- TMPL_INCLUDE name="doc-head-open.inc" --><!-- TMPL_VAR NAME="LibraryName" --> Catalog -- Library Home for <!-- TMPL_LOOP name="BORROWER_INFO" --><!-- TMPL_VAR name="firstname" --> <!-- TMPL_VAR name="surname" --><!-- /TMPL_LOOP -->
|
||||
<!-- TMPL_INCLUDE name="doc-head-close.inc" -->
|
||||
|
||||
<!-- TMPL_INCLUDE name="masthead.inc" -->
|
||||
<!-- TMPL_INCLUDE name="navigation.inc" -->
|
||||
|
||||
<table>
|
||||
<!--TMPL_LOOP NAME="reviews"-->
|
||||
<tr>
|
||||
<th>
|
||||
<b><!--TMPL_VAR NAME="title"--></b>
|
||||
</th>
|
||||
</tr>
|
||||
<tr>
|
||||
<td>
|
||||
<!--TMPL_VAR NAME="review"-->
|
||||
<p><!--TMPL_VAR NAME="datereviewed"--></p>
|
||||
</td>
|
||||
</tr>
|
||||
<!--/TMPL_LOOP-->
|
||||
</table>
|
||||
|
||||
<!-- TMPL_INCLUDE NAME="opac-bottom.inc"-->
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
#!/usr/bin/perl
|
||||
# get_ratings.pl
|
||||
#
|
||||
# A script to fetch the ratings of a given title, using the isbn number
|
||||
# Initially just books, but ill expand to handle dvd's and cd's as well
|
||||
|
||||
# uses a new table, ratings, pipe the ratings.sql script into mysql to create the table.
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use HTTP::Cookies;
|
||||
use LWP::UserAgent;
|
||||
use C4::Context;
|
||||
|
||||
my $dbh = C4::Context->dbh();
|
||||
|
||||
my $query =
|
||||
"SELECT isbn,biblioitemnumber,biblionumber FROM biblioitems where isbn is NOT NULL and isbn <> ''
|
||||
group by isbn";
|
||||
my $sth = $dbh->prepare($query);
|
||||
$sth->execute();
|
||||
while ( my $data = $sth->fetchrow_hashref() ) {
|
||||
$data->{'isbn'} =~ s/\-//g;
|
||||
$data->{'isbn'} =~ s/ +//g;
|
||||
|
||||
# append isbn
|
||||
# isbn must appear without spaces or -
|
||||
my $url = "http://www.amazon.com/exec/obidos/search-handle-url/index%3Dbooks%26field-isbn%3D";
|
||||
$url .= $data->{'isbn'};
|
||||
my $ua = LWP::UserAgent->new;
|
||||
my $content = $ua->get($url)->content;
|
||||
|
||||
#print $content;
|
||||
|
||||
my $rating;
|
||||
|
||||
if ( $content =~ /alt="(.*?) out of 5 stars"/ ) {
|
||||
$rating = $1;
|
||||
|
||||
}
|
||||
if ($rating) {
|
||||
|
||||
# first check we dont already have a rating, if so, and its different update it
|
||||
# otherwise insert a new rating
|
||||
my $query2 = "SELECT * FROM ratings WHERE biblioitemnumber=?";
|
||||
my $sth2 = $dbh->prepare($query2);
|
||||
$sth2->execute( $data->{'biblioitemnumber'} );
|
||||
if ( my $ratings = $sth2->fetchrow_hashref() ) {
|
||||
if ( $rating ne $ratings->{'rating'} ) {
|
||||
my $query3 =
|
||||
"UPDATE ratings SET rating=? WHERE biblioitemnumber=?";
|
||||
my $sth3 = $dbh->prepare($query3);
|
||||
$sth3->execute( $rating, $data->{'biblioitemnumber'} );
|
||||
$sth3->finish();
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $query3 =
|
||||
"INSERT INTO ratings (rating,biblioitemnumber,biblionumber) VALUES (?,?,?)";
|
||||
my $sth3 = $dbh->prepare($query3);
|
||||
$sth3->execute(
|
||||
$rating, $data->{'biblioitemnumber'},
|
||||
$data->{'biblionumber'}
|
||||
);
|
||||
$sth3->finish();
|
||||
}
|
||||
$sth2->finish();
|
||||
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
-- MySQL dump 8.21
|
||||
--
|
||||
-- Host: localhost Database: Koha2
|
||||
---------------------------------------------------------
|
||||
-- Server version 3.23.49-log
|
||||
|
||||
--
|
||||
-- Table structure for table 'ratings'
|
||||
--
|
||||
|
||||
CREATE TABLE ratings (
|
||||
biblioitemnumber int(11) NOT NULL default '0',
|
||||
biblionumber int(11) default NULL,
|
||||
rating varchar(10) default NULL,
|
||||
modified timestamp(14) NOT NULL,
|
||||
PRIMARY KEY (biblioitemnumber)
|
||||
) TYPE=MyISAM;
|
||||
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
#!/usr/bin/perl
|
||||
#-----------------------------------
|
||||
# Script Name: reservelist.pl
|
||||
# Script Version: 1.0
|
||||
# Date: 2003/9/18
|
||||
# Author: Stephen Hedges shedges@skemotah.com
|
||||
# Description: produces a comma separated list of currently
|
||||
# available reserves, with item and borrower details
|
||||
# Usage: reservelist.pl.
|
||||
# Revision History:
|
||||
# 1.0 2003/9/18: original version
|
||||
# 1.1 2003/10/1: modified to load into a MySQL table
|
||||
#-----------------------------------
|
||||
|
||||
use lib '/usr/local/koha/intranet/modules/';
|
||||
|
||||
use strict;
|
||||
use C4::Context;
|
||||
use C4::Biblio;
|
||||
|
||||
my ($biblionumber,$barcode,$holdingbranch,$pickbranch,$notes,$cardnumber,$lastname,$firstname,$phone,$title,$callno,$rdate,$borrno);
|
||||
|
||||
my $dbh = C4::Context->dbh;
|
||||
|
||||
$dbh->do("DELETE FROM reservelist"); # clear the old table for new info
|
||||
|
||||
my $sth=$dbh->prepare("SELECT biblionumber,reserves.branchcode,reservenotes,borrowers.borrowernumber,cardnumber,surname,firstname,phone,reservedate FROM reserves,borrowers WHERE reserves.borrowernumber=borrowers.borrowernumber AND priority=1 AND cancellationdate IS NULL GROUP BY biblionumber");
|
||||
|
||||
my $sth_load=$dbh->prepare("INSERT INTO reservelist (biblionumber,barcode,lastname,firstname,phone,borrowernumber,cardnumber,reservedate,title,callno,holdingbranch,pickbranch,notes) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)");
|
||||
|
||||
$sth->execute(); # get the list of biblionumbers for unfilled reserves
|
||||
|
||||
GETIT: while (my $data=$sth->fetchrow_hashref){
|
||||
$biblionumber = $data->{'biblionumber'}; # get the basic reserve info
|
||||
$pickbranch = $data->{'branchcode'};
|
||||
$notes = $data->{'reservenotes'};
|
||||
$borrno = $data->{'borrowernumber'};
|
||||
$cardnumber = $data->{'cardnumber'};
|
||||
$lastname = $data->{'surname'};
|
||||
$firstname = $data->{'firstname'};
|
||||
$phone = $data->{'phone'};
|
||||
$rdate = $data->{'reservedate'};
|
||||
my @items = GetItemsInfo($biblionumber,''); # get the items for this biblio
|
||||
my @itemorder; # prepare a new array to hold re-ordered items
|
||||
|
||||
# The following lines take the retrieved items and run them through various
|
||||
# tests to decide if they are to be used and then put them in the preferred
|
||||
# 'pick' order.
|
||||
foreach my $itm (@items) {
|
||||
if ($itm->{"datedue"} eq "Reserved") { # is item ready for member?
|
||||
if ($itm->{'holdingbranch'} eq $pickbranch) {
|
||||
$itemorder[0]=$itm;
|
||||
} elsif ($itm->{'homebranch'} eq 'NPL') {
|
||||
$itemorder[1]=$itm;
|
||||
} elsif ($itm->{'homebranch'} eq 'CPL') {
|
||||
$itemorder[2]=$itm;
|
||||
} elsif ($itm->{'homebranch'} eq 'COV') {
|
||||
$itemorder[3]=$itm;
|
||||
} elsif ($itm->{'homebranch'} eq 'GPL') {
|
||||
$itemorder[4]=$itm;
|
||||
} elsif ($itm->{'homebranch'} eq 'ALB') {
|
||||
$itemorder[5]=$itm;
|
||||
} elsif ($itm->{'homebranch'} eq 'PPL') {
|
||||
$itemorder[6]=$itm;
|
||||
} elsif ($itm->{'homebranch'} eq 'APL') {
|
||||
$itemorder[7]=$itm;
|
||||
}
|
||||
}
|
||||
}
|
||||
my $count = @itemorder;
|
||||
next GETIT if $count<1; # if the re-ordered array is empty, skip to next
|
||||
PREP: foreach my $itmlist (@itemorder) {
|
||||
if ($itmlist) {
|
||||
$barcode = $itmlist->{'barcode'};
|
||||
$holdingbranch = $itmlist->{'holdingbranch'};
|
||||
$title = $itmlist->{'title'};
|
||||
$callno = $itmlist->{'classification'};
|
||||
last PREP; # we only want the first def item in the array
|
||||
}
|
||||
}
|
||||
$sth_load->execute($biblionumber,$barcode,$lastname,$firstname,$phone,$borrno,$cardnumber,$rdate,$title,$callno,$holdingbranch,$pickbranch,$notes);
|
||||
$sth_load->finish;
|
||||
}
|
||||
$sth->finish;
|
||||
$dbh->disconnect;
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
#!/usr/bin/perl
|
||||
use C4::Context;
|
||||
use C4::Biblio;
|
||||
|
||||
use strict;
|
||||
|
||||
my $Zconn=C4::Context->Zconn('biblioserver', 0, 1);
|
||||
my $Zpackage = $Zconn->package();
|
||||
$Zpackage->option(action => 'recordDelete');
|
||||
$Zpackage->option(record => '<?xml version="1.0" encoding="UTF-8"?>
|
||||
<record
|
||||
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
|
||||
xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/ standards/marcxml/schema/MARC21slim.xsd"
|
||||
xmlns="http://www.loc.gov/MARC21/slim">
|
||||
|
||||
<leader>00577 a2200193 4500</leader>
|
||||
<controlfield tag="005">19980415162006.0</controlfield>
|
||||
<datafield tag="035" ind1=" " ind2=" ">
|
||||
<subfield code="a">TOB*M*9074254</subfield>
|
||||
</datafield>
|
||||
<datafield tag="090" ind1=" " ind2=" ">
|
||||
<subfield code="9">8</subfield>
|
||||
<subfield code="a">8</subfield>
|
||||
</datafield>
|
||||
<datafield tag="100" ind1=" " ind2=" ">
|
||||
<subfield code="a">19910405d1976 y1frea0103 ba</subfield>
|
||||
</datafield>
|
||||
<datafield tag="101" ind1="0" ind2=" ">
|
||||
<subfield code="a">fre</subfield>
|
||||
</datafield>
|
||||
<datafield tag="200" ind1="1" ind2=" ">
|
||||
<subfield code="a">Lune vole fJacqueline Held, et Claude Held</subfield>
|
||||
<subfield code="g">illustrations d\' Yvan Pommaux</subfield>
|
||||
<subfield code="b">LIVR</subfield>
|
||||
</datafield>
|
||||
<datafield tag="210" ind1=" " ind2=" ">
|
||||
<subfield code="c">Ecole des loisirs</subfield>
|
||||
<subfield code="d">cop. 1976</subfield>
|
||||
</datafield>
|
||||
<datafield tag="215" ind1=" " ind2=" ">
|
||||
<subfield code="a">20p</subfield>
|
||||
</datafield>
|
||||
<datafield tag="225" ind1="0" ind2=" ">
|
||||
<subfield code="a">Chanterime</subfield>
|
||||
</datafield>
|
||||
<datafield tag="309" ind1=" " ind2=" ">
|
||||
<subfield code="a">Migration GEAC</subfield>
|
||||
</datafield>
|
||||
<datafield tag="700" ind1=" " ind2="1">
|
||||
<subfield code="a">Held</subfield>
|
||||
<subfield code="b">Jacqueline</subfield>
|
||||
<subfield code="9">187392</subfield>
|
||||
</datafield>
|
||||
<datafield tag="913" ind1="0" ind2="0">
|
||||
<subfield code="a">HELLVOL99000</subfield>
|
||||
</datafield>
|
||||
<datafield tag="949" ind1=" " ind2=" ">
|
||||
<subfield code="a">MIRMJE</subfield>
|
||||
<subfield code="a">ISTISP</subfield>
|
||||
</datafield>
|
||||
<datafield tag="995" ind1=" " ind2=" ">
|
||||
<subfield code="a">IST</subfield>
|
||||
<subfield code="c">IST</subfield>
|
||||
<subfield code="f">9991088063</subfield>
|
||||
<subfield code="k">P HEL</subfield>
|
||||
<subfield code="m">2004-06-22</subfield>
|
||||
<subfield code="v">2.9</subfield>
|
||||
<subfield code="r">LIVR</subfield>
|
||||
<subfield code="s">14</subfield>
|
||||
<subfield code="b">J</subfield>
|
||||
<subfield code="9">16</subfield>
|
||||
</datafield>
|
||||
</record>');
|
||||
$Zpackage->send("update");
|
||||
$Zpackage->send('commit');
|
||||
$Zpackage->destroy();
|
||||
$Zconn->destroy();
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
-- MySQL dump 9.08
|
||||
--
|
||||
-- Host: localhost Database: Koha
|
||||
---------------------------------------------------------
|
||||
-- Server version 4.0.13-log
|
||||
|
||||
--
|
||||
-- Table structure for table 'attempted_contacts'
|
||||
--
|
||||
|
||||
CREATE TABLE attempted_contacts (
|
||||
borrowernumber int(11) default NULL,
|
||||
method varchar(50) default NULL,
|
||||
address varchar(255) default NULL,
|
||||
result int(11) default NULL,
|
||||
message text,
|
||||
date datetime default NULL
|
||||
) TYPE=MyISAM;
|
||||
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# Display a history of attempts to contact this borrower
|
||||
# regarding overdues and fines.
|
||||
#
|
||||
# Tony McCrae
|
||||
# tony@katipo.co.nz 5/July/2003
|
||||
# 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., 59 Temple Place,
|
||||
# Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
|
||||
|
||||
use C4::Circulation;
|
||||
use C4::Overdues;
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
my $input = new CGI;
|
||||
my $borrowernumber = $input->param('borrowernumber');
|
||||
my $date= $input->param('date');
|
||||
my $edate=$input->param('edate');
|
||||
print $input->header;
|
||||
if ($borrowernumber) {
|
||||
my $borrower = BorType($borrowernumber);
|
||||
|
||||
|
||||
my $querystring = " select date, method, address, result, message, borrowernumber
|
||||
from attempted_contacts
|
||||
where date >= ? and date < ?
|
||||
";
|
||||
|
||||
|
||||
my $dbh=C4Connect();
|
||||
my $sth=$dbh->prepare($querystring);
|
||||
$sth->execute($date,$edate);
|
||||
|
||||
while (my $row=$sth->fetchrow_hashref()) {
|
||||
print "<a href=/cgi-bin/koha/moremember.pl?borrowernumber=$row->{'borrowernumber'}>Borrwer Record</a> ";
|
||||
if ($row->{'method'} ne 'email'){
|
||||
my $tidydate=$row->{'date'};
|
||||
$tidydate=~ s/ /%20/g;
|
||||
print " <a href=/cgi-bin/koha/printnote.pl?borrowernumber=$row->{'borrowernumber'}&date=$tidydate>Print Note</a><br>";
|
||||
}
|
||||
print $row->{'date'}."<br>\n";
|
||||
print $row->{'method'}."<br>\n";
|
||||
print $row->{'address'}."<br>\n";
|
||||
print $row->{'result'}."<br>\n";
|
||||
print $row->{'message'}."<br>\n";
|
||||
print "<p><p>";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,587 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# 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 C4::Members;
|
||||
use C4::Circulation;
|
||||
use C4::Overdues;
|
||||
use Date::Manip;
|
||||
|
||||
use Mail::Sendmail;
|
||||
use Mail::RFC822::Address;
|
||||
use C4::Biblio;
|
||||
use strict;
|
||||
|
||||
|
||||
#levyFines(); # Do not levy real fines in testing situation.
|
||||
notifyOverdues();
|
||||
|
||||
|
||||
|
||||
# Todo
|
||||
# - Need to calculate the fine on each book; no idea how to get this information from Koha
|
||||
# - Need to diffentricate between the total_fines including replacement costs,
|
||||
# and the total fines if the books are returned in the day 29 notices (see above).
|
||||
# - clean up the %actions hash creation code.
|
||||
|
||||
#Done
|
||||
# - preferedcont field in borrowers hash; does this do anything?
|
||||
# - logging
|
||||
# - which 'address' to send sms to?
|
||||
# - senders returning success or fail
|
||||
|
||||
|
||||
|
||||
sub levyFines {
|
||||
# Look at the current overdues, and levy fines on the offenders.
|
||||
# arguments:
|
||||
# $date
|
||||
# $maxfine
|
||||
|
||||
# Work out what today is as an integer value.
|
||||
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
|
||||
$mon++; $year=$year+1900;
|
||||
my $date=Date_DaysSince1BC($mon,$mday,$year);
|
||||
my $maxfine =5;
|
||||
|
||||
|
||||
# Retrieve an array of overdues.
|
||||
my ($count, $overduesReference) = Getoverdues();
|
||||
print "$count overdue items where found.\n\n";
|
||||
my @overdues=@$overduesReference;
|
||||
|
||||
foreach my $overdue (@overdues) {
|
||||
my @dates=split('-',$overdue->{'date_due'});
|
||||
my $due_day=Date_DaysSince1BC($dates[1],$dates[2],$dates[0]);
|
||||
|
||||
|
||||
# Check that the item is really overdue. The output of Getoverdues() will normally
|
||||
# always be overdue items. However, if you are running this script with a value of $date other than the current time, this check is needed.
|
||||
if ($due_day <= $date) {
|
||||
my $difference=$date-$due_day;
|
||||
print "Itemnumber ".$overdue->{'itemnumber'}." is issued to ".$overdue->{'borrowernumber'}." is overdue by $difference days.\n";
|
||||
|
||||
# Calculate the cost of this overdue.
|
||||
# Fines vary according to borrower type, but cannot exceed the maximum fine.
|
||||
print $overdue->{'borrowernumber'};
|
||||
my $borrower=BorType($overdue->{'borrowernumber'});
|
||||
|
||||
my ($amount,$type,$printout)=CalcFine($overdue->{'itemnumber'}, $borrower->{'categorycode'}, $difference);
|
||||
if ($amount > $maxfine){
|
||||
$amount=$maxfine;
|
||||
}
|
||||
|
||||
if ($amount > 0){
|
||||
my $due="$dates[2]/$dates[1]/$dates[0]";
|
||||
UpdateFine($overdue->{'itemnumber'}, $overdue->{'borrowernumber'}, $amount, $type, $due);
|
||||
print $overdue->{'borrowernumber'}." has been fined $amount for itemnumber ".$overdue->{'itemnumber'}." overdue for $difference days.\n";
|
||||
}
|
||||
|
||||
|
||||
|
||||
# After 28 days, the item is marked lost and the replacement charge is added as a fine
|
||||
if ($difference >= 28) {
|
||||
my $borrower=BorType($overdue->{'borrowernumber'});
|
||||
if ($borrower->{'cardnumber'} ne ''){
|
||||
my $cost=ReplacementCost($overdue->{'itemnumber'});
|
||||
my $dbh=C4Connect();
|
||||
my $accountno=C4::Circulation::getnextacctno($overdue->{'borrowernumber'});
|
||||
my $item=GetBiblioFromItemNumber($overdue->{'itemnumber'});
|
||||
if ($item->{'itemlost'} ne '1' && $item->{'itemlost'} ne '2' ){
|
||||
$item->{'title'}=~ s/\'/\\'/g;
|
||||
my $query="Insert into accountlines (borrowernumber,itemnumber,accountno,date,amount, description,accounttype,amountoutstanding)
|
||||
values ($overdue->{'borrowernumber'}, $overdue->{'itemnumber'},
|
||||
'$accountno',now(),'$cost','Lost item $item->{'title'} $item->{'barcode'}','L','$cost')";
|
||||
|
||||
my $sth=$dbh->prepare($query);
|
||||
$sth->execute();
|
||||
$sth->finish();
|
||||
|
||||
$query="update items set itemlost=2 where itemnumber='$overdue->{'itemnumber'}'";
|
||||
$sth=$dbh->prepare($query);
|
||||
$sth->execute();
|
||||
$sth->finish();
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
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-8.txt';
|
||||
my %sms;
|
||||
%sms->{'template'}='sms-8.txt';
|
||||
|
||||
my %fax1;
|
||||
%fax1->{'template'}='fax-8.html';
|
||||
|
||||
my %firstReminder->{'email'} = \%email;
|
||||
%firstReminder->{'sms'} = \%sms;
|
||||
%firstReminder->{'fax'} = \%fax1;
|
||||
|
||||
my %email2;
|
||||
%email2->{'template'}='email-15.txt';
|
||||
|
||||
my %fax2;
|
||||
%fax2->{'template'}='fax-15.html';
|
||||
|
||||
my %letter2;
|
||||
%letter2->{'template'}='fax-15.html';
|
||||
|
||||
my %sms2->{'template'}='sms-15.txt';
|
||||
my %secondReminder->{'email'} = \%email2;
|
||||
%secondReminder->{'sms'} = \%sms2;
|
||||
%secondReminder->{'fax'} = \%fax2;
|
||||
%secondReminder->{'letter'} = \%letter2;
|
||||
|
||||
|
||||
my %email3;
|
||||
%email3->{'template'}='email-29.txt';
|
||||
my %fax3;
|
||||
%fax3->{'template'}='fax-29.html';
|
||||
my %letter3;
|
||||
%letter3->{'template'}='letter-29.html';
|
||||
|
||||
my %finalReminder->{'email'} = \%email3;
|
||||
%finalReminder->{'fax'} = \%fax3;
|
||||
%finalReminder->{'letter'} = \%letter3;
|
||||
|
||||
my $fines;
|
||||
my %actions;
|
||||
%actions->{'8'}=\%firstReminder;
|
||||
%actions->{'15'}=\%secondReminder;
|
||||
%actions->{'29'}=\%finalReminder;
|
||||
|
||||
##################################################################################################################
|
||||
|
||||
|
||||
# Work out what today is as an integer value.
|
||||
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
|
||||
$mon++; $year=$year+1900;
|
||||
my $date=Date_DaysSince1BC($mon,$mday,$year);
|
||||
|
||||
|
||||
# Retrieve an array of overdues.
|
||||
my ($count, $overduesReference) = Getoverdues();
|
||||
print "$count overdue items where found.\n\n";
|
||||
my @overdues=@$overduesReference;
|
||||
|
||||
|
||||
# We're going to build a hash of arrays, containing the items requiring action.
|
||||
# ->borrowernumber, date, @overdues
|
||||
my %actionItems;
|
||||
foreach my $actionday (keys(%actions)) {
|
||||
my @items=();
|
||||
%actionItems->{$actionday} = \@items;
|
||||
}
|
||||
|
||||
|
||||
|
||||
foreach my $overdue (@overdues) {
|
||||
my @dates=split('-',$overdue->{'date_due'});
|
||||
my $due_day=Date_DaysSince1BC($dates[1],$dates[2],$dates[0]);
|
||||
|
||||
my $difference=$date-$due_day;
|
||||
# $overdue->{'fine'}=GetFine($overdue->{'itemnumber'});
|
||||
# If does this item fall on a day of interest?
|
||||
$overdue->{'difference'}=$difference;
|
||||
foreach my $actiondate (keys(%actions)) {
|
||||
if ($actiondate == $difference) {
|
||||
my @items = @{%actionItems->{$actiondate}};
|
||||
|
||||
my %o = %$overdue;
|
||||
push (@items, \%o);
|
||||
%actionItems->{$actiondate} = \@items;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
# 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 (sort {$a <=> $b} (keys(%actions))) {
|
||||
print "\n\nThe following items are $actiondate days overdue.\n";
|
||||
my @items = @{%actionItems->{$actiondate}};
|
||||
|
||||
|
||||
foreach my $overdue (@items) {
|
||||
if ($overdue->{'difference'} eq $actiondate) {
|
||||
# Detemine which borrower is responsible for this overdue;
|
||||
# if the offender is a child, then the garentor is the person to notify
|
||||
my $borrower=responsibleBorrower($overdue);
|
||||
|
||||
|
||||
my ($method, $address) = preferedContactMethod($borrower);
|
||||
if ($method) {
|
||||
|
||||
# Do we have to send something, using this method on this day?
|
||||
if (%actions->{$actiondate}->{$method}->{'template'}) {
|
||||
# If this user has one overdue, then they may have offers as well.
|
||||
# No point in sending a notice without mentioning all of the items.
|
||||
my @alloverdues;
|
||||
foreach my $over (@overdues) {
|
||||
my $responisble= responsibleBorrower($over);
|
||||
if ($responisble->{'borrowernumber'} eq $borrower->{'borrowernumber'}) {
|
||||
$over->{'borrowernumber'}=$responisble->{'borrowernumber'};
|
||||
my %o = %$over;
|
||||
push (@alloverdues, \%o);
|
||||
}
|
||||
}
|
||||
|
||||
my $dbh=C4Connect(); # FIXME disconnect this
|
||||
|
||||
# Template the message
|
||||
my $template = HTML::Template->new(filename => 'templates/'.%actions->{$actiondate}->{$method}->{'template'}, die_on_bad_params => 0);
|
||||
|
||||
my @bookdetails;
|
||||
my $total_fines = 0;
|
||||
foreach my $over (@alloverdues) {
|
||||
my %row_data;
|
||||
if ( my $item = GetBiblioFromItemNumber( $over->{'itemnumber'})){
|
||||
print "getting fine ($over->{'itemnumber'} $overdue->{'borrowernumber'} $over->{'borrowernumber'}\n";
|
||||
my $fine = GetFine($over->{'itemnumber'},$overdue->{'borrowernumber'});
|
||||
|
||||
|
||||
print "fine=$fine ";
|
||||
|
||||
my $rep = ReplacementCost2($over->{'itemnumber'},$overdue->{'borrowernumber'});
|
||||
|
||||
if ($rep){
|
||||
$rep+=0.00;
|
||||
}
|
||||
if ($fine){
|
||||
$fine+=0.00;
|
||||
$borritem{"$over->{'itemnumber'} $over->{'borrowernumber'}"}=$fine;
|
||||
} else {
|
||||
$borritem{"$over->{'itemnumber'} $over->{'borrowernumber'}"}+=$fine;
|
||||
}
|
||||
print $borritem{"$over->{'itemnumber'} $over->{'borrowernumber'}"},"\n";
|
||||
$total_fines += $borritem{"$over->{'itemnumber'} $over->{'borrowernumber'}"};
|
||||
$item->{'title'}=substr($item->{'title'},0,25);
|
||||
my $len=length($item->{'title'});
|
||||
if ($len < 25){
|
||||
my $diff=25-$len;
|
||||
$item->{'title'}.=" " x $diff;
|
||||
}
|
||||
|
||||
$row_data{'BARCODE'}=$item->{'barcode'};
|
||||
$row_data{'TITLE'}=$item->{'title'};
|
||||
$row_data{'DATE_DUE'}=$over->{'date_due'};
|
||||
$row_data{'FINE'}=$borritem{"$over->{'itemnumber'} $over->{'borrowernumber'}"};
|
||||
$row_data{'REP'}=$rep;
|
||||
|
||||
push(@bookdetails, \%row_data);
|
||||
} else {
|
||||
print "Missing item $over->{'itemnumber'}\n";
|
||||
}
|
||||
}
|
||||
|
||||
$template->param(BOOKDETAILS => \@bookdetails);
|
||||
my %params;
|
||||
%params->{'borrowernumber'} = $overdue->{'borrowernumber'};
|
||||
my ($total, $acctlines, $count) = &GetMemberAccountRecords($overdue->{'borrowernumber'});
|
||||
$template->param(FINES_TOTAL => $total_fines);
|
||||
$template->param(OWING => $total);
|
||||
my $name= "$borrower->{'firstname'} $borrower->{'surname'}";
|
||||
$template->param(NAME=> $name);
|
||||
|
||||
%messages->{$borrower->{'borrowernumber'}} = $template->output();
|
||||
}
|
||||
else {
|
||||
print "No $method needs to be sent at $overdue->{'difference'} days; not sending\n";
|
||||
}
|
||||
|
||||
}
|
||||
else {
|
||||
print "This borrower has an overdue item, but no means of contact\n";
|
||||
}
|
||||
|
||||
} #end of 'if this overdue falls on an action date'
|
||||
|
||||
} #end of 'foreach overdue'
|
||||
|
||||
} # end of foreach actiondate
|
||||
|
||||
|
||||
# How that all of the messsages to be sent have been composed, send them.
|
||||
foreach my $borrowernumber (keys(%messages)) {
|
||||
print "$borrowernumber\n";
|
||||
|
||||
my $borrower=BorType($borrowernumber);
|
||||
my ($method, $address) = preferedContactMethod($borrower);
|
||||
|
||||
my $result=0;
|
||||
if ($method eq 'email') {
|
||||
$result = sendEmail($address, 'lep@library.org.nz', 'Overdue Library Items', %messages->{$borrowernumber});
|
||||
}
|
||||
elsif ($method eq 'sms') {
|
||||
$result = sendSMS($address, %messages->{$borrowernumber});
|
||||
}
|
||||
elsif ($method eq 'fax') {
|
||||
$result = sendFax($address, %messages->{$borrowernumber});
|
||||
}
|
||||
elsif ($method eq 'letter') {
|
||||
$result = printLetter($address, %messages->{$borrowernumber});
|
||||
}
|
||||
|
||||
|
||||
#print %messages->{$borrowernumber}; # debug
|
||||
|
||||
|
||||
# Log the outcome of this attempt
|
||||
logContact($borrowernumber, $method, $address, $result, %messages->{$borrowernumber});
|
||||
}
|
||||
|
||||
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
sub responsibleBorrower {
|
||||
# Given an overdue item, return the details of the borrower responible as a hash of database columns.
|
||||
my $overdue=$_[0];
|
||||
|
||||
if ($overdue->{'borrowernumber'}) {
|
||||
my $borrower=BorType($overdue->{'borrowernumber'});
|
||||
|
||||
|
||||
# Overdue books assigned to children have notices sent to the guarantor.
|
||||
if ($borrower->{'categorycode'} eq 'C') {
|
||||
my $dbh=C4Connect();
|
||||
my $query="Select borrowernumber from borrowers
|
||||
where borrowernumber=?";
|
||||
|
||||
my $sth=$dbh->prepare($query);
|
||||
$sth->execute($borrower->{'guarantor'});
|
||||
|
||||
my $tdata=$sth->fetchrow_hashref();
|
||||
$sth->finish();
|
||||
$dbh->disconnect();
|
||||
|
||||
my $guarantor=BorType($tdata->{'borrowernumber'});
|
||||
$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];
|
||||
# print "finding borrower method $borrower->{'preferredcont'} $borrower->{'emailaddress'} $borrower->{'streetaddress'}\n";
|
||||
|
||||
# Possible contact methods, in order of preference are:
|
||||
my @methods = ('email', 'sms', 'fax', 'letter');
|
||||
|
||||
my $method='';
|
||||
my $address='';
|
||||
|
||||
|
||||
# Does this borrower have a borrower.preferredcont set?
|
||||
# If so, push it to the head of our array of methods to try.
|
||||
# If it's a method unheard of by this system, then we'll drop though to the prefined methods above.
|
||||
# Note use of unshift to push onto the front of the array.
|
||||
if ($borrower->{'preferredcont'}) {
|
||||
unshift(@methods, $borrower->{'preferredcont'});
|
||||
}
|
||||
|
||||
|
||||
# Cycle through the possible methods until one is accepted
|
||||
while ((@methods) and (!$address)) {
|
||||
$method=shift(@methods);
|
||||
|
||||
|
||||
if ($method eq 'email') {
|
||||
if (($borrower->{'emailaddress'}) and (Mail::RFC822::Address::valid($borrower->{'emailaddress'}))) {
|
||||
$address = $borrower->{'emailaddress'};
|
||||
}
|
||||
}
|
||||
elsif ($method eq 'fax') {
|
||||
if ($borrower->{'faxnumber'}) {
|
||||
$address = $borrower->{'faxnumber'};
|
||||
}
|
||||
}
|
||||
elsif ($method eq 'sms') {
|
||||
if ($borrower->{'textmessaging'}) {
|
||||
$address = $borrower->{'textmessaging'};
|
||||
}
|
||||
}
|
||||
elsif ($method eq 'letter') {
|
||||
if ($borrower->{'streetaddress'}) {
|
||||
$address = mailingAddress($borrower);
|
||||
}
|
||||
}
|
||||
}
|
||||
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 $dbh=C4Connect(); # FIXME - disconnect me
|
||||
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 itemFine {
|
||||
# Given an overdue item, return the current fines on it
|
||||
my $overdue=$_[0];
|
||||
# FIXME
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
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 => 'rosalie@library.org.nz',
|
||||
From => $from,
|
||||
Subject => $subject,
|
||||
Message => $message);
|
||||
|
||||
|
||||
if (not(sendmail %mail)) {
|
||||
warn "sendEmail to $to failed.";
|
||||
return 0;
|
||||
}
|
||||
|
||||
return 1;
|
||||
# die "got to here";
|
||||
}
|
||||
|
||||
|
||||
sub sendSMS {
|
||||
# Given a cell number and a message, attempt to send an SMS message.
|
||||
# FIXME - needs information about how to do this at HLT
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
sub sendFax {
|
||||
print "in fax \n";
|
||||
# Given a fax number, and a message, attempt to send a fax.
|
||||
# FIXME - needs information about how to do this at HLT
|
||||
# This is fairly easy.
|
||||
# We will be past the body of the fax as HTML.
|
||||
# We can pass this through html2ps to generate Postscript suitable
|
||||
# for passing to the fax server.
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
sub printLetter {
|
||||
# Print a letter
|
||||
# FIXME - needs information about how to do this at HLT
|
||||
return 1;
|
||||
}
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# Display a history of attempts to contact this borrower
|
||||
# regarding overdues and fines.
|
||||
#
|
||||
# Tony McCrae
|
||||
# tony@katipo.co.nz 5/July/2003
|
||||
# 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., 59 Temple Place,
|
||||
# Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
#use lib ('/usr/local/koha/intranet/modules');
|
||||
use strict;
|
||||
use CGI;
|
||||
|
||||
|
||||
use C4::Circulation;
|
||||
use C4::Overdues;
|
||||
|
||||
my $input = new CGI;
|
||||
my $borrowernumber = $input->param('borrowernumber');
|
||||
my $date= $input->param('date');
|
||||
print $input->header;
|
||||
if ($borrowernumber) {
|
||||
my $borrower = BorType($borrowernumber);
|
||||
my $dbh=C4Connect();
|
||||
my $querystring = "select * from borrowers where borrowernumber = ?";
|
||||
my $sth=$dbh->prepare($querystring);
|
||||
$sth->execute($borrowernumber);
|
||||
my $row=$sth->fetchrow_hashref();
|
||||
# print "<body background=/images/letterhead.jpg> <p> <p> <p>";
|
||||
print "
|
||||
<html>
|
||||
<head>
|
||||
<title></title>
|
||||
<style type=\"text/css\">
|
||||
body {
|
||||
padding:0
|
||||
margin:0
|
||||
}
|
||||
.content {
|
||||
padding-left:30px;
|
||||
padding-right:20px
|
||||
}
|
||||
|
||||
@ media print {
|
||||
.content {
|
||||
padding-left:20px;
|
||||
padding-right:20px
|
||||
}
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>";
|
||||
print "<img src=\"/images/letterhead.jpg\"><br>";
|
||||
print "<p> <p> <p>\n ";
|
||||
print "<div class=\"content\">$row->{'firstname'} $row->{'surname'}<br>
|
||||
$row->{'streetaddress'}<br>
|
||||
$row->{'city'}<p> <p>";
|
||||
$sth->finish();
|
||||
|
||||
$querystring = " select date, method, address, result, message, borrowernumber
|
||||
from attempted_contacts
|
||||
where date = ? and borrowernumber= ?
|
||||
";
|
||||
|
||||
|
||||
|
||||
$sth=$dbh->prepare($querystring);
|
||||
$sth->execute($date,$borrowernumber);
|
||||
|
||||
$row=$sth->fetchrow_hashref();
|
||||
# print $row->{'date'}."<br>\n";
|
||||
# print $row->{'method'}."<br>\n";
|
||||
# print $row->{'address'}."<br>\n";
|
||||
# print $row->{'result'}."<br>\n";
|
||||
print $row->{'message'}."<br>\n";
|
||||
print "<p><p>";
|
||||
|
||||
#print $querystring,$date,$borrowernumber;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
Dear Library Member
|
||||
According to the library's records, you or your children have the following
|
||||
overdue items borrowed from a Horowhenua Library and not yet returned.
|
||||
Please return them immediately to avoid increasing fines.
|
||||
|
||||
<TMPL_LOOP NAME=BOOKDETAILS><TMPL_VAR NAME=DATE_DUE> <TMPL_VAR NAME=TITLE> <TMPL_VAR NAME=ITEMTYPE> <TMPL_IF NAME=FINE>$<TMPL_VAR NAME=FINE></TMPL_IF>
|
||||
</TMPL_LOOP>
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
Invoice for lost book(s)
|
||||
This is an invoice for the replacement cost of items you
|
||||
or your children borrowed from the library which have not been returned.
|
||||
|
||||
<TMPL_LOOP NAME=BOOKDETAILS><TMPL_VAR NAME=DATE_DUE> <TMPL_VAR NAME=TITLE> <TMPL_VAR NAME=ITEMTYPE> <TMPL_IF NAME=FINE>$<TMPL_VAR NAME=FINE></TMPL_IF> <TMPL_IF NAME=REP>$<TMPL_VAR NAME=REP></TMPL_IF>
|
||||
</TMPL_LOOP>
|
||||
|
||||
Total Owing: $<TMPL_VAR NAME=OWING>
|
||||
|
||||
|
||||
If you return all overdue items, the total owing in fines will be $<TMPL_VAR
|
||||
NAME=FINES_TOTAL>
|
||||
|
||||
Please deal with this matter immediately. If you need more time to search or pay, or you think a mistake
|
||||
has been made, please contact the library straight away. If you do not respond to this letter, this
|
||||
account will be handed to a debt collection agency.
|
||||
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
Dear Library member
|
||||
This is a reminder about some items you or your children borrowed from the library
|
||||
recently, which are now overdue and incurring fines.
|
||||
|
||||
They are:
|
||||
<TMPL_LOOP NAME=BOOKDETAILS><TMPL_VAR NAME=DATE_DUE> <TMPL_VAR NAME=TITLE> <TMPL_VAR NAME=ITEMTYPE> <TMPL_IF NAME=FINE>$<TMPL_VAR NAME=FINE></TMPL_IF>
|
||||
</TMPL_LOOP>
|
||||
|
||||
Please return or renew them as soon as you can.
|
||||
Rosalie Blake
|
||||
Head of Libraries
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
Dear <TMPL_VAR NAME="NAME"><p>
|
||||
According to the library's records, you or your children have the following overdue
|
||||
items borrowed from a Horowhenua Library and not yet returned. Please return them immediately to avoid increasing fines.
|
||||
<p>
|
||||
<table border=\"1\">
|
||||
<TMPL_LOOP NAME=BOOKDETAILS>
|
||||
<tr>
|
||||
<td><TMPL_VAR NAME=DATE_DUE></td>
|
||||
<td><TMPL_VAR NAME=BARCODE></td>
|
||||
<td><TMPL_VAR NAME=TITLE></td>
|
||||
<td><TMPL_VAR NAME=ITEMTYPE></td>
|
||||
<td>$<TMPL_VAR NAME=FINE></td>
|
||||
</tr>
|
||||
</TMPL_LOOP>
|
||||
<table>
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
Dear <TMPL_VAR NAME="NAME"><p>
|
||||
|
||||
Invoice for lost book(s) <br>
|
||||
This is an invoice for the replacement cost of items you or your children
|
||||
borrowed from the library which have not been returned.
|
||||
|
||||
<p>
|
||||
<table border=\"1\">
|
||||
<TMPL_LOOP NAME=BOOKDETAILS>
|
||||
<tr>
|
||||
<td><TMPL_VAR NAME=DATE_DUE></td>
|
||||
<td><TMPL_VAR NAME=BARCODE></td>
|
||||
<td><TMPL_VAR NAME=TITLE></td>
|
||||
<td><TMPL_VAR NAME=ITEMTYPE></td>
|
||||
<td>$<TMPL_VAR NAME=FINE></td>
|
||||
<td>$<TMPL_VAR NAME=REP></td>
|
||||
</tr>
|
||||
</TMPL_LOOP>
|
||||
<table>
|
||||
Total Owing: $<TMPL_VAR NAME=OWING> <p>
|
||||
If you return all overdue items, the total owing in fines will be $<TMPL_VAR NAME=FINES_TOTAL>
|
||||
<br>
|
||||
Please deal with this matter
|
||||
immediately. If you need more time to search or pay, or you think a mistake
|
||||
has been made, please contact the library straight away. If you do not
|
||||
respond to this letter, this
|
||||
account will be handed to a debt collection agency.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
Dear <TMPL_VAR NAME="NAME"><p>
|
||||
According to the library's records, you or your children have the following overdue
|
||||
items borrowed from a Horowhenua Library and not yet returned. Please return them immediately to avoid increasing fines.
|
||||
<p>
|
||||
<table border=\"1\">
|
||||
<TMPL_LOOP NAME=BOOKDETAILS>
|
||||
<tr>
|
||||
<td><TMPL_VAR NAME=DATE_DUE></td>
|
||||
<td><TMPL_VAR NAME=BARCODE></td>
|
||||
<td><TMPL_VAR NAME=TITLE></td>
|
||||
<td><TMPL_VAR NAME=ITEMTYPE></td>
|
||||
<td>$<TMPL_VAR NAME=FINE></td>
|
||||
</tr>
|
||||
</TMPL_LOOP>
|
||||
</table>
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
Dear <TMPL_VAR NAME="NAME"><p>
|
||||
Invoice for lost book(s) <br>
|
||||
This is an invoice for the replacement cost of items you or your children
|
||||
borrowed from the library which have not been returned.
|
||||
|
||||
<p>
|
||||
<table border=\"1\">
|
||||
<TMPL_LOOP NAME=BOOKDETAILS>
|
||||
<tr>
|
||||
<td><TMPL_VAR NAME=DATE_DUE></td>
|
||||
<td><TMPL_VAR NAME=BARCODE></td>
|
||||
<td><TMPL_VAR NAME=TITLE></td>
|
||||
<td><TMPL_VAR NAME=ITEMTYPE></td>
|
||||
<td>$<TMPL_VAR NAME=FINE></td>
|
||||
<td>$<TMPL_VAR NAME=REP></td>
|
||||
|
||||
</tr>
|
||||
</TMPL_LOOP>
|
||||
</table>
|
||||
Total Owing: $<TMPL_VAR NAME=OWING> <p>
|
||||
If you return all overdue items, the total owing in fines will be $<TMPL_VAR NAME=FINES_TOTAL>
|
||||
<br>
|
||||
Please deal with this matter
|
||||
immediately. If you need more time to search or pay, or you think a mistake
|
||||
has been made, please contact the library straight away. If you do not
|
||||
respond to this letter, this
|
||||
account will be handed to a debt collection agency.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1 @@
|
|||
ovdues @lib ret immed
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
ovdues @lib pls ret
|
||||
|
||||
|
|
@ -793,7 +793,7 @@ ut Title-uniform
|
|||
# for an authority to be searched subfield $9 in the
|
||||
# for cataloging purposes. following: 700,701,702,710,
|
||||
# 711,712 and some 6XX fields (Unimarc)
|
||||
Authority-Number 1=8910
|
||||
Authority-number 1=8910
|
||||
an Authority-Number
|
||||
Koha-Auth-Number Authority-Number
|
||||
|
||||
|
|
|
|||
|
|
@ -116,4 +116,8 @@ $template->param(
|
|||
koha_news_count => $koha_news_count
|
||||
);
|
||||
|
||||
$template->param(
|
||||
'Disable_Dictionary' => C4::Context->preference("Disable_Dictionary") )
|
||||
if ( C4::Context->preference("Disable_Dictionary") );
|
||||
|
||||
output_html_with_http_headers $input, $cookie, $template->output;
|
||||
|
|
|
|||
|
|
@ -296,12 +296,12 @@ else {
|
|||
debarred => 1
|
||||
);
|
||||
}
|
||||
my (@reserves) = GetReservesFromBorrowernumber( $borrowernumber );
|
||||
$template->param( RESERVES => $reserves );
|
||||
if ( $#reserves+1 >= $MAXIMUM_NUMBER_OF_RESERVES ) {
|
||||
my @reserves = GetReservesFromBorrowernumber( $borrowernumber );
|
||||
$template->param( RESERVES => \@reserves );
|
||||
if ( scalar(@$reserves) >= $MAXIMUM_NUMBER_OF_RESERVES ) {
|
||||
$template->param( message => 1 );
|
||||
$noreserves = 1;
|
||||
$template->param( too_many_reserves => $#reserves+1 );
|
||||
$template->param( too_many_reserves => scalar($reserves));
|
||||
}
|
||||
foreach my $res (@$reserves) {
|
||||
if ( $res->{'biblionumber'} == $biblionumber ) {
|
||||
|
|
|
|||
|
|
@ -0,0 +1,49 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# 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;
|
||||
require Exporter;
|
||||
use CGI;
|
||||
use C4::Auth;
|
||||
use C4::Koha;
|
||||
use C4::Output;
|
||||
use C4::Circulation;
|
||||
use C4::Review;
|
||||
use C4::Biblio;
|
||||
|
||||
my $query = new CGI;
|
||||
my $biblionumber = $query->param('biblionumber');
|
||||
|
||||
my ( $template, $borrowernumber, $cookie ) = &get_template_and_user(
|
||||
{
|
||||
template_name => "opac-showreviews.tmpl",
|
||||
query => $query,
|
||||
type => "opac",
|
||||
authnotrequired => 1,
|
||||
}
|
||||
);
|
||||
|
||||
my $biblio = GetBiblioData( $biblionumber );
|
||||
my $reviews = getreviews( $biblionumber, 1 );
|
||||
|
||||
$template->param(
|
||||
reviews => $reviews,
|
||||
title => $biblio->{'title'},
|
||||
);
|
||||
|
||||
output_html_with_http_headers $query, $cookie, $template->output;
|
||||
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
# 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
|
||||
|
||||
# $Id$
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use C4::Auth;
|
||||
use C4::Date;
|
||||
use C4::Output;
|
||||
use C4::Context;
|
||||
use C4::Serials;
|
||||
|
||||
my $query = new CGI;
|
||||
my $op = $query->param('op');
|
||||
my $dbh = C4::Context->dbh;
|
||||
my $subscriptionid = $query->param('subscriptionid');
|
||||
my $auser = $query->param('user');
|
||||
my $histstartdate = format_date_in_iso($query->param('histstartdate'));
|
||||
my $enddate = format_date_in_iso($query->param('enddate'));
|
||||
my $recievedlist = $query->param('recievedlist');
|
||||
my $missinglist = $query->param('missinglist');
|
||||
my $opacnote = $query->param('opacnote');
|
||||
my $librariannote = $query->param('librariannote');
|
||||
my @serialids = $query->param('serialid');
|
||||
my @serialseqs = $query->param('serialseq');
|
||||
my @planneddates = $query->param('planneddate');
|
||||
my @notes = $query->param('notes');
|
||||
my @status = $query->param('status');
|
||||
|
||||
my ($template, $loggedinuser, $cookie)
|
||||
= get_template_and_user({template_name => "serials/statecollection.tmpl",
|
||||
query => $query,
|
||||
type => "intranet",
|
||||
authnotrequired => 0,
|
||||
flagsrequired => {serials => 1},
|
||||
debug => 1,
|
||||
});
|
||||
|
||||
my $HasSubscriptionExpired = HasSubscriptionExpired($subscriptionid);
|
||||
my $subscription=GetSubscription($subscriptionid);
|
||||
if ($op eq 'modsubscriptionhistory') {
|
||||
modsubscriptionhistory($subscriptionid,$histstartdate,$enddate,$recievedlist,$missinglist,$opacnote,$librariannote);
|
||||
}
|
||||
# change status except, if subscription has expired, for the "waited" issue.
|
||||
if ($op eq 'serialchangestatus') {
|
||||
my $sth = $dbh->prepare("select status from serial where serialid=?");
|
||||
for (my $i=0;$i<=$#serialids;$i++) {
|
||||
$sth->execute($serialids[$i]);
|
||||
my ($oldstatus) = $sth->fetchrow;
|
||||
if ($serialids[$i]) {
|
||||
serialchangestatus($serialids[$i],$serialseqs[$i],format_date_in_iso($planneddates[$i]),$status[$i],$notes[$i]) unless ($HasSubscriptionExpired && $oldstatus == 1);
|
||||
} else {
|
||||
# add a special issue
|
||||
if ($serialseqs[$i]) {
|
||||
my $subscription=getsubscription($subscriptionid);
|
||||
newissue($serialseqs[$i],$subscriptionid,$subscription->{biblionumber},$status[$i], format_date_in_iso($planneddates[$i]));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
my $subs = &GetSubscription($subscriptionid);
|
||||
my ($totalissues,@serialslist) = GetSerials($subscriptionid,10);
|
||||
|
||||
my $sth=$dbh->prepare("select * from subscriptionhistory where subscriptionid = ?");
|
||||
$sth->execute($subscriptionid);
|
||||
my $solhistory = $sth->fetchrow_hashref;
|
||||
|
||||
$template->param(
|
||||
serialslist => \@serialslist,
|
||||
biblionumber => $subscription->{biblionumber},
|
||||
histstartdate => format_date($solhistory->{'histstartdate'}),
|
||||
enddate => format_date($solhistory->{'enddate'}),
|
||||
recievedlist => $solhistory->{'recievedlist'},
|
||||
missinglist => $solhistory->{'missinglist'},
|
||||
opacnote => $solhistory->{'opacnote'},
|
||||
librariannote => $solhistory->{'librariannote'},
|
||||
subscriptionid => $subscriptionid,
|
||||
bibliotitle => $subs->{bibliotitle},
|
||||
biblionumber => $subs->{biblionumber},
|
||||
hassubscriptionexpired =>$HasSubscriptionExpired,
|
||||
);
|
||||
output_html_with_http_headers $query, $cookie, $template->output;
|
||||
|
|
@ -0,0 +1,33 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
|
||||
use strict;
|
||||
use CGI;
|
||||
use Date::Manip;
|
||||
|
||||
use C4::Koha;
|
||||
use C4::Auth;
|
||||
use C4::Date;
|
||||
use C4::Output;
|
||||
use C4::Acquisition;
|
||||
use C4::Context;
|
||||
use C4::Serials;
|
||||
|
||||
my $query = new CGI;
|
||||
my $subscriptionid = $query->param('subscriptionid');
|
||||
my $dbh = C4::Context->dbh;
|
||||
# get old subscription
|
||||
my $subs = &GetSubscription($subscriptionid);
|
||||
|
||||
# make newsubscription()
|
||||
my $subscriptionid = old_newsubscription($subs->{'auser'},$subs->{'aqbooksellerid'},$subs->{'cost'},$subs->{'aqbudgetid'},
|
||||
$subs->{'biblionumber'},$subs->{'startdate'},$subs->{'periodicity'},$subs->{'firstacquidate'},
|
||||
$subs->{'dow'},$subs->{'irregularity'},$subs->{'numberpattern'},$subs->{'numberlength'},
|
||||
$subs->{'weeklength'},$subs->{'monthlength'},$subs->{'add1'},$subs->{'every1'},
|
||||
$subs->{'whenmorethan1'},$subs->{'setto1'},$subs->{'lastvalue1'},$subs->{'add2'},
|
||||
$subs->{'every2'},$subs->{'whenmorethan2'},$subs->{'setto2'},$subs->{'lastvalue2'},$subs->{'add3'},
|
||||
$subs->{'every3'},$subs->{'whenmorethan3'},$subs->{'setto3'},$subs->{'lastvalue3'},
|
||||
$subs->{'numberingmethod'},$subs->{'status'},$subs->{'notes'},
|
||||
);
|
||||
print $query->redirect("/cgi-bin/koha/serials/subscription-detail.pl?subscriptionid=$subscriptionid");
|
||||
|
||||
Loading…
Reference in New Issue