Koha-devel
Threads by month
- ----- 2026 -----
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2025 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2011 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2010 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2009 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2008 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2007 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2006 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2005 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2004 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2003 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2002 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2001 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- 5 participants
- 10642 discussions
Update of /cvsroot/koha/koha
In directory usw-pr-cvs1:/tmp/cvs-serv25277
Modified Files:
detail.pl
Log Message:
Bug fixes to get the new acqui.simple system working.
Index: detail.pl
===================================================================
RCS file: /cvsroot/koha/koha/detail.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** detail.pl 15 Mar 2001 10:17:33 -0000 1.3
--- detail.pl 3 May 2002 02:47:33 -0000 1.4
***************
*** 5,9 ****
use strict;
- #use DBI;
use C4::Search;
use CGI;
--- 5,8 ----
***************
*** 11,53 ****
my $input = new CGI;
! print $input->header;
! #whether it is called from the opac of the intranet
! my $type=$input->param('type');
! if ($type eq ''){
! $type='intra';
! }
! #setup colours
my $main;
my $secondary;
if ($type eq 'opac'){
! $main='#99cccc';
! $secondary='#efe5ef';
} else {
! $main='#cccc99';
! $secondary='#ffffcc';
! }
print startpage();
print startmenu($type);
- #print $type;
- my $blah;
- my $bib=$input->param('bib');
- my $title=$input->param('title');
- if ($type ne 'opac'){
- print "<a href=request.pl?bib=$bib><img height=42 WIDTH=120 BORDER=0 src=\"/images/requests.gif\" align=right border=0></a>";
- }
- my @items=ItemInfo(\$blah,$bib,$type);
- my $dat=bibdata($bib);
- my $count=@items;
- my ($count3,$addauthor)=addauthor($bib);
- my $additional=$addauthor->[0]->{'author'};
- for (my $i=1;$i<$count3;$i++){
- $additional=$additional."|".$addauthor->[$i]->{'author'};
- }
- my @temp=split('\t',$items[0]);
if ($type eq 'catmain'){
print mkheadr(3,"Catalogue Maintenance");
! }
if ($dat->{'author'} ne ''){
print mkheadr(3,"$dat->{'title'} ($dat->{'author'}) $temp[4]");
--- 10,56 ----
my $input = new CGI;
! my $type = $input->param('type');
! my $bib = $input->param('bib');
! my $title = $input->param('title');
! my @items = &ItemInfo(undef, $bib, $type);
! my $dat = &bibdata($bib);
! my $count = @items;
! my ($count3, $addauthor) = &addauthor($bib);
! my $additional = $addauthor->[0]->{'author'};
! my @temp = split('\t', $items[0]);
my $main;
my $secondary;
+
+ if ($type eq ''){
+ $type = 'opac';
+ } # if
+
+ # setup colours
if ($type eq 'opac'){
! $main = '#99cccc';
! $secondary = '#efe5ef';
} else {
! $main = '#cccc99';
! $secondary = '#ffffcc';
! } # else
!
! print $input->header;
print startpage();
print startmenu($type);
+ if ($type ne 'opac'){
+ print << "EOF";
+ <a href=request.pl?bib=$bib><img height=42 WIDTH=120 BORDER=0 src=\"/images/requests.gif\" align=right border=0></a>
+ EOF
+ } # if
+
+ for (my $i = 1; $i < $count3; $i++) {
+ $additional .= "|" . $addauthor->[$i]->{'author'};
+ } # for
if ($type eq 'catmain'){
print mkheadr(3,"Catalogue Maintenance");
! } # if
!
if ($dat->{'author'} ne ''){
print mkheadr(3,"$dat->{'title'} ($dat->{'author'}) $temp[4]");
***************
*** 55,59 ****
print mkheadr(3,"$dat->{'title'} $temp[4]");
}
! print <<printend
<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width="220">
--- 58,62 ----
print mkheadr(3,"$dat->{'title'} $temp[4]");
}
! print << "EOF";
<TABLE CELLSPACING=0 CELLPADDING=5 border=1 align=left width="220">
***************
*** 67,83 ****
<td bgcolor="$main"
! printend
! ;
if ($type ne 'opac'){
print "background=\"/images/background-mem.gif\"";
}
! print <<printend
><B>BIBLIO RECORD
! printend
! ;
if ($type ne 'opac'){
print "$bib";
}
! print <<printend
</TD></TR>
--- 70,86 ----
<td bgcolor="$main"
! EOF
!
if ($type ne 'opac'){
print "background=\"/images/background-mem.gif\"";
}
! print << "EOF";
><B>BIBLIO RECORD
! EOF
!
if ($type ne 'opac'){
print "$bib";
}
! print << "EOF";
</TD></TR>
***************
*** 85,103 ****
<tr VALIGN=TOP >
<TD>
! printend
! ;
if ($type ne 'opac'){
print "<INPUT TYPE=\"image\" name=\"submit\" VALUE=\"modify\" height=42 WIDTH=93 BORDER=0 src=\"/images/modify-mem.gif\">
<INPUT TYPE=\"image\" name=\"delete\" VALUE=\"delete\" height=42 WIDTH=93 BORDER=0 src=\"/images/delete-mem.gif\">";
}
! print <<printend
<br>
<FONT SIZE=2 face="arial, helvetica">
! printend
! ;
if ($type ne 'opac'){
! print <<printend
<b>Subtitle:</b> $dat->{'subtitle'}<br>
<b>Author:</b> $dat->{'author'}<br>
--- 88,105 ----
<tr VALIGN=TOP >
<TD>
! EOF
!
if ($type ne 'opac'){
print "<INPUT TYPE=\"image\" name=\"submit\" VALUE=\"modify\" height=42 WIDTH=93 BORDER=0 src=\"/images/modify-mem.gif\">
<INPUT TYPE=\"image\" name=\"delete\" VALUE=\"delete\" height=42 WIDTH=93 BORDER=0 src=\"/images/delete-mem.gif\">";
}
! print << "EOF";
<br>
<FONT SIZE=2 face="arial, helvetica">
! EOF
if ($type ne 'opac'){
! print << "EOF";
<b>Subtitle:</b> $dat->{'subtitle'}<br>
<b>Author:</b> $dat->{'author'}<br>
***************
*** 113,118 ****
<b>Total Number of Items:</b> $count
<p>
! printend
! ;
}
else {
--- 115,120 ----
<b>Total Number of Items:</b> $count
<p>
! EOF
!
}
else {
***************
*** 149,153 ****
}
! print <<printend
</form>
</font></TD>
--- 151,155 ----
}
! print << "EOF";
</form>
</font></TD>
***************
*** 156,165 ****
</TABLE>
<img src="/images/holder.gif" width=16 height=300 align=left>
!
! printend
! ;
!
!
! #print @items;
my $i=0;
--- 158,162 ----
</TABLE>
<img src="/images/holder.gif" width=16 height=300 align=left>
! EOF
my $i=0;
***************
*** 174,179 ****
my $colour=1;
while ($i < $count){
! # print $items[$i],"<br>";
! my @results=split('\t',$items[$i]);
if ($type ne 'opac'){
$results[1]=mklink("/cgi-bin/koha/moredetail.pl?item=$results[5]&bib=$bib&bi=$results[8]&type=$type",$results[1]);
--- 171,176 ----
my $colour=1;
while ($i < $count){
!
! my @results = split('\t', $items[$i]);
if ($type ne 'opac'){
$results[1]=mklink("/cgi-bin/koha/moredetail.pl?item=$results[5]&bib=$bib&bi=$results[8]&type=$type",$results[1]);
***************
*** 217,229 ****
print mktablehdr();
if ($type ne 'opac'){
! print <<printend
<TR VALIGN=TOP>
<TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=2><p><b>HELP</b><br>
<b>Update Biblio for all Items:</b> Click on the <b>Modify</b> button [left] to amend the biblio. Any changes you make will update the record for <b>all</b> the items listed above. <p>
<b>Updating the Biblio for only ONE or SOME Items:</b>
! printend
! ;
if ($type eq 'catmain'){
! print <<printend
If some of the items listed above need a different biblio,
you need to click on the wrong item, then shift the group it belongs to, to the correct biblio.
--- 214,226 ----
print mktablehdr();
if ($type ne 'opac'){
! print << "EOF";
<TR VALIGN=TOP>
<TD bgcolor="99cc33" background="/images/background-mem.gif" colspan=2><p><b>HELP</b><br>
<b>Update Biblio for all Items:</b> Click on the <b>Modify</b> button [left] to amend the biblio. Any changes you make will update the record for <b>all</b> the items listed above. <p>
<b>Updating the Biblio for only ONE or SOME Items:</b>
! EOF
!
if ($type eq 'catmain'){
! print << "EOF";
If some of the items listed above need a different biblio,
you need to click on the wrong item, then shift the group it belongs to, to the correct biblio.
***************
*** 232,245 ****
</TR>
! printend
! ;
} else {
! print <<printend
If some of the items listed above need a different biblio, or are on the wrong biblio, you must use the <a href="acquisitions/">acquisitions</a> process to fix this. You will need to "re-order" the items, and delete them from this biblio.
<p>
</TR>
! printend
! ;
}
}
--- 229,242 ----
</TR>
! EOF
!
} else {
! print << "EOF";
If some of the items listed above need a different biblio, or are on the wrong biblio, you must use the <a href="acquisitions/">acquisitions</a> process to fix this. You will need to "re-order" the items, and delete them from this biblio.
<p>
</TR>
! EOF
!
}
}
1
0
Update of /cvsroot/koha/koha/C4
In directory usw-pr-cvs1:/tmp/cvs-serv25277/C4
Modified Files:
Acquisitions.pm
Log Message:
Bug fixes to get the new acqui.simple system working.
Index: Acquisitions.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Acquisitions.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** Acquisitions.pm 29 Apr 2002 05:25:41 -0000 1.6
--- Acquisitions.pm 3 May 2002 02:47:33 -0000 1.7
***************
*** 407,411 ****
author = $biblio->{'author'},
copyrightdate = $biblio->{'copyright'},
! series = $series;
seriestitle = $biblio->{'seriestitle'},
notes = $biblio->{'notes'},
--- 407,411 ----
author = $biblio->{'author'},
copyrightdate = $biblio->{'copyright'},
! serial = $series,
seriestitle = $biblio->{'seriestitle'},
notes = $biblio->{'notes'},
***************
*** 413,417 ****
$sth = $dbh->prepare($query);
- # print $query;
$sth->execute;
--- 413,416 ----
***************
*** 913,923 ****
booksellerid = $item->{'booksellerid'},
dateaccessioned = NOW(),
! homebranch = $item->{'branch'},
! holdingbranch = $item->{'branch'},
price = $item->{'price'},
replacementprice = $item->{'replacementprice'},
replacementpricedate = NOW(),
- notforloan = $item->{'loan'},
itemnotes = $item->{'itemnotes'}";
$sth = $dbh->prepare($query);
--- 912,926 ----
booksellerid = $item->{'booksellerid'},
dateaccessioned = NOW(),
! homebranch = $item->{'homebranch'},
! holdingbranch = $item->{'homebranch'},
price = $item->{'price'},
replacementprice = $item->{'replacementprice'},
replacementpricedate = NOW(),
itemnotes = $item->{'itemnotes'}";
+
+ if ($item->{'loan'}) {
+ $query .= ",
+ notforloan = $item->{'loan'}";
+ } # if
$sth = $dbh->prepare($query);
1
0
Update of /cvsroot/koha/koha/updater
In directory usw-pr-cvs1:/tmp/cvs-serv32641/updater
Modified Files:
updatedatabase2.pl
Log Message:
updated database.mysql : dropped unused tables, created indexes : old database.mysql updated by updatedatabase2.pl script
Index: updatedatabase2.pl
===================================================================
RCS file: /cvsroot/koha/koha/updater/updatedatabase2.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** updatedatabase2.pl 19 Mar 2002 15:39:31 -0000 1.1
--- updatedatabase2.pl 2 May 2002 09:19:50 -0000 1.2
***************
*** 43,75 ****
my $dbh=C4Connect;
- my %tables;
my $sth=$dbh->prepare("show tables");
$sth->execute;
while (my ($table) = $sth->fetchrow) {
$tables{$table}=1;
}
! print "creating thesaurus...\n";
! dosql($dbh,"CREATE TABLE bibliothesaurus (code BIGINT not null AUTO_INCREMENT, freelib CHAR (255) not null , stdlib CHAR (255) not null , type CHAR (80) not null , PRIMARY KEY (code), INDEX (freelib),index(stdlib),index(type))");
! my $sti=$dbh->prepare("select subject from bibliosubject");
! $sti->execute;
! $i=0;
! while ($line =$sti->fetchrow_hashref) {
! $i++;
# print "$i $line->{'subject'}\n";
! $sti2=$dbh->prepare("select count(*) as t from bibliothesaurus where freelib=".$dbh->quote($line->{'subject'}));
! $sti2->execute;
! if ($sti2->err) {
! print "error : ".$sti2->errstr." \n tried to execute : $sql_cmd\n";
! die;
! }
! $line2=$sti2->fetchrow_hashref;
! if ($line2->{'t'} ==0) {
! dosql($dbh,"insert into bibliothesaurus (freelib,stdlib) values (".$dbh->quote($line->{'subject'}).",".$dbh->quote($line->{'subject'}).")");
! } else {
! print "pas ecriture pour : $line->{'subject'}\n";
! }
!
! }
#aqbookfund : the sample db is full of trash data. Delete and recreate
--- 43,75 ----
my $dbh=C4Connect;
my $sth=$dbh->prepare("show tables");
$sth->execute;
while (my ($table) = $sth->fetchrow) {
$tables{$table}=1;
+ print "table $table\n";
}
! #print "creating thesaurus...\n";
! #dosql($dbh,"CREATE TABLE bibliothesaurus (code BIGINT not null AUTO_INCREMENT, freelib CHAR (255) not null , stdlib CHAR (255) not null , type CHAR (80) not null , PRIMARY KEY (code), INDEX (freelib),index(stdlib),index(type))");
! # my $sti=$dbh->prepare("select subject from bibliosubject");
! # $sti->execute;
! # $i=0;
! # while ($line =$sti->fetchrow_hashref) {
! # $i++;
# print "$i $line->{'subject'}\n";
! # $sti2=$dbh->prepare("select count(*) as t from bibliothesaurus where freelib=".$dbh->quote($line->{'subject'}));
! # $sti2->execute;
! # if ($sti2->err) {
! # print "error : ".$sti2->errstr." \n tried to execute : $sql_cmd\n";
! # die;
! # }
! # $line2=$sti2->fetchrow_hashref;
! # if ($line2->{'t'} ==0) {
! # dosql($dbh,"insert into bibliothesaurus (freelib,stdlib) values (".$dbh->quote($line->{'subject'}).",".$dbh->quote($line->{'subject'}).")");
! # } else {
! # print "pas ecriture pour : $line->{'subject'}\n";
! # }
! #
! # }
#aqbookfund : the sample db is full of trash data. Delete and recreate
***************
*** 124,130 ****
dosql($dbh,"ALTER TABLE aqorderdelivery DROP PRIMARY KEY, ADD PRIMARY KEY(ordernumber);");
dosql($dbh,"ALTER TABLE aqorders DROP PRIMARY KEY, ADD PRIMARY KEY(ordernumber);");
! dosql($dbh,"ALTER TABLE biblio DROP PRIMARY KEY, ADD PRIMARY KEY(biblionumber, biblionumber);");
dosql($dbh,"ALTER TABLE biblioitems DROP PRIMARY KEY, ADD PRIMARY KEY(biblionumber, biblioitemnumber)");
! dosql($dbh,"CREATE INDEX SUBTITLE ON bibliosubtitle (subtitle(80))");
dosql($dbh,"ALTER TABLE borexp CHANGE borrowernumber borrowernumber INT (11) not null");
dosql($dbh,"ALTER TABLE borexp CHANGE newexp newexp DATE not null");
--- 124,130 ----
dosql($dbh,"ALTER TABLE aqorderdelivery DROP PRIMARY KEY, ADD PRIMARY KEY(ordernumber);");
dosql($dbh,"ALTER TABLE aqorders DROP PRIMARY KEY, ADD PRIMARY KEY(ordernumber);");
! dosql($dbh,"ALTER TABLE biblio DROP PRIMARY KEY, ADD PRIMARY KEY(biblionumber);");
dosql($dbh,"ALTER TABLE biblioitems DROP PRIMARY KEY, ADD PRIMARY KEY(biblionumber, biblioitemnumber)");
! # dosql($dbh,"CREATE INDEX SUBTITLE ON bibliosubtitle (subtitle(80))");
dosql($dbh,"ALTER TABLE borexp CHANGE borrowernumber borrowernumber INT (11) not null");
dosql($dbh,"ALTER TABLE borexp CHANGE newexp newexp DATE not null");
1
0
Update of /cvsroot/koha/koha
In directory usw-pr-cvs1:/tmp/cvs-serv18536
Modified Files:
database.mysql
Log Message:
added branchrelations table and changed branchcategories table to allow
admin/branches.pl to work properly.
Index: database.mysql
===================================================================
RCS file: /cvsroot/koha/koha/database.mysql,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** database.mysql 29 Apr 2002 05:25:41 -0000 1.3
--- database.mysql 2 May 2002 00:23:26 -0000 1.4
***************
*** 305,310 ****
CREATE TABLE branchcategories (
categorycode char(2) DEFAULT '' NOT NULL,
! branchcode char(4) DEFAULT '' NOT NULL,
! branchholding int(11)
);
--- 305,319 ----
CREATE TABLE branchcategories (
categorycode char(2) DEFAULT '' NOT NULL,
! categoryname text,
! codedescription text,
! PRIMARY KEY (categorycode)
! );
!
! #
! # Table structure for table 'branchrelations'
! #
! CREATE TABLE branchrelations (
! branchcode varchar(4) DEFAULT '' NOT NULL,
! categorycode varchar(4) DEFAULT '' NOT NULL
);
***************
*** 330,336 ****
CREATE TABLE branchtransfers (
itemnumber int(11) DEFAULT '0' NOT NULL,
! datesent date DEFAULT '0000-00-00' NOT NULL,
frombranch varchar(4),
! datearrived date,
tobranch varchar(4),
comments text
--- 339,345 ----
CREATE TABLE branchtransfers (
itemnumber int(11) DEFAULT '0' NOT NULL,
! datesent datetime DEFAULT '0000-00-00' NOT NULL,
frombranch varchar(4),
! datearrived datetime,
tobranch varchar(4),
comments text
1
0
CVS: koha/circ circulationold.pl,NONE,1.1 returns.pl,NONE,1.1 branchtransfers.pl,1.3,1.4 circulation.pl,1.23,1.24
by Finlay Thompson 01 May '02
by Finlay Thompson 01 May '02
01 May '02
Update of /cvsroot/koha/koha/circ
In directory usw-pr-cvs1:/tmp/cvs-serv14842
Modified Files:
branchtransfers.pl circulation.pl
Added Files:
circulationold.pl returns.pl
Log Message:
Changes to circulations:
added returns.pl -> deals with the returns only
moved old circulation.pl to circulationold.pl which still deals with issues.
fixed up branchtransfers.pl
moved circulation2.pl to circulation.pl
Note more changes coming next week
--- NEW FILE ---
#!/usr/bin/perl
use CGI qw/:standard/;
use C4::Circulation::Circ2;
use C4::Output;
use C4::Print;
use DBI;
my %env;
my $headerbackgroundcolor='#99cc33';
my $circbackgroundcolor='#ffffcc';
my $circbackgroundcolor='white';
my $linecolor1='#ffffcc';
my $linecolor2='white';
my $backgroundimage="/images/background-mem.gif";
my $query=new CGI;
my $branches=getbranches(\%env);
my $printers=getprinters(\%env);
my $branch=$query->param('branch');
my $printer=$query->param('printer');
#print $query->header;
($branch) || ($branch=$query->cookie('branch'));
($printer) || ($printer=$query->cookie('printer'));
my ($oldbranch, $oldprinter);
if ($query->param('selectnewbranchprinter')) {
$oldbranch=$branch;
$oldprinter=$printer;
$branch='';
$printer='';
}
$env{'branchcode'}=$branch;
$env{'printer'}=$printer;
$env{'queue'}=$printer;
my $branchcount=0;
my $printercount=0;
my $branchoptions;
my $printeroptions;
foreach (keys %$branches) {
(next) unless ($_);
(next) if (/^TR$/);
$branchcount++;
my $selected='';
($selected='selected') if ($_ eq $oldbranch);
$branchoptions.="<option value=$_ $selected>$branches->{$_}->{'branchname'}\n";
}
foreach (keys %$printers) {
(next) unless ($_);
$printercount++;
my $selected='';
($selected='selected') if ($_ eq $oldprinter);
$printeroptions.="<option value=$_ $selected>$printers->{$_}->{'printername'}\n";
}
if ($printercount==1) {
($printer)=keys %$printers;
}
if ($branchcount==1) {
($branch)=keys %$branches;
}
my $branchname='';
my $printername='';
if ($branch && $printer) {
$branchname=$branches->{$branch}->{'branchname'};
$printername=$printers->{$printer}->{'printername'};
}
my $branchcookie=$query->cookie(-name=>'branch', -value=>"$branch", -expires=>'+1y');
my $printercookie=$query->cookie(-name=>'printer', -value=>"$printer", -expires=>'+1y');
print $query->header(-type=>'text/html',-expires=>'now', -cookie=>[$branchcookie,$printercookie]);
#print $query->dump;
print startpage();
#print startmenu('circulation');
my @inp=startmenu('circulation');
if ($query->param('module') eq 'issues' && $query->param('barcode') eq '' && $query->param('charges') eq 'yes'){
my $count=@inp;
for (my $i=0;$i<$count;$i++){
my $bornum=$query->param('borrnumber');
$inp[$i]=~ s/onLoad=focusinput\(\)/onLoad=focusinput\(\)\;messenger\(\"\/cgi-bin\/koha\/pay.pl?bornum=$bornum\"\)\;window1.focus\(\)/;
}
}
print @inp;
print <<EOF
<script language="javascript" type="text/javascript">
<!--
function messenger(url){
window1=window.open(url,"window1","height=700,width=600,left=150,top=50,350,screenY=50");
}
//-->
</script>
EOF
;
if ($printer && $branch) {
SWITCH: {
if ($query->param('module') eq 'issues') { issues(); last SWITCH; }
if ($query->param('module') eq 'returns') { returns(); last SWITCH; }
issues();
}
} else {
my ($printerform, $branchform);
if ($printercount>1) {
$printerform=<<"EOF";
<table border=0 cellspacing=0 cellpadding=5>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Choose a Printer</font></td></tr>
<tr><td>
<select name=printer>
$printeroptions
</select>
</td></tr>
</table>
EOF
} else {
my ($printer) = keys %$printers;
$printerform=<<"EOF";
<input type=hidden name=printer value=$printer>
EOF
}
if ($branchcount>1) {
$branchform=<<"EOF";
<table border=0 cellpadding=5 cellspacing=0>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Choose a Branch</font></td></tr>
<tr><td>
<select name=branch>
$branchoptions
</select>
</td></tr>
</table>
EOF
}
print << "EOF";
<center>
Select a branch and a printer
<form method=get>
<table border=0>
<tr><td>
$branchform
</td><td>
$printerform
</td></tr>
</table>
<input type=submit>
</form>
EOF
}
print endmenu('circulation');
print endpage();
sub default {
print << "EOF";
<a href=cirulationold.pl?module=issues&branch=$branch&printer=$printer>Issues</a>
<a href=cirulationold.pl?module=returns&branch=$branch&printer=$printer>Returns</a>
EOF
}
sub decode {
($encoded) = @_;
$seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
@s = map { index($seq,$_); } split(//,$encoded);
$l = ($#s+1) % 4;
if ($l)
{
if ($l == 1)
{
print "Error!";
return;
}
$l = 4-$l;
$#s += $l;
}
$r = '';
while ($#s >= 0)
{
$n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
$r .=chr(($n >> 16) ^ 67) .
chr(($n >> 8 & 255) ^ 67) .
chr(($n & 255) ^ 67);
@s = @s[4..$#s];
}
$r = substr($r,0,length($r)-$l);
return $r;
}
sub returns {
my %returneditems;
print "<FONT SIZE=6><em>Circulation: Returns</em></FONT><br>";
foreach ($query->param) {
(next) unless (/ri-(\d*)/);
my $counter=$1;
(next) if ($counter>20);
my $barcode=$query->param("ri-$counter");
# I'm not POSITIVE this decode belongs here - can't tell what causes it to run.
# decode cuecat
chomp($barcode);
@fields = split(/\./,$barcode);
@results = map(decode($_), @fields[1..$#fields]);
if ($#results == 2)
{
$barcode=$results[2];
}
# end decode
my $duedate=$query->param("dd-$counter");
my $borrowernumber=$query->param("bn-$counter");
$counter++;
$returneditems{$counter}=$barcode;
$riduedate{$counter}=$duedate;
$riborrowernumber{$counter}=$borrowernumber;
$ritext.="<input type=hidden name=ri-$counter value=$barcode>\n";
$ritext.="<input type=hidden name=dd-$counter value=$duedate>\n";
$ritext.="<input type=hidden name=bn-$counter value=$borrowernumber>\n";
}
if (my $barcode=$query->param('barcode')) {
# decode cuecat
chomp($barcode);
@fields = split(/\./,$barcode);
@results = map(decode($_), @fields[1..$#fields]);
if ($#results == 2)
{
$barcode=$results[2];
}
# end decode
$ritext.="<input type=hidden name=ri-0 value=$barcode>\n";
$returneditems{0}=$barcode;
}
my $barcodeentrytext= << "EOF";
<form method=post action=/cgi-bin/koha/circ/cirulationold.pl>
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><td colspan=2 bgcolor=$headerbackgroundcolor align=center background=$backgroundimage><font color=black><b>Enter Book Barcode</b></font></td></tr>
<tr><td>Item Barcode:</td><td><input name=barcode size=10></td></tr>
</table>
<input type=hidden name=module value=returns>
<input type=hidden name=branch value=$branch>
<input type=hidden name=printer value=$printer>
$ritext
EOF
if ((my $barcode=$query->param('barcode')) || (%returneditems)) {
# decode cuecat
chomp($barcode);
@fields = split(/\./,$barcode);
@results = map(decode($_), @fields[1..$#fields]);
if ($#results == 2)
{
$barcode=$results[2];
}
# end decode
my ($iteminformation, $borrower, $messages, $overduecharge) = returnbook(\%env, $barcode);
(my $nosuchitem=1) unless ($iteminformation);
$riborrowernumber{0}=$borrower->{'borrowernumber'};
$riduedate{0}=$iteminformation->{'date_due'};
$barcodeentrytext.= "<input type=hidden name=dd-0 value=$iteminformation->{'date_due'}>\n";
$barcodeentrytext.= "<input type=hidden name=bn-0 value=$borrower->{'borrowernumber'}>\n";
my @datearr = localtime(time());
my $todaysdate = (1900+$datearr[5]).'-'.sprintf ("%0.2d", ($datearr[4]+1)).'-'.
sprintf ("%0.2d", $datearr[3]);
my $itemtable=<<"EOF";
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Returned Item Information</font></th></tr>
<tr><td>
Title: $iteminformation->{'title'}<br>
<!--Hlt decided they dont want these showing, uncoment the html to make it work
Author: $iteminformation->{'author'}<br>
Barcode: <a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}&type=intra onClick="openWindow(this, 'Item', 480, 640)">$iteminformation->{'barcode'}</a><br>
Date Due: $iteminformation->{'date_due'}-->
</td></tr>
</table>
EOF
if ($messages) {
my $messagetext='';
foreach (@$messages) {
$messagetext.="$_<p>\n";
}
print << "EOF";
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor $background=$backgroundimage><font color=black>Messages</font></th></tr>
<tr><td>
$messagetext
</td></tr>
</table>
<p>
EOF
}
if (($nosuchitem) && ($barcode)) {
print << "EOF";
<table border=0 cellpadding=1>
<tr>
<td valign=top>
$barcodeentrytext
</td>
<td valign=top>
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Error</font></th></tr>
<tr><td>
<table border=0 cellpadding=5>
<tr><td>
$barcode is not a valid barcode.
</td></tr>
</table>
</td></tr>
</table>
</td>
</tr>
</table>
EOF
} elsif ($nosuchitem) {
print << "EOF";
<table border=0 cellpadding=1>
<tr>
<td valign=top>
$barcodeentrytext
</td>
</tr>
</table>
EOF
} else {
if ($borrower->{'borrowernumber'}) {
my ($patrontable, $flaginfotext) = patrontable($borrower);
print << "EOF";
<table border=0 cellpadding=5>
<tr>
<td>
$barcodeentrytext
</td>
<td align=center valign=top>
$itemtable
</td>
</tr>
<tr>
<td valign=top align=center colspan=2>
<table border=0>
<tr><td valign=top>
$patrontable
</td>
<td valign=top>
$flaginfotext
</td>
</tr>
</table>
</td>
</tr>
</table>
<br>
EOF
} else {
print << "EOF";
<table border=0 cellpadding=5>
<tr><td>
$barcodeentrytext
</td>
<td>
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Error</font></th></tr>
<tr><td>
<table border=0 cellpadding=5>
<tr><td>
$iteminformation->{'title'} by $iteminformation->{'author'} was not loaned out.
</td></tr>
</table>
</td></tr>
</table>
</td>
</tr>
</table>
EOF
}
}
print << "EOF";
<p>
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th colspan=6 bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Returned Items</font></th></tr>
<tr><th>Due Date</th><th>Bar Code</th><th>Title</th><th>Author</th><th>Type</th><th>Borrower</th></tr>
EOF
my $color='';
#set up so only the lat 8 returned items display (make for faster loading pages)
my $count=0;
foreach (sort {$a <=> $b} keys %returneditems) {
if ($count < 8){
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
my $barcode=$returneditems{$_};
my $duedate=$riduedate{$_};
my @datearr = localtime(time());
###
# convert to nz date format
my @tempdate=split(/-/,$duedate);
$duedate="$tempdate[2]/$tempdate[1]/$tempdate[0]";
####
my $todaysdate = (1900+$datearr[5]).'-'.sprintf ("%0.2d", ($datearr[4]+1)).'-'.sprintf ("%0.2d", $datearr[3]);
my $overduetext="$duedate";
($overduetext="<font color=red>$duedate</font>") if ($duedate lt $todaysdate);
($duedate) || ($overduetext="<img src=/koha/images/blackdot.gif>");
my $borrowernumber=$riborrowernumber{$_};
my ($borrower) = getpatroninformation(\%env,$borrowernumber,0);
my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
print "<tr><td bgcolor=$color>$overduetext</td><td bgcolor=$color align=center><a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}&type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$barcode</a></td><td bgcolor=$color>$iteminformation->{'title'}</td><td bgcolor=$color>$iteminformation->{'author'}</td><td bgcolor=$color align=center>$iteminformation->{'itemtype'}</td><td bgcolor=$color><img src=/koha/images/blackdot.gif><a href=/cgi-bin/koha/moremember.pl?bornum=$borrower->{'borrowernumber'} onClick=\"openWindow(this,'Member', 480, 640)\">$borrower->{'cardnumber'}</a> $borrower->{'firstname'} $borrower->{'surname'}</td></tr>\n";
} else {
last
}
$count++;
}
print "</table>\n";
} else {
print $barcodeentrytext;
}
print "</form>\n";
print "</td></tr></table>\n";
}
sub issues {
my ($noheader) = shift;
my $print=$query->param('print');
my $borrowernumber=$query->param('borrnumber');
my $barcode=$query->param('barcode');
if ($barcode eq ''){
$print='yes';
} elsif ($barcode eq ' '){
$query->param('barcode','');
$barcode='';
}
if ($print eq 'yes' && $borrowernumber ne ''){
my ($borrower, $flags) = getpatroninformation(\%env,$borrowernumber,0);
$env{'todaysissues'}=1;
my ($borrowerissues) = currentissues(\%env, $borrower);
$env{'nottodaysissues'}=1;
$env{'todaysissues'}=0;
my ($borroweriss2)=currentissues(\%env, $borrower);
$env{'nottodaysissues'}=0;
my $i=0;
my @issues;
foreach (sort keys %$borrowerissues) {
$issues[$i]=$borrowerissues->{$_};
my $dd=$issues[$i]->{'date_due'};
#convert to nz style dates
#this should be set with some kinda config variable
my @tempdate=split(/-/,$dd);
$issues[$i]->{'date_due'}="$tempdate[2]/$tempdate[1]/$tempdate[0]";
$i++;
}
foreach (sort keys %$borroweriss2) {
$issues[$i]=$borroweriss2->{$_};
my $dd=$issues[$i]->{'date_due'};
#convert to nz style dates
#this should be set with some kinda config variable
my @tempdate=split(/-/,$dd);
$issues[$i]->{'date_due'}="$tempdate[2]/$tempdate[1]/$tempdate[0]";
$i++;
}
remoteprint(\%env,\@issues,$borrower);
$query->param('borrnumber','')
}
unless ($noheader) {
print <<EOF
<p align=right>
<FONT SIZE=2 face="arial, helvetica">
<a href=circulationold.pl?borrnumber=$borrowernumber&module=issues&branch=$branch&printer=$printer&print>Next Borrower</a> ||
<a href=returns.pl>Returns</a> ||
<a href=branchtransfers.pl>Transfers</a></font><p>
</p>
<FONT SIZE=6><em>Circulation: Issues</em></FONT><br>
EOF
}
if (my $borrnumber=$query->param('borrnumber')) {
my ($borrower, $flags) = getpatroninformation(\%env,$borrnumber,0);
my $year=$query->param('year');
my $month=$query->param('month');
my $day=$query->param('day');
if (my $barcode=$query->param('barcode')) {
# decode cuecat
chomp($barcode);
@fields = split(/\./,$barcode);
@results = map(decode($_), @fields[1..$#fields]);
if ($#results == 2)
{
$barcode=$results[2];
}
# end decode
my $invalidduedate=0;
$env{'datedue'}='';
if (($year eq 0) && ($month eq 0) && ($year eq 0)) {
$env{'datedue'}='';
} else {
if (($year eq 0) || ($month eq 0) || ($year eq 0)) {
print "Invalid Due Date Specified. Book was not issued.<p>\n";
$invalidduedate=1;
} else {
if (($day>30) && (($month==4) || ($month==6) || ($month==9) || ($month==11))) {
print "Invalid Due Date Specified. Book was not issued. Only 30 days in $month month.<p>\n";
$invalidduedate=1;
} elsif (($day>29) && ($month==2)) {
print "Invalid Due Date Specified. Book was not issued. Never that many days in February!<p>\n";
$invalidduedate=1;
} elsif (($month==2) && ($day>28) && (($year%4) && ((!($year%100) || ($year%400))))) {
print "Invalid Due Date Specified. Book was not issued. $year is not a leap year.<p>\n";
$invalidduedate=1;
} else {
$env{'datedue'}="$year-$month-$day";
}
}
}
my %responses;
foreach (sort $query->param) {
if ($_ =~ /response-(\d*)/) {
$responses{$1}=$query->param($_);
}
}
if (my $qnumber=$query->param('questionnumber')) {
$responses{$qnumber}=$query->param('answer');
}
unless ($invalidduedate) {
my @time=localtime(time);
my $date= (1900+$time[5])."-".($time[4]+1)."-".$time[3];
my ($iteminformation, $duedate, $rejected, $question, $questionnumber, $defaultanswer, $message) = issuebook(\%env, $borrower, $barcode, \%responses,$date);
unless ($iteminformation) {
print << "EOF";
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Error</font></th></tr>
<tr><td>
<table border=0 cellpadding=5>
<tr><td>
$barcode is not a valid barcode.
</td></tr>
</table>
EOF
}
if ($rejected) {
if ($rejected == -1) {
} else {
print << "EOF"
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th><font color=black size=6>Error Issuing Book</font></th></tr>
<tr><td><font color=red size=6>$rejected</font></td></tr>
</table>
<br>
EOF
}
}
my $responsesform='';
foreach (keys %responses) {
$responsesform.="<input type=hidden name=response-$_ value=$responses{$_}>\n";
}
if ($question) {
my $stickyduedate=$query->param('stickyduedate');
print << "EOF";
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black><b>Issuing Question</b></font></td></tr>
<tr><td>
<table border=0 cellpadding=10>
<tr><td>
Attempting to issue $iteminformation->{'title'} by $iteminformation->{'author'} to $borrower->{'firstname'} $borrower->{'surname'}.
<p>
$question
</td></tr>
</table>
</td></tr>
<tr><td align=center>
<table border=0>
<tr><td>
<form method=get>
<input type=hidden name=module value=issues>
<input type=hidden name=borrnumber value=$borrnumber>
<input type=hidden name=barcode value=$barcode>
<input type=hidden name=questionnumber value=$questionnumber>
<input type=hidden name=day value=$day>
<input type=hidden name=month value=$month>
<input type=hidden name=year value=$year>
<input type=hidden name=stickyduedate value=$stickyduedate>
<input type=hidden name=branch value=$branch>
<input type=hidden name=printer value=$printer>
$responsesform
<input type=hidden name=answer value=Y>
<input type=submit value=Yes>
</form>
</td>
<td>
<form method=get>
<input type=hidden name=module value=issues>
<input type=hidden name=borrnumber value=$borrnumber>
<input type=hidden name=barcode value=$barcode>
<input type=hidden name=questionnumber value=$questionnumber>
<input type=hidden name=day value=$day>
<input type=hidden name=month value=$month>
<input type=hidden name=year value=$year>
<input type=hidden name=stickyduedate value=$stickyduedate>
<input type=hidden name=branch value=$branch>
<input type=hidden name=printer value=$printer>
$responsesform
<input type=hidden name=answer value=N>
<input type=submit value=No>
</form>
</td>
</tr>
</table>
</td></tr>
</table>
</td></tr>
</table>
EOF
return;
}
if ($message) {
print << "EOF";
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Message</font></th></tr>
<tr><td>$message</td></tr>
</table>
<p>
EOF
}
}
}
my $issueid=$query->param('issueid');
($issueid) || ($issueid=int(rand()*1000000000));
my $flag='';
my $flagtext='';
my $flaginfotext='';
foreach $flag (sort keys %$flags) {
if ($flags->{$flag}->{'noissues'}) {
$flagtext.="<font color=red>$flag</font> ";
} else {
$flagtext.="$flag ";
}
$flags->{$flag}->{'message'}=~s/\n/<br>/g;
if ($flags->{$flag}->{'noissues'}) {
$flaginfotext.="<tr><td bgcolor=red valign=top><font color=black><b>$flag</b></font></td><td bgcolor=red><font color=black><b>$flags->{$flag}->{'message'}</b></font></td></tr>\n";
} else {
$flaginfotext.="<tr><td valign=top>$flag</td><td>$flags->{$flag}->{'message'}</td></tr>\n";
}
}
if ($flaginfotext) {
$flaginfotext="<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd><tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage colspan=2><font color=black>Patron Flags</font></th></tr>$flaginfotext</table>\n";
}
$env{'nottodaysissues'}=1;
my ($borrowerissues) = currentissues(\%env, $borrower);
$env{'nottodaysissues'}=0;
$env{'todaysissues'}=1;
my ($today) = currentissues(\%env, $borrower);
$env{'todaysissues'}=0;
my $previssues='';
my @datearr = localtime(time());
my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
my $color='';
foreach (sort keys %$borrowerissues) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
my $bookissue=$borrowerissues->{$_};
my $bgcolor='';
my $datedue=$bookissue->{'date_due'};
my $dd=$bookissue->{'date_due'};
#convert to nz style dates
#this should be set with some kinda config variable
my @tempdate=split(/-/,$dd);
$dd="$tempdate[2]/$tempdate[1]/$tempdate[0]";
#####
$datedue=~s/-//g;
if ($datedue < $todaysdate) {
$dd="<font color=red>$dd</font>\n";
}
$previssues.="<tr><td bgcolor=$color align=center>$dd</td><td bgcolor=$color align=center><a href=/cgi-bin/koha/detail.pl?bib=$bookissue->{'biblionumber'}&type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$bookissue->{'barcode'}</a></td><td bgcolor=$color>$bookissue->{'title'}</td><td bgcolor=$color>$bookissue->{'author'}</td><td bgcolor=$color align=center>$bookissue->{'dewey'} $bookissue->{'subclass'}</td></tr>\n";
}
my $todaysissues='';
$color='';
foreach (sort keys %$today) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
my $bookissue=$today->{$_};
$todaysissues.="<tr><td bgcolor=$color align=center>$bookissue->{'date_due'}</td><td bgcolor=$color align=center><a href=/cgi-bin/koha/detail.pl?bib=$bookissue->{'biblionumber'}&type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$bookissue->{'barcode'}</a></td><td bgcolor=$color>$bookissue->{'title'}</td><td bgcolor=$color>$bookissue->{'author'}</td><td bgcolor=$color align=center>$bookissue->{'dewey'} $bookissue->{'subclass'}</td></tr>\n";
}
for ($i=1; $i<32; $i++) {
my $selected='';
if (($query->param('stickyduedate')) && ($day==$i)) {
$selected='selected';
}
$dayoptions.="<option value=$i $selected>$i";
}
my $counter=1;
foreach (('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')) {
my $selected='';
if (($query->param('stickyduedate')) && ($month==$counter)) {
$selected='selected';
}
$monthoptions.="<option value=$counter $selected>$_";
$counter++;
}
for ($i=$datearr[5]+1900; $i<$datearr[5]+1905; $i++) {
my $selected='';
if (($query->param('stickyduedate')) && ($year==$i)) {
$selected='selected';
}
$yearoptions.="<option value=$i $selected>$i";
}
my $selected='';
($query->param('stickyduedate')) && ($selected='checked');
my ($borrower, $flags) = getpatroninformation(\%env,$borrnumber,0);
my ($patrontable, $flaginfotable) = patrontable($borrower);
print << "EOF";
$patrontable
$flaginfotable
<br> <a href=cirulationold.pl?selectnewbranchprinter=1><b>Branch:</b></a> $branch,
<a href=cirulationold.pl?selectnewbranchprinter=1><b>Printer:</b></a> $printer<P>
<p>
<form method=get>
<table border=1 cellpadding=5>
<tr>
<td align=center valign=top>
<table border=0 cellspacing=0 cellpadding=5>
<tr><th align=center background=$backgroundimage><font color=black><b>Enter Book Barcode</b></font></th></tr>
<tr><td align=center>
<table border=0>
<tr><td>Item Barcode:</td><td><input name=barcode size=10></td><td><input type=submit value=Issue></tr>
<tr><td colspan=3 align=center>
<table border=0 cellpadding=0 cellspacing=0>
<tr><td>
<select name=day><option value=0>Day$dayoptions</select>
</td><td>
<select name=month><option value=0>Month$monthoptions</select>
</td><td>
<select name=year><option value=0>Year$yearoptions</select>
</td></tr>
</table>
<input type=checkbox name=stickyduedate $selected> Sticky Due Date
</td></tr>
</table>
<input type=hidden name=module value=issues>
<input type=hidden name=borrnumber value=$borrnumber>
<input type=hidden name=branch value=$branch>
<input type=hidden name=printer value=$printer>
EOF
;
if ($flags->{'CHARGES'}){
print "<input type=hidden name=charges value=yes>";
}
my $amountold=$flags->{'CHARGES'}->{'message'};
my @temp=split(/\$/,$amountold);
$amountold=$temp[1];
print "<input type=hidden name=oldamount value=$amountold>";
print <<EOF
</form>
</td>
</tr>
</table>
</table>
<p clear=all>
<!-- issues tables-->
<table border=1 cellpadding=5 cellspacing=0 width=90%>
<td colspan=2 align=center>
<table border=0 cellpadding=5 cellspacing=0 width=100% >
<tr><th colspan=5 bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black><b>Issues Today</b></font></th></tr>
<tr><th>Due Date</th><th>Bar Code</th><th>Title</th><th>Author</th><th>Class</th></tr>
$todaysissues
</table>
</td>
</tr>
<tr>
<td colspan=2 align=center>
<table border=0 cellpadding=5 cellspacing=0 width=100%>
<tr><th colspan=5 bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black><b>Previous Issues</b></font></th></tr>
<tr><th>Due Date</th><th>Bar Code</th><th>Title</th><th>Author</th><th>Class</th></tr>
$previssues
</table>
</td>
</tr>
</table>
</td></tr></table>
<p>
EOF
} else {
if (my $findborrower=$query->param('findborrower')) {
my ($borrowers, $flags) = findborrower(\%env, $findborrower);
my @borrowers=@$borrowers;
if ($#borrowers == -1) {
$query->param('findborrower', '');
print "No borrower matched '$findborrower'<p>\n";
issues(1);
return;
}
if ($#borrowers == 0) {
$query->param('borrnumber', $borrowers[0]->{'borrowernumber'});
$query->param('barcode',' ');
issues(1);
return;
} else {
print "<form method=get>\n";
print "<input type=hidden name=module value=issues>\n";
print "<input type=hidden name=branch value=$branch>\n";
print "<input type=hidden name=printer value=$printer>\n";
print "<input type=hidden name=barcode value=\" \">\n";
print "<table border=0 cellspacing=0 cellpadding=5 bgcolor=#dddddd>";
print "<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black><b>Select a borrower</b></font></th></tr>\n";
print "<tr><td align=center>\n";
print "<select name=borrnumber size=7>\n";
foreach (sort {$a->{'surname'}.$a->{'firstname'} cmp $b->{'surname'}.$b->{'firstname'}} @$borrowers) {
print "<option value=$_->{'borrowernumber'}>$_->{'surname'}, $_->{'firstname'} ($_->{'cardnumber'})\n";
}
print "</select><br>";
print "<input type=submit>\n";
print "</td></tr></table>\n";
print "</td></tr></table>\n";
}
} else {
print << "EOF";
<form method=get>
<table border=0 cellpadding=5 cellspacing=0 bgcolor=#dddddd>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black><b>Enter borrower card number<br> or partial last name</b></font></td></tr>
<tr><td><input name=findborrower></td></tr>
</table>
<input type=hidden name=module value=issues>
<input type=hidden name=branch value=$branch>
<input type=hidden name=printer value=$printer>
<input type=hidden name=barcode value=" ">
</form>
</td></tr></table>
EOF
}
}
}
sub patrontable {
my ($borrower) = @_;
my $flags=$borrower->{'flags'};
my $flagtext='';
my $flaginfotable='';
my $flaginfotext='';
my $flag;
foreach $flag (sort keys %$flags) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
if ($flags->{$flag}->{'noissues'}) {
$flagtext.="<font color=red>$flag</font> ";
} else {
$flagtext.="$flag ";
}
$flags->{$flag}->{'message'}=~s/\n/<br>/g;
if ($flags->{$flag}->{'noissues'}) {
if ($flag eq 'CHARGES') {
$flaginfotext.="<tr><td valign=top><font color=red>$flag</font></td><td bgcolor=$color><b>$flags->{$flag}->{'message'}</b> <a href=/cgi-bin/koha/pay.pl?bornum=$borrower->{'borrowernumber'} onClick=\"openWindow(this, 'Payment', 480,640)\">Payment</a></td></tr>\n";
} else {
$flaginfotext.="<tr><td valign=top><font color=red>$flag</font></td><td bgcolor=$color>$flags->{$flag}->{'message'}</td></tr>\n";
}
} else {
if ($flag eq 'CHARGES') {
$flaginfotext.="<tr><td valign=top>$flag</td><td> $flags->{$flag}->{'message'} <a href=/cgi-bin/koha/pay.pl?bornum=$borrower->{'borrowernumber'} onClick=\"openWindow(this, 'Payment', 480,640)\">Payment</a></td></tr>\n";
} elsif ($flag eq 'WAITING') {
my $itemswaiting='';
my $items=$flags->{$flag}->{'itemlist'};
foreach $item (@$items) {
my ($iteminformation) = getiteminformation($env, $item->{'itemnumber'}, 0);
$itemswaiting.="<a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}&type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$iteminformation->{'barcode'}</a> $iteminformation->{'title'} ($branches->{$iteminformation->{'holdingbranch'}}->{'branchname'})<br>\n";
}
$flaginfotext.="<tr><td valign=top>$flag</td><td>$itemswaiting</td></tr>\n";
} elsif ($flag eq 'ODUES') {
my $items=$flags->{$flag}->{'itemlist'};
my $itemswaiting="<table border=0 cellspacing=0 cellpadding=2>\n";
my $currentcolor=$color;
{
my $color=$currentcolor;
foreach $item (@$items) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
my ($iteminformation) = getiteminformation($env, $item->{'itemnumber'}, 0);
$itemswaiting.="<tr><td><font color=red>$iteminformation->{'date_due'}</font></td><td bgcolor=$color><a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}&type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$iteminformation->{'barcode'}</a></td><td>$iteminformation->{'title'}</td></tr>\n";
}
}
$itemswaiting.="</table>\n";
if ($query->param('module') ne 'returns'){
$flaginfotext.="<tr><td valign=top>$flag</td><td>$flags->{$flag}->{'message'}, See below</td></tr>\n";
} else {
$flaginfotext.="<tr><td valign=top>$flag</td><td>$flags->{$flag}->{'message'}</td></tr>\n";
}
} else {
$flaginfotext.="<tr><td valign=top>$flag</td><td>$flags->{$flag}->{'message'}</td></tr>\n";
}
}
}
($flaginfotext) && ($flaginfotext="<tr><td bgcolor=$headerbackgroundcolor background=$backgroundimage colspan=2><b>Flags</b></td></tr>$flaginfotext\n");
$flaginfotext.="</table>";
my $patrontable= << "EOF";
<table border=1
cellpadding=5 cellspacing=0 align=right>
<tr><td bgcolor=$headerbackgroundcolor background=$backgroundimage colspan=2><font color=black><b>Patron Information</b></font></td></tr>
<tr><td colspan=2>
<a href=/cgi-bin/koha/moremember.pl?bornum=$borrower->{'borrowernumber'} onClick="openWindow(this,'Member', 480, 640)">$borrower->{'cardnumber'}</a> $borrower->{'surname'}, $borrower->{'title'} $borrower->{'firstname'}<br>
EOF
if ($query->param('module') ne 'returns'){
$patrontable.="$borrower->{'streetaddress'} $borrower->{'city'} Cat:
$borrower->{'categorycode'} ";
}
$patrontable.=<< "EOF";
</td></tr>
EOF
return($patrontable, $flaginfotext);
}
--- NEW FILE ---
#!/usr/bin/perl
#written 11/3/2002 by Finlay
#script to execute returns of books
use strict;
use CGI;
use C4::Circulation::Circ2;
use C4::Search;
use C4::Output;
my %env;
my $headerbackgroundcolor='#99cc33';
my $circbackgroundcolor='#ffffcc';
my $circbackgroundcolor='white';
my $linecolor1='#ffffcc';
my $linecolor2='white';
my $backgroundimage="/images/background-mem.gif";
my $query=new CGI;
my $branches = getbranches();
my $branch = $query->param("branch");
my $printer = $query->param("printer");
($branch) || ($branch=$query->cookie('branch')) ;
($printer) || ($printer=$query->cookie('printer')) ;
#
# Some code to handle the error if there is no branch or printer setting.....
#
$env{'branchcode'}=$branch;
$env{'printer'}=$printer;
$env{'queue'}=$printer;
# Set up the item stack ....
my $ritext = '';
my %returneditems;
my %riduedate;
my %riborrowernumber;
foreach ($query->param) {
(next) unless (/ri-(\d*)/);
my $counter=$1;
(next) if ($counter>20);
my $barcode=$query->param("ri-$counter");
my $duedate=$query->param("dd-$counter");
my $borrowernumber=$query->param("bn-$counter");
$counter++;
# decode cuecat
$barcode = cuecatbarcodedecode($barcode);
$returneditems{$counter}=$barcode;
$riduedate{$counter}=$duedate;
$riborrowernumber{$counter}=$borrowernumber;
$ritext.="<input type=hidden name=ri-$counter value=$barcode>\n";
$ritext.="<input type=hidden name=dd-$counter value=$duedate>\n";
$ritext.="<input type=hidden name=bn-$counter value=$borrowernumber>\n";
}
my $iteminformation;
my $borrower;
my $returned = 0;
my $messages;
# actually return book (SQL CALL) and prepare item table.....
if (my $barcode = $query->param('barcode')) {
# decode cuecat
$barcode = cuecatbarcodedecode($barcode);
($returned, $messages, $iteminformation, $borrower) = returnbook2(\%env, $barcode);
if ($returned) {
$returneditems{0} = $barcode;
$riborrowernumber{0} = $borrower->{'borrowernumber'};
$riduedate{0} = $iteminformation->{'date_due'};
$ritext.= "<input type=hidden name=ri-0 value=$barcode>\n";
$ritext.= "<input type=hidden name=dd-0 value=$iteminformation->{'date_due'}>\n";
$ritext.= "<input type=hidden name=bn-0 value=$borrower->{'borrowernumber'}>\n";
}
}
##################################################################################
# HTML code....
# title....
my $title = <<"EOF";
<p align=right>
<FONT SIZE=2 face="arial, helvetica">
<a href=circulationold.pl?module=issues&branch=$branch&printer=$printer&print>Next Borrower</a> ||
<a href=returns.pl>Returns</a> ||
<a href=branchtransfers.pl>Transfers</a></font></p>
<FONT SIZE=6><em>Circulation: Returns</em></FONT>
EOF
my $itemtable;
if ($iteminformation) {
$itemtable = <<"EOF";
<table border=1 cellpadding=5 cellspacing=0>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage>
<font color=black>Returned Item Information</font></th></tr>
<tr><td>
Title: $iteminformation->{'title'}<br>
<!--Hlt decided they dont want these showing, uncoment the html to make it work
Author: $iteminformation->{'author'}<br>
Barcode: <a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}
&type=intra onClick="openWindow(this, 'Item', 480, 640)">$iteminformation->{'barcode'}</a><br>
Date Due: $iteminformation->{'date_due'}-->
</td></tr>
</table>
<p>
EOF
}
# Barcode entry box, with hidden inputs attached....
my $barcodeentrytext= << "EOF";
<form method=post action=/cgi-bin/koha/circ/returns.pl>
<table border=1 cellpadding=5 cellspacing=0 align=left>
<tr><td colspan=2 bgcolor=$headerbackgroundcolor align=center background=$backgroundimage>
<font color=black><b>Enter Book Barcode</b></font></td></tr>
<tr><td>Item Barcode:</td><td><input name=barcode size=10></td></tr>
</table>
<input type=hidden name=branch value=$branch>
<input type=hidden name=printer value=$printer>
$ritext
</form>
EOF
# collect the messages and put into message table....
my $messagetable;
if ($messages) {
my $messagetext='';
foreach (@$messages) {
$messagetext .= "$_<br>";
}
$messagetext = substr($messagetext, 0, -4);
if ($messagetext) {
$messagetable = << "EOF";
<table border=1 cellpadding=5 cellspacing=0>
<tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Messages</font></th></tr>
<tr><td>
$messagetext
</td></tr>
</table>
<p>
EOF
}
}
# patrontable ....
my $borrowertable;
if ($borrower) {
my $patrontable = << "EOF";
<table border=1 cellpadding=5 cellspacing=0 align=right>
<tr><td colspan=2 bgcolor=$headerbackgroundcolor background=$backgroundimage>
<font color=black><b>Patron Information</b></font></td></tr>
<tr><td colspan=2>
<a href=/cgi-bin/koha/moremember.pl?bornum=$borrower->{'borrowernumber'}
onClick="openWindow(this,'Member', 480, 640)">$borrower->{'cardnumber'}</a>
$borrower->{'surname'}, $borrower->{'title'} $borrower->{'firstname'}<br>
</td></tr></table>
EOF
my $flags = $borrower->{'flags'};
my $flaginfotext='';
my $flag;
my $color = '';
foreach $flag (sort keys %$flags) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
$flags->{$flag}->{'message'}=~s/\n/<br>/g;
if ($flags->{$flag}->{'noissues'}) {
if ($flag eq 'CHARGES') {
$flaginfotext.= <<"EOF";
<tr><td valign=top><font color=red>$flag</font></td>
<td bgcolor=$color><b>$flags->{$flag}->{'message'}</b>
<a href=/cgi-bin/koha/pay.pl?bornum=$borrower->{'borrowernumber'}
onClick=\"openWindow(this, 'Payment', 480,640)\">Payment</a></td></tr>
EOF
} else {
$flaginfotext.= <<"EOF";
<tr><td valign=top><font color=red>$flag</font></td>
<td bgcolor=$color>$flags->{$flag}->{'message'}</td></tr>
EOF
}
} else {
if ($flag eq 'CHARGES') {
$flaginfotext .= << "EOF";
<tr><td valign=top>$flag</td>
<td> $flags->{$flag}->{'message'} <a href=/cgi-bin/koha/pay.pl?bornum=$borrower->{'borrowernumber'}
onClick=\"openWindow(this, 'Payment', 480,640)\">Payment</a></td></tr>
EOF
} elsif ($flag eq 'WAITING') {
my $itemswaiting='';
my $items = $flags->{$flag}->{'itemlist'};
foreach my $item (@$items) {
my ($iteminformation) = getiteminformation(\%env, $item->{'itemnumber'}, 0);
$itemswaiting .= <<"EOF";
<a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}&type=intra
onClick=\"openWindow(this, 'Item', 480, 640)\">$iteminformation->{'barcode'}</a>
$iteminformation->{'title'} ($branches->{$iteminformation->{'holdingbranch'}}->{'branchname'})<br>
EOF
}
$flaginfotext.="<tr><td valign=top>$flag</td><td>$itemswaiting</td></tr>\n";
} elsif ($flag eq 'ODUES') {
my $items = $flags->{$flag}->{'itemlist'};
$flaginfotext .= <<"EOF";
<tr><td bgcolor=$color><font color=red>$flag</font></td>
<td bgcolor=$color>Patron has Overdue books</td></tr>
EOF
} else {
$flaginfotext .= "<tr><td valign=top>$flag</td><td>$flags->{$flag}->{'message'}</td></tr>\n";
}
}
}
if ($flaginfotext) {
$flaginfotext = << "EOF";
<table border=1 cellpadding=5 cellspacing=0> <tr><td bgcolor=$headerbackgroundcolor background=$backgroundimage colspan=2><b>Flags</b></td></tr>
$flaginfotext
</table>
EOF
}
$borrowertable = << "EOF";
<table border=0 cellpadding=5>
<tr>
<td valign=top>$patrontable</td>
<td valign=top>$flaginfotext</td>
</tr>
</table>
EOF
}
# the returned items.....
my $returneditemstable = << "EOF";
<br><p>
<table border=1 cellpadding=5 cellspacing=0 align=left>
<tr><th colspan=6 bgcolor=$headerbackgroundcolor background=$backgroundimage>
<font color=black>Returned Items</font></th></tr>
<tr><th>Due Date</th><th>Bar Code</th><th>Title</th><th>Author</th><th>Type</th><th>Borrower</th></tr>
EOF
my $color='';
#set up so only the lat 8 returned items display (make for faster loading pages)
my $count=0;
foreach (sort {$a <=> $b} keys %returneditems) {
if ($count < 8) {
($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
my $barcode = $returneditems{$_};
my $duedate = $riduedate{$_};
my @datearr = localtime(time());
###
# convert to nz date format
my @tempdate = split(/-/,$duedate);
$duedate = "$tempdate[2]/$tempdate[1]/$tempdate[0]";
####
my $todaysdate
= (1900+$datearr[5]).'-'.sprintf ("%0.2d", ($datearr[4]+1)).'-'.sprintf ("%0.2d", $datearr[3]);
my $overduetext = "$duedate";
($overduetext="<font color=red>$duedate</font>") if ($duedate lt $todaysdate);
($duedate) || ($overduetext = "<img src=/images/blackdot.gif>");
my $borrowernumber = $riborrowernumber{$_};
my ($borrower) = getpatroninformation(\%env,$borrowernumber,0);
my ($iteminformation) = getiteminformation(\%env, 0, $barcode);;
$returneditemstable .= << "EOF";
<tr><td bgcolor=$color>$overduetext</td>
<td bgcolor=$color align=center>
<a href=/cgi-bin/koha/detail.pl?bib=$iteminformation->{'biblionumber'}&type=intra onClick=\"openWindow(this, 'Item', 480, 640)\">$barcode</a></td>
<td bgcolor=$color>$iteminformation->{'title'}</td>
<td bgcolor=$color>$iteminformation->{'author'}</td>
<td bgcolor=$color align=center>$iteminformation->{'itemtype'}</td>
<td bgcolor=$color>
<a href=/cgi-bin/koha/moremember.pl?bornum=$borrower->{'borrowernumber'} onClick=\"openWindow(this,'Member', 480, 640)\">$borrower->{'cardnumber'}</a> $borrower->{'firstname'} $borrower->{'surname'}</td></tr>
EOF
} else {
last;
}
$count++;
}
$returneditemstable .= "</table>\n";
# actually print the page!
print $query->header();
print startpage();
print startmenu('circulation');
print $title;
# my $flags = $borrower->{'flags'};
# foreach my $key (keys %$flags) {
# print "$key : $flags->{$key} <br> ";
# }
print $barcodeentrytext;
print $messagetable;
if ($returned) {
print $itemtable;
print $borrowertable;
}
(print $returneditemstable) if (%returneditems);
print endmenu('circulation');
print endpage();
sub cuecatbarcodedecode {
my ($barcode) = @_;
chomp($barcode);
my @fields = split(/\./,$barcode);
my @results = map(decode($_), @fields[1..$#fields]);
if ($#results == 2){
return $results[2];
} else {
return $barcode;
}
}
Index: branchtransfers.pl
===================================================================
RCS file: /cvsroot/koha/koha/circ/branchtransfers.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** branchtransfers.pl 14 Mar 2002 01:51:16 -0000 1.3
--- branchtransfers.pl 2 May 2002 00:06:28 -0000 1.4
***************
*** 7,13 ****
use CGI;
use C4::Circulation::Circ2;
- use C4::Search;
use C4::Output;
my %env;
--- 7,14 ----
use CGI;
use C4::Circulation::Circ2;
use C4::Output;
+ ###############################################
+ # constants
my %env;
***************
*** 19,42 ****
my $backgroundimage="/images/background-mem.gif";
my $query=new CGI;
- my $branches=getbranches(\%env);
my $tobranchcd=$query->param('tobranchcd');
my $frbranchcd='';
- $env{'tobranchcd'}=$tobranchcd;
-
my $tobranchoptions;
! foreach (keys %$branches) {
! (next) unless ($_);
! (next) if (/^TR$/);
! my $selected='';
! ($selected='selected') if ($_ eq $tobranchcd);
! $tobranchoptions.="<option value=$_ $selected>$branches->{$_}->{'branchname'}\n";
}
# collect the stack of books already transfered so they can printed...
- my @messages;
my %transfereditems;
my $ritext = '';
--- 20,44 ----
my $backgroundimage="/images/background-mem.gif";
+ my $branches=getbranches();
+
+ ###############################################
+ # Getting state
+
my $query=new CGI;
my $tobranchcd=$query->param('tobranchcd');
my $frbranchcd='';
+ # set up the branchselect options....
my $tobranchoptions;
! foreach my $br (keys %$branches) {
! (next) if $branches->{$br}->{'PE'};
! my $selected='';
! ($selected='selected') if ($br eq $tobranchcd);
! $tobranchoptions.="<option value=$br $selected>$branches->{$br}->{'branchname'}\n";
}
# collect the stack of books already transfered so they can printed...
my %transfereditems;
my $ritext = '';
***************
*** 58,94 ****
}
#if the barcode has been entered action that and write a message and onto the top of the stack...
my $iteminformation;
-
- my $todaysdate;
if (my $barcode=$query->param('barcode')) {
! my $iteminformation = getiteminformation(\%env,0, $barcode);
! my $fail=0;
! if (not $iteminformation) {
! $fail=1;
! @messages = ("There is no book with barcode: $barcode ", @messages);
}
! $frbranchcd = $iteminformation->{'holdingbranch'};
! %env->{'frbranchcd'} = $frbranchcd;
! if ($frbranchcd eq $tobranchcd) {
! $fail=1;
! @messages = ("You can't transfer the book to the branch it is already at!", @messages);
! }
! # should add some more tests ... like is the book already out, maybe it cant be moved....
! if (not $fail) {
! my ($transfered, $message) = transferbook(\%env, $iteminformation, $barcode);
! if (not $transfered) {@messages = ($message, @messages);}
! else {
! $ritext.="<input type=hidden name=bc-0 value=$barcode>\n";
! $ritext.="<input type=hidden name=fb-0 value=$frbranchcd>\n";
! $ritext.="<input type=hidden name=tb-0 value=$tobranchcd>\n";
! $transfereditems{0}=$barcode;
! $frbranchcds{0}=$frbranchcd;
! $tobranchcds{0}=$tobranchcd;
! @messages = ("Book: $barcode has been transfered", @messages);
! }
}
}
my $entrytext= << "EOF";
<form method=post action=/cgi-bin/koha/circ/branchtransfers.pl>
--- 60,89 ----
}
+ # Warnings etc that get displayed at top of next page....
+ my @messages;
+
#if the barcode has been entered action that and write a message and onto the top of the stack...
my $iteminformation;
if (my $barcode=$query->param('barcode')) {
! my $iteminformation = getiteminformation(\%env,0 ,$barcode);
! my ($transfered, $message, $iteminformation) = transferbook($tobranchcd, $barcode);
! if (not $transfered) {
! push(@messages, $message);
}
! else {
! my $frbranchcd = $iteminformation->{'holdingbranch'};
! $ritext.="<input type=hidden name=bc-0 value=$barcode>\n";
! $ritext.="<input type=hidden name=fb-0 value=$frbranchcd>\n";
! $ritext.="<input type=hidden name=tb-0 value=$tobranchcd>\n";
! $transfereditems{0}=$barcode;
! $frbranchcds{0}=$frbranchcd;
! $tobranchcds{0}=$tobranchcd;
! push(@messages, "Book: $barcode has been transfered");
}
}
+ #################################################################################
+ # Html code....
+
my $entrytext= << "EOF";
<form method=post action=/cgi-bin/koha/circ/branchtransfers.pl>
***************
*** 115,137 ****
my $messagetext='';
foreach (@messages) {
! $messagetext.="$_<p>\n";
}
$messagetable = << "EOF";
! <table border=0 cellpadding=5 cellspacing=0 bgcolor='#dddddd'>
! <tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font color=black>Messages</font></th></tr>
<tr><td> $messagetext </td></tr></table>
EOF
}
!
print $query->header;
print startpage;
print startmenu('circulation');
! print "<FONT SIZE=6><em>Circulation: Transfers</em></FONT><br>";
!
!
! print $messagetable if (@messages);
print $entrytext;
--- 110,138 ----
my $messagetext='';
foreach (@messages) {
! $messagetext.="$_<br>";
}
+ $messagetext = substr($messagetext, 0, -4);
$messagetable = << "EOF";
! <table border=1 cellpadding=5 cellspacing=0 bgcolor='#dddddd'>
! <tr><th bgcolor=$headerbackgroundcolor background=$backgroundimage><font>Messages</font></th></tr>
<tr><td> $messagetext </td></tr></table>
EOF
}
! #######################################################################################
! # Make the page .....
print $query->header;
print startpage;
print startmenu('circulation');
! print <<"EOF";
! <p align=right>
! <FONT SIZE=2 face="arial, helvetica">
! <a href=circulationold.pl?module=issues>Next Borrower</a> ||
! <a href=returns.pl>Returns</a> ||
! <a href=branchtransfers.pl>Transfers</a></font></p><FONT SIZE=6><em>Circulation: Transfers</em></FONT><br>
! EOF
+ print $messagetable;
print $entrytext;
Index: circulation.pl
===================================================================
RCS file: /cvsroot/koha/koha/circ/circulation.pl,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -r1.23 -r1.24
*** circulation.pl 14 Mar 2002 01:50:17 -0000 1.23
--- circulation.pl 2 May 2002 00:06:28 -0000 1.24
***************
*** 1,4 ****
--- 1,5 ----
#!/usr/bin/perl
+ use strict;
use CGI qw/:standard/;
use C4::Circulation::Circ2;
***************
*** 8,12 ****
[...1030 lines suppressed...]
! <table border=1 cellpadding=5 cellspacing=0>
! <tr><td colspan=2 bgcolor=$headerbackgroundcolor align=center background=$backgroundimage>
! <font color=black><b>Please Set Branch and Printer</b></font></td></tr>
! <tr><td>
! $branchform
! </td>
! <td>
! $printerform
! </td></tr>
! </table>
! <input type="submit" value="Change Settings" type="changesettings">
! </form>
!
EOF
}
+
+ print endmenu('circulation');
+ print endpage();
+
1
0
Update of /cvsroot/koha/koha/C4/Circulation
In directory usw-pr-cvs1:/tmp/cvs-serv15441/C4/Circulation
Modified Files:
Circ2.pm
Log Message:
moredetail.pl presents circulation information taken from the
branchtransfers table
Circ2.pm has been changed a little
admin/branches.pl alows branches to be added, edited and deleted.
updatedatabase needs more fixing
Index: Circ2.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -r1.21 -r1.22
*** Circ2.pm 13 Mar 2002 21:13:42 -0000 1.21
--- Circ2.pm 2 May 2002 00:08:53 -0000 1.22
***************
*** 5,8 ****
--- 5,9 ----
use strict;
+ # use warnings;
require Exporter;
use DBI;
***************
*** 24,29 ****
@ISA = qw(Exporter);
! @EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook
! &find_reserves &transferbook);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
--- 25,29 ----
@ISA = qw(Exporter);
! @EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook &returnbook2 &find_reserves &transferbook &decode);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
***************
*** 63,67 ****
sub getbranches {
! my ($env) = @_;
my %branches;
my $dbh=&C4Connect;
--- 63,67 ----
sub getbranches {
! # returns a reference to a hash of references to branches...
my %branches;
my $dbh=&C4Connect;
***************
*** 69,73 ****
$sth->execute;
while (my $branch=$sth->fetchrow_hashref) {
! # (next) if ($branch->{'branchcode'} eq 'TR');
$branches{$branch->{'branchcode'}}=$branch;
}
--- 69,80 ----
$sth->execute;
while (my $branch=$sth->fetchrow_hashref) {
! my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp);
! my $query = "select categorycode from branchrelations where branchcode = $brc";
! my $nsth = $dbh->prepare($query);
! $nsth->execute;
! while (my ($cat) = $nsth->fetchrow_array) {
! $branch->{$cat} = 1;
! }
! $nsth->finish;
$branches{$branch->{'branchcode'}}=$branch;
}
***************
*** 96,115 ****
my ($env, $borrowernumber,$cardnumber) = @_;
my $dbh=&C4Connect;
my $sth;
open O, ">>/root/tkcirc.out";
print O "Looking up patron $borrowernumber / $cardnumber\n";
if ($borrowernumber) {
! $sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber");
} elsif ($cardnumber) {
! $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber");
} else {
! # error condition. This subroutine must be called with either a
! # borrowernumber or a card number.
! $env->{'apierror'}="invalid borrower information passed to getpatroninformation subroutine";
! return();
}
$sth->execute;
! my $borrower=$sth->fetchrow_hashref;
! my $flags=patronflags($env, $borrower, $dbh);
$sth->finish;
$dbh->disconnect;
--- 103,123 ----
my ($env, $borrowernumber,$cardnumber) = @_;
my $dbh=&C4Connect;
+ my $query;
my $sth;
open O, ">>/root/tkcirc.out";
print O "Looking up patron $borrowernumber / $cardnumber\n";
if ($borrowernumber) {
! $query = "select * from borrowers where borrowernumber=$borrowernumber";
} elsif ($cardnumber) {
! $query = "select * from borrowers where cardnumber=$cardnumber";
} else {
! $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
! return();
}
+ $env->{'mess'} = $query;
+ $sth = $dbh->prepare($query);
$sth->execute;
! my $borrower = $sth->fetchrow_hashref;
! my $flags = patronflags($env, $borrower, $dbh);
$sth->finish;
$dbh->disconnect;
***************
*** 120,123 ****
--- 128,158 ----
}
+ sub decode {
+ my ($encoded) = @_;
+ my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
+ my @s = map { index($seq,$_); } split(//,$encoded);
+ my $l = ($#s+1) % 4;
+ if ($l)
+ {
+ if ($l == 1)
+ {
+ print "Error!";
+ return;
+ }
+ $l = 4-$l;
+ $#s += $l;
+ }
+ my $r = '';
+ while ($#s >= 0)
+ {
+ my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
+ $r .=chr(($n >> 16) ^ 67) .
+ chr(($n >> 8 & 255) ^ 67) .
+ chr(($n & 255) ^ 67);
+ @s = @s[4..$#s];
+ }
+ $r = substr($r,0,length($r)-$l);
+ return $r;
+ }
***************
*** 188,205 ****
sub transferbook {
! my ($env, $iteminformation, $barcode) = @_;
! my $messages;
my $dbh=&C4Connect;
#new entry in branchtransfers....
! my $sth = $dbh->prepare("insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) values($iteminformation->{'itemnumber'}, '$env->{'frbranchcd'}', now(), '$env->{'tobranchcd'}')");
! $sth->execute || return (0,"database error: $sth->errstr");
$sth->finish;
#update holdingbranch in items .....
! $sth = $dbh->prepare("update items set holdingbranch='$env->{'tobranchcd'}' where items.itemnumber=$iteminformation->{'itemnumber'}");
! $sth->execute || return (0,"database error: $sth->errstr");
! $sth->execute;
$sth->finish;
$dbh->disconnect;
! return (1, $messages);
}
--- 223,266 ----
sub transferbook {
! # transfer book code....
! my ($tbr, $barcode) = @_;
! my $message = "";
! my %env;
! my $branches = getbranches();
! my $iteminformation = getiteminformation(\%env,0, $barcode);
! if (not $iteminformation) {
! $message = "<font color='red' size='+2'>There is no book with barcode: $barcode </font>";
! return (0, $message, 0);
! }
! my $fbr = $iteminformation->{'holdingbranch'};
! if ($branches->{$fbr}->{'PE'}) {
! $message = "<font color='red' size='+2'>You cannot transfer a book that is in a permanant branch.</font>";
! return (0, $message, $iteminformation);
! }
! if ($fbr eq $tbr) {
! $message = "<font color='red' size='+2'>You can't transfer the book to the branch it is already at! </font>";
! return (0, $message, $iteminformation);
! }
my $dbh=&C4Connect;
+ my ($currentborrower) = currentborrower(\%env, $iteminformation->{'itemnumber'}, $dbh);
+ if ($currentborrower) {
+ $message = "<font color='red' size='+2'>Book cannot be transfered bracause it is currently on loan to: $currentborrower . Please return book first.</font>";
+ return (0, $message, $iteminformation);
+ }
+ my $itm = $dbh->quote($iteminformation->{'itemnumber'});
+ $fbr = $dbh->quote($fbr);
+ $tbr = $dbh->quote($tbr);
#new entry in branchtransfers....
! my $query = "insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) values($itm, $fbr, now(), $tbr)";
! my $sth = $dbh->prepare($query);
! $sth->execute;
$sth->finish;
#update holdingbranch in items .....
! $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm";
! $sth = $dbh->prepare($query);
! $sth->execute;
$sth->finish;
$dbh->disconnect;
! return (1, $message, $iteminformation);
}
***************
*** 396,400 ****
# check for overdue fine
- $overduecharge;
$sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')");
$sth->execute;
--- 457,460 ----
***************
*** 407,412 ****
}
$sth->finish;
! }
! if ($iteminformation->{'itemlost'} eq '1'){
# check for charge made for lost book
my $query="select * from accountlines where (itemnumber =
--- 467,472 ----
}
$sth->finish;
! }
! if ($iteminformation->{'itemlost'} eq '1'){
# check for charge made for lost book
my $query="select * from accountlines where (itemnumber =
***************
*** 518,582 ****
sub patronflags {
# Original subroutine for Circ2.pm
my %flags;
! my ($env,$patroninformation,$dbh) = @_;
! my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh);
if ($amount > 0) {
my %flaginfo;
! $flaginfo{'message'}=sprintf "Patron owes \$%.02f", $amount;
! if ($amount>5) {
! $flaginfo{'noissues'}=1;
}
! $flags{'CHARGES'}=\%flaginfo;
} elsif ($amount < 0){
my %flaginfo;
! $amount=$amount*-1;
! $flaginfo{'message'}=sprintf "Patron has credit of \$%.02f", $amount;
! $flags{'CHARGES'}=\%flaginfo;
}
if ($patroninformation->{'gonenoaddress'} == 1) {
my %flaginfo;
! $flaginfo{'message'}='Borrower has no valid address.';
! $flaginfo{'noissues'}=1;
! $flags{'GNA'}=\%flaginfo;
}
if ($patroninformation->{'lost'} == 1) {
my %flaginfo;
! $flaginfo{'message'}='Borrower\'s card reported lost.';
! $flaginfo{'noissues'}=1;
! $flags{'LOST'}=\%flaginfo;
}
if ($patroninformation->{'debarred'} == 1) {
my %flaginfo;
! $flaginfo{'message'}='Borrower is Debarred.';
! $flaginfo{'noissues'}=1;
! $flags{'DBARRED'}=\%flaginfo;
}
if ($patroninformation->{'borrowernotes'}) {
my %flaginfo;
! $flaginfo{'message'}="$patroninformation->{'borrowernotes'}";
! $flags{'NOTES'}=\%flaginfo;
}
! my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh);
if ($odues > 0) {
my %flaginfo;
! $flaginfo{'message'}="Yes";
! $flaginfo{'itemlist'}=$itemsoverdue;
foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
$flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
}
! $flags{'ODUES'}=\%flaginfo;
}
! my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'});
! if ($nowaiting>0) {
my %flaginfo;
! $flaginfo{'message'}="Reserved items available";
! $flaginfo{'itemlist'}=$itemswaiting;
! $flaginfo{'itemfields'}=['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch'];
! $flags{'WAITING'}=\%flaginfo;
}
- my $flag;
- my $key;
return(\%flags);
}
--- 578,798 ----
+
+ sub returnbook2 {
+ my ($env, $barcode) = @_;
+ my @messages;
+ my $dbh=&C4Connect;
+ # get information on item
+ my ($iteminformation) = getiteminformation($env, 0, $barcode);
+ if (not $iteminformation) {
+ push(@messages, "<font color='red' size='+2'> There is no book with barcode: $barcode </font>");
+ return (0, \@messages, 0 ,0);
+ }
+ # updatelastseen($env, $dbh, $iteminformation->{'itemnumber'});
+
+ # find the borrower
+ my $borrower;
+ my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh);
+ if (not $currentborrower) {
+ push(@messages, "<font color='red' size='+2'>Book: $barcode is not currently issued.</font>");
+ return (0, \@messages, 0,0);
+ }
+ # update issues, thereby returning book (should push this out into another subroutine
+ ($borrower) = getpatroninformation($env, $currentborrower, 0);
+ my $query = "update issues set returndate = now()
+ where (borrowernumber = '$borrower->{'borrowernumber'}')
+ and (itemnumber = '$iteminformation->{'itemnumber'}') and (returndate is null)";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ $sth->finish;
+ push(@messages, "Book has been returned.");
+
+ my $tbr = $env->{'branchcode'};
+ my ($transfered, $message, $item) = transferbook($tbr, $barcode);
+ if ($transfered) {
+ push(@messages, "Book: as been transfered.");
+ }
+
+ if ($iteminformation->{'itemlost'}) {
+ updateitemlost($dbh, $iteminformation->{'itemnumber'});
+ # check for charge made for lost book
+ my $query = "select * from accountlines where (itemnumber = '$iteminformation->{'itemnumber'}')
+ and (accounttype='L' or accounttype='Rep') order by date desc";
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ if (my $data = $sth->fetchrow_hashref) {
+ # writeoff this amount
+ my $offset;
+ my $amount = $data->{'amount'};
+ my $acctno = $data->{'accountno'};
+ my $amountleft;
+ if ($data->{'amountoutstanding'} == $amount) {
+ $offset = $data->{'amount'};
+ $amountleft = 0;
+ } else {
+ $offset = $amount - $data->{'amountoutstanding'};
+ $amountleft = $data->{'amountoutstanding'} - $amount;
+ }
+ my $uquery = "update accountlines
+ set accounttype = 'LR',amountoutstanding='0'
+ where (borrowernumber = '$data->{'borrowernumber'}')
+ and (itemnumber = '$iteminformation->{'itemnumber'}')
+ and (accountno = '$acctno') ";
+ my $usth = $dbh->prepare($uquery);
+ $usth->execute;
+ $usth->finish;
+ #check if any credit is left if so writeoff other accounts
+ my $nextaccntno = getnextacctno($env,$data->{'borrowernumber'},$dbh);
+ if ($amountleft < 0){
+ $amountleft*=-1;
+ }
+ if ($amountleft > 0){
+ my $query = "select * from accountlines
+ where (borrowernumber = '$data->{'borrowernumber'}') and (amountoutstanding >0)
+ order by date";
+ my $msth = $dbh->prepare($query);
+ $msth->execute;
+ # offset transactions
+ my $newamtos;
+ my $accdata;
+ while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){
+ if ($accdata->{'amountoutstanding'} < $amountleft) {
+ $newamtos = 0;
+ $amountleft = $amountleft - $accdata->{'amountoutstanding'};
+ } else {
+ $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
+ $amountleft = 0;
+ }
+ my $thisacct = $accdata->{accountno};
+ my $updquery = "update accountlines set amountoutstanding= '$newamtos'
+ where (borrowernumber = '$data->{'borrowernumber'}') and (accountno='$thisacct')";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ $updquery = "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values
+ ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')";
+ my $usth = $dbh->prepare($updquery);
+ $usth->execute;
+ $usth->finish;
+ }
+ $msth->finish;
+ }
+ if ($amountleft > 0){
+ $amountleft*=-1;
+ }
+ my $desc="Book Returned ".$iteminformation->{'barcode'};
+ $uquery = "insert into accountlines
+ (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
+ values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc',
+ 'CR',$amountleft)";
+ $usth = $dbh->prepare($uquery);
+
+ $usth->execute;
+ $usth->finish;
+ $uquery = "insert into accountoffsets
+ (borrowernumber, accountno, offsetaccount, offsetamount)
+ values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)";
+ $usth = $dbh->prepare($uquery);
+ $usth->execute;
+ $usth->finish;
+ $uquery="update items set paidfor='' where itemnumber='$iteminformation->{'itemnumber'}'";
+ $usth = $dbh->prepare($uquery);
+ $usth->execute;
+ $usth->finish;
+ }
+ $sth->finish;
+ }
+
+ # check for overdue fine
+ my $query = "select * from accountlines where (borrowernumber='$borrower->{'borrowernumber'}')
+ and (itemnumber = '$iteminformation->{'itemnumber'}') and (accounttype='FU' or accounttype='O')";
+ $sth = $dbh->prepare($query);
+ $sth->execute;
+ # alter fine to show that the book has been returned
+ if (my $data = $sth->fetchrow_hashref) {
+ my $query = "update accountlines set accounttype='F'
+ where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'})
+ and (acccountno='$data->{'accountno'}')";
+ my $usth=$dbh->prepare($query);
+ $usth->execute();
+ $usth->finish();
+ }
+ $sth->finish;
+
+ my ($resfound, $resrec) = find_reserves($env, $dbh, $iteminformation->{'itemnumber'});
+ if ($resfound eq 'y') {
+ my ($borrower) = getpatroninformation($env,$resrec->{'borrowernumber'},0);
+ my ($branches) = getbranches();
+ my $branchname = $branches->{$resrec->{'branchcode'}}->{'branchname'};
+ push(@messages, "<b><font color=red>RESERVED</font></b> for collection by $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'}) at $branchname");
+ }
+ UpdateStats($env,$env->{'branchcode'},'return','0','',$iteminformation->{'itemnumber'});
+ $dbh->disconnect;
+ return (1, \@messages, $iteminformation, $borrower);
+ }
+
+
+
sub patronflags {
# Original subroutine for Circ2.pm
my %flags;
! my ($env, $patroninformation, $dbh) = @_;
! my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
if ($amount > 0) {
my %flaginfo;
! $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount;
! if ($amount > 5) {
! $flaginfo{'noissues'} = 1;
}
! $flags{'CHARGES'} = \%flaginfo;
} elsif ($amount < 0){
my %flaginfo;
! $amount = $amount*-1;
! $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount;
! $flags{'CHARGES'} = \%flaginfo;
}
if ($patroninformation->{'gonenoaddress'} == 1) {
my %flaginfo;
! $flaginfo{'message'} = 'Borrower has no valid address.';
! $flaginfo{'noissues'} = 1;
! $flags{'GNA'} = \%flaginfo;
}
if ($patroninformation->{'lost'} == 1) {
my %flaginfo;
! $flaginfo{'message'} = 'Borrower\'s card reported lost.';
! $flaginfo{'noissues'} = 1;
! $flags{'LOST'} = \%flaginfo;
}
if ($patroninformation->{'debarred'} == 1) {
my %flaginfo;
! $flaginfo{'message'} = 'Borrower is Debarred.';
! $flaginfo{'noissues'} = 1;
! $flags{'DBARRED'} = \%flaginfo;
}
if ($patroninformation->{'borrowernotes'}) {
my %flaginfo;
! $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
! $flags{'NOTES'} = \%flaginfo;
}
! my ($odues, $itemsoverdue) = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh);
if ($odues > 0) {
my %flaginfo;
! $flaginfo{'message'} = "Yes";
! $flaginfo{'itemlist'} = $itemsoverdue;
foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) {
$flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n";
}
! $flags{'ODUES'} = \%flaginfo;
}
! my ($nowaiting, $itemswaiting) = checkwaiting($env, $dbh, $patroninformation->{'borrowernumber'});
! if ($nowaiting > 0) {
my %flaginfo;
! $flaginfo{'message'} = "Reserved items available";
! $flaginfo{'itemlist'} = $itemswaiting;
! $flaginfo{'itemfields'} = ['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch'];
! $flags{'WAITING'} = \%flaginfo;
}
return(\%flags);
}
***************
*** 604,612 ****
sub updatelastseen {
# Stolen from Returns.pm
! my ($env,$dbh,$itemnumber)= @_;
! my $br = $env->{'branchcode'};
! my $query = "update items
! set datelastseen = now(), holdingbranch = '$br'
! where (itemnumber = '$itemnumber')";
my $sth = $dbh->prepare($query);
$sth->execute;
--- 820,828 ----
sub updatelastseen {
# Stolen from Returns.pm
! my ($env, $dbh, $itemnumber) = @_;
! my $brc = $env->{'branchcode'};
! $brc = $dbh->quote($brc);
! my $itm = $dbh->quote($itemnumber);
! my $query = "update items set datelastseen = now(), holdingbranch = $brc where (itemnumber = $itm)";
my $sth = $dbh->prepare($query);
$sth->execute;
***************
*** 617,621 ****
# Original subroutine for Circ2.pm
my ($env, $itemnumber, $dbh) = @_;
! my $q_itemnumber=$dbh->quote($itemnumber);
my $sth=$dbh->prepare("select borrowers.borrowernumber from
issues,borrowers where issues.itemnumber=$q_itemnumber and
--- 833,837 ----
# Original subroutine for Circ2.pm
my ($env, $itemnumber, $dbh) = @_;
! my $q_itemnumber = $dbh->quote($itemnumber);
my $sth=$dbh->prepare("select borrowers.borrowernumber from
issues,borrowers where issues.itemnumber=$q_itemnumber and
***************
*** 623,627 ****
NULL");
$sth->execute;
! my ($previousborrower)=$sth->fetchrow;
return($previousborrower);
}
--- 839,843 ----
NULL");
$sth->execute;
! my ($previousborrower) = $sth->fetchrow;
return($previousborrower);
}
1
0
Update of /cvsroot/koha/koha/C4
In directory usw-pr-cvs1:/tmp/cvs-serv15441/C4
Modified Files:
Search.pm
Log Message:
moredetail.pl presents circulation information taken from the
branchtransfers table
Circ2.pm has been changed a little
admin/branches.pl alows branches to be added, edited and deleted.
updatedatabase needs more fixing
Index: Search.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Search.pm,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -r1.18 -r1.19
*** Search.pm 10 Apr 2002 09:55:17 -0000 1.18
--- Search.pm 2 May 2002 00:08:53 -0000 1.19
***************
*** 962,966 ****
sub itemissues {
! my ($bibitem,$biblio)=@_;
my $dbh=C4Connect;
my $query="Select * from items where
--- 962,966 ----
sub itemissues {
! my ($bibitem, $biblio)=@_;
my $dbh=C4Connect;
my $query="Select * from items where
1
0
Update of /cvsroot/koha/koha/admin
In directory usw-pr-cvs1:/tmp/cvs-serv15441/admin
Modified Files:
branches.pl
Log Message:
moredetail.pl presents circulation information taken from the
branchtransfers table
Circ2.pm has been changed a little
admin/branches.pl alows branches to be added, edited and deleted.
updatedatabase needs more fixing
Index: branches.pl
===================================================================
RCS file: /cvsroot/koha/koha/admin/branches.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** branches.pl 5 Mar 2002 20:48:42 -0000 1.1
--- branches.pl 2 May 2002 00:08:53 -0000 1.2
***************
*** 1,280 ****
#!/usr/bin/perl
! #script to administer the aqbudget table
! #written 20/02/2002 by paul.poulain(a)free.fr
! # This software is placed under the gnu General Public License, v2 (http://www.gnu.org/licenses/gpl.html)
!
! # ALGO :
! # this script use an $op to know what to do.
! # if $op is empty or none of the above values,
! # - the default screen is build (with all records, or filtered datas).
! # - the user can clic on add, modify or delete record.
! # if $op=add_form
! # - if primkey exists, this is a modification,so we read the $primkey record
! # - builds the add/modify form
! # if $op=add_validate
! # - the user has just send datas, so we create/modify the record
! # if $op=delete_form
! # - we show the record having primkey=$primkey and ask for deletion validation form
! # if $op=delete_confirm
! # - we delete the record having primkey=$primkey
use strict;
- use C4::Output;
use CGI;
! use C4::Search;
use C4::Database;
! sub StringSearch {
! my ($env,$searchstring,$type)=@_;
! my $dbh = &C4Connect;
! $searchstring=~ s/\'/\\\'/g;
! my @data=split(' ',$searchstring);
! my $count=@data;
! my $query="Select branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing from branches where (branchcode like \"$data[0]%\") order by branchcode";
! my $sth=$dbh->prepare($query);
! $sth->execute;
! my @results;
! my $cnt=0;
! while (my $data=$sth->fetchrow_hashref){
! push(@results,$data);
! $cnt ++;
! }
! # $sth->execute;
! $sth->finish;
! $dbh->disconnect;
! return ($cnt,\@results);
! }
!
! my $input = new CGI;
! my $searchfield=$input->param('searchfield');
! my $pkfield="branchcode";
! my $reqsel="select branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing from branches where branchcode='$searchfield'";
! my $reqdel="delete from branches where branchcode='$searchfield'";
! #my $branchcode=$input->param('branchcode');
! my $offset=$input->param('offset');
my $script_name="/cgi-bin/koha/admin/branches.pl";
-
my $pagesize=20;
my $op = $input->param('op');
! $searchfield=~ s/\,//g;
print $input->header;
! #start the page and read in includes
print startpage();
print startmenu('admin');
! ################## ADD_FORM ##################################
! # called by default. Used to create form to add or modify a record
! if ($op eq 'add_form') {
! #---- if primkey exists, it's a modify action, so read values to modify...
! my $data;
! if ($searchfield) {
! my $dbh = &C4Connect;
! my $sth=$dbh->prepare("select branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing from branches where branchcode='$searchfield'");
! $sth->execute;
! $data=$sth->fetchrow_hashref;
! $sth->finish;
! }
! print <<printend
! <script>
! /////////////////////////////////////////////////////////////////////////////////////////////////////////////////
! function isNotNull(f,noalert) {
! if (f.value.length ==0) {
! return false;
! }
! return true;
! }
! /////////////////////////////////////////////////////////////////////////////////////////////////////////////////
! function toUC(f) {
! var x=f.value.toUpperCase();
! f.value=x;
! return true;
! }
! /////////////////////////////////////////////////////////////////////////////////////////////////////////////////
! function isNum(v,maybenull) {
! var n = new Number(v.value);
! if (isNaN(n)) {
! return false;
! }
! if (maybenull==0 && v.value=='') {
! return false;
! }
! return true;
! }
! /////////////////////////////////////////////////////////////////////////////////////////////////////////////////
! function isDate(f) {
! var t = Date.parse(f.value);
! if (isNaN(t)) {
! return false;
! }
! }
! /////////////////////////////////////////////////////////////////////////////////////////////////////////////////
! function Check(f) {
! var ok=1;
! var _alertString="";
! var alertString2;
! if (f.searchfield.value.length==0) {
! _alertString += "- branch code missing\\n";
! }
! if (f.branchname.value.length==0) {
! _alertString += "- branch name missing\\n";
! }
! if (_alertString.length==0) {
! document.Aform.submit();
! } else {
! alertString2 = "Form not submitted because of the following problem(s)\\n";
! alertString2 += "------------------------------------------------------------------------------------\\n\\n";
! alertString2 += _alertString;
! alert(alertString2);
! }
! }
! </SCRIPT>
! printend
! ;#/
! if ($searchfield) {
! print "<h1>Modify branch</h1>";
! } else {
! print "<h1>Add branch</h1>";
! }
! print "<form action='$script_name' name=Aform method=post>";
! print "<input type=hidden name=op value='add_validate'>";
! print "<table>";
! if ($searchfield) {
! print "<tr><td>Branch code</td><td><input type=hidden name=searchfield value=$searchfield>$searchfield</td></tr>";
! } else {
! print "<tr><td>Branch code</td><td><input type=text name=searchfield size=5 maxlength=5 onBlur=toUC(this)></td></tr>";
! }
! print "<tr><td>Name</td><td><input type=text name=branchname size=40 maxlength=80 value='$data->{'branchname'}'> </td></tr>";
! print "<tr><td>Adress</td><td><input type=text name=branchaddress1 value='$data->{'branchaddress1'}'></td></tr>";
! print "<tr><td> </td><td><input type=text name=branchaddress2 value='$data->{'branchaddress2'}'></td></tr>";
! print "<tr><td> </td><td><input type=text name=branchaddress3 value='$data->{'branchaddress3'}'></td></tr>";
! print "<tr><td>Phone</td><td><input type=text name=branchphone value='$data->{'branchphone'}'></td></tr>";
! print "<tr><td>Fax</td><td><input type=text name=branchfax value='$data->{'branchfax'}'></td></tr>";
! print "<tr><td>E-mail</td><td><input type=text name=branchemail value='$data->{'branchemail'}'></td></tr>";
! print "<tr><td>Issuing</td><td><input type=text name=issuing value='$data->{'issuing'}'></td></tr>";
! print "<tr><td> </td><td><INPUT type=button value='OK' onClick='Check(this.form)'></td></tr>";
! print "</table>";
! print "</form>";
! ;
! # END $OP eq ADD_FORM
! ################## ADD_VALIDATE ##################################
! # called by add_form, used to insert/modify data in DB
} elsif ($op eq 'add_validate') {
! my $dbh=C4Connect;
! my $query = "replace branches (branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing) values (";
! $query.= $dbh->quote($input->param('branchcode')).",";
! $query.= $dbh->quote($input->param('branchname')).",";
! $query.= $dbh->quote($input->param('branchaddress1')).",";
! $query.= $dbh->quote($input->param('branchaddress2')).",";
! $query.= $dbh->quote($input->param('branchaddress3')).",";
! $query.= $dbh->quote($input->param('branchphone')).",";
! $query.= $dbh->quote($input->param('branchfax')).",";
! $query.= $dbh->quote($input->param('branchemail')).",";
! $query.= $dbh->quote($input->param('issuing')).")";
! my $sth=$dbh->prepare($query);
! $sth->execute;
! $sth->finish;
! print "data recorded";
! print "<form action='$script_name' method=post>";
! print "<input type=submit value=OK>";
! print "</form>";
! # END $OP eq ADD_VALIDATE
! ################## DELETE_CONFIRM ##################################
! # called by default form, used to confirm deletion of data in DB
! } elsif ($op eq 'delete_confirm') {
! my $dbh = &C4Connect;
! my $sth=$dbh->prepare("select count(*) as total from borrowers where branchcode='$searchfield'");
! $sth->execute;
! my $total = $sth->fetchrow_hashref;
! $sth->finish;
! print "$reqsel";
! my $sth=$dbh->prepare($reqsel);
$sth->execute;
- my $data=$sth->fetchrow_hashref;
$sth->finish;
! print mktablehdr;
! print mktablerow(2,'#99cc33',bold('Branch code'),bold("$searchfield"),'/images/background-mem.gif');
! print "<form action='$script_name' method=post><input type=hidden name=op value=delete_confirmed><input type=hidden name=searchfield value='$searchfield'>";
! print "<tr><td>Branch code</td><td>$data->{'branchcode'}</td></tr>";
! print "<tr><td> name</td><td>$data->{'branchname'}</td></tr>";
! print "<tr><td> adress</td><td>$data->{'branchaddress1'}</td></tr>";
! print "<tr><td> </td><td>$data->{'branchaddress2'}</td></tr>";
! print "<tr><td> </td><td>$data->{'branchaddress3'}</td></tr>";
! print "<tr><td> phone</td><td>$data->{'branchphone'}</td></tr>";
! print "<tr><td> fax</td><td>$data->{'branchfax'}</td></tr>";
! print "<tr><td> e-mail</td><td>$data->{'branchemail'}</td></tr>";
! print "<tr><td> issuing</td><td>$data->{'issuing'}</td></tr>";
! if ($total->{'total'} >0) {
! print "<tr><td colspan=2 align=center><b>This record is used $total->{'total'} times. Deletion not possible</b></td></tr>";
! print "<tr><td colspan=2></form><form action='$script_name' method=post><input type=submit value=OK></form></td></tr>";
! } else {
! print "<tr><td colspan=2 align=center>CONFIRM DELETION</td></tr>";
! print "<tr><td><INPUT type=submit value='YES'></form></td><td><form action='$script_name' method=post><input type=submit value=NO></form></td></tr>";
! }
! # END $OP eq DELETE_CONFIRM
! ################## DELETE_CONFIRMED ##################################
! # called by delete_confirm, used to effectively confirm deletion of data in DB
! } elsif ($op eq 'delete_confirmed') {
! my $dbh=C4Connect;
! # my $searchfield=$input->param('branchcode');
! my $sth=$dbh->prepare($reqdel);
$sth->execute;
$sth->finish;
! print "data deleted";
! print "<form action='$script_name' method=post>";
! print "<input type=submit value=OK>";
! print "</form>";
! # END $OP eq DELETE_CONFIRMED
! ################## DEFAULT ##################################
! } else { # DEFAULT
! my @inputs=(["text","searchfield",$searchfield],
! ["reset","reset","clr"]);
! print mkheadr(2,'branches admin');
! print mkformnotable("$script_name",@inputs);
! print <<printend
!
! printend
! ;
! if ($searchfield ne '') {
! print "You Searched for <b>$searchfield<b><p>";
! }
! print mktablehdr;
! print mktablerow(9,'#99cc33',bold('Branch code'),bold('name'),bold('adress'),
! bold('phone'),bold('fax'),bold('mail'),bold('issuing'),
! ' ',' ','/images/background-mem.gif');
! my $env;
! my ($count,$results)=StringSearch($env,$searchfield,'web');
! my $toggle="white";
! for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
! #find out stats
! # my ($od,$issue,$fines)=categdata2($env,$results->[$i]{'borrowernumber'});
! # $fines=$fines+0;
! if ($toggle eq 'white'){
! $toggle="#ffffcc";
! } else {
! $toggle="white";
! }
! print mktablerow(9,$toggle,$results->[$i]{'branchcode'},$results->[$i]{'branchname'},
! $results->[$i]{'branchaddress1'}.$results->[$i]{'branchaddress2'}.$results->[$i]{'branchaddress3'},
! $results->[$i]{'branchphone'},,$results->[$i]{'branchfax'},,$results->[$i]{'branchmail'},,$results->[$i]{'issuing'},
! mklink("$script_name?op=add_form&searchfield=".$results->[$i]{'branchcode'},'Edit'),
! mklink("$script_name?op=delete_confirm&searchfield=".$results->[$i]{'branchcode'},'Delete',''));
! }
! print mktableft;
! print "<form action='$script_name' method=post>";
! print "<input type=hidden name=op value=add_form>";
! if ($offset>0) {
! my $prevpage = $offset-$pagesize;
! print mklink("$script_name?offset=".$prevpage,'<< Prev');
! }
! print " ";
! if ($offset+$pagesize<$count) {
! my $nextpage =$offset+$pagesize;
! print mklink("$script_name?offset=".$nextpage,'Next >>');
! }
! print "<br><input type=image src=\"/images/button-add-member.gif\" WIDTH=188 HEIGHT=44 ALT=\"Add budget\" BORDER=0 ></a><br>";
! print "</form>";
! } #---- END $OP eq DEFAULT
! print endmenu('admin');
! print endpage();
--- 1,387 ----
#!/usr/bin/perl
! # Finlay working on this file from 26-03-2002
! # Reorganising this branches admin page.....
use strict;
use CGI;
! use C4::Output;
use C4::Database;
! # Fixed variables
! my $linecolor1='#ffffcc';
! my $linecolor2='white';
! my $backgroundimage="/images/background-mem.gif";
my $script_name="/cgi-bin/koha/admin/branches.pl";
my $pagesize=20;
+
+
+ #######################################################################################
+ # Main loop....
+
+ my $input = new CGI;
+ my $branchcode=$input->param('branchcode');
my $op = $input->param('op');
!
! # header
print $input->header;
! # start the page and read in includes
print startpage();
print startmenu('admin');
! if ($op eq 'add') {
! # If the user has pressed the "add new branch" button.
! print heading("Branches: Add Branch");
! print editbranchform();
!
! } elsif ($op eq 'edit') {
! # if the user has pressed the "edit branch settings" button.
! print heading("Branches: Edit Branch");
! print editbranchform($branchcode);
!
} elsif ($op eq 'add_validate') {
! # confirm settings change...
! my $params = $input->Vars;
! unless ($params->{'branchcode'} && $params->{'branchname'}) {
! default ("Cannot change branch record: You must specify a Branchname and a Branchcode");
! } else {
! setbranchinfo($params);
! default ("Branch record changed for branch: $params->{'branchname'}");
! }
!
! } elsif ($op eq 'delete') {
! # if the user has pressed the "delete branch" button.
! my $message = checkdatabasefor($branchcode);
! if ($message) {
! default($message);
! } else {
! print deleteconfirm($branchcode);
! }
!
! } elsif ($op eq 'delete_confirmed') {
! # actually delete branch and return to the main screen....
! deletebranch($branchcode);
! default("The branch with code $branchcode has been deleted.");
!
! } else {
! # if no operation has been set...
! default();
! }
!
!
! print endmenu('admin');
! print endpage();
!
! ######################################################################################################
! #
! # html output functions....
!
! sub default {
! my ($message) = @_;
! print heading("Branches");
! print "<font color='red'>$message</font>";
! print "<form action='$script_name' method=post><input type='hidden' name='op' value='add'><input type=submit value='Add New Branch'></form>";
! print branchinfotable();
! print branchcategoriestable();
! }
!
! sub heading {
! my ($head) = @_;
! return "<FONT SIZE=6><em>$head</em></FONT><br>";
! }
!
! sub editbranchform {
! # prepares the edit form...
! my ($branchcode) = @_;
! my $data;
! if ($branchcode) {
! $data = getbranchinfo($branchcode);
! $data = $data->[0];
! }
! # make the checkboxs.....
! my $catinfo = getcategoryinfo();
! my $catcheckbox;
! foreach my $cat (@$catinfo) {
! my $checked = "";
! my $tmp = $cat->{'categorycode'};
! if (grep {/^$tmp$/} @{$data->{'categories'}}) {
! $checked = "CHECKED";
! }
! $catcheckbox .= <<EOF;
! <tr><td>$cat->{'categoryname'}</td>
! <td><INPUT TYPE="checkbox" NAME="$cat->{'categorycode'}" VALUE="1" $checked>$cat->{'codedescription'}</td></tr>
! EOF
! }
! my $form = <<EOF;
! <form action='$script_name' name=Aform method=post>
! <input type=hidden name=op value='add_validate'>
! <table>
! <tr><td>Branch code</td><td><input type=text name=branchcode size=5 maxlength=5 value='$data->{'branchcode'}'></td></tr>
! <tr><td>Name</td><td><input type=text name=branchname size=40 maxlength=80 value='$data->{'branchname'}'> </td></tr>
! $catcheckbox
! <tr><td>Address</td><td><input type=text name=branchaddress1 value='$data->{'branchaddress1'}'></td></tr>
! <tr><td> </td><td><input type=text name=branchaddress2 value='$data->{'branchaddress2'}'></td></tr>
! <tr><td> </td><td><input type=text name=branchaddress3 value='$data->{'branchaddress3'}'></td></tr>
! <tr><td>Phone</td><td><input type=text name=branchphone value='$data->{'branchphone'}'></td></tr>
! <tr><td>Fax</td><td><input type=text name=branchfax value='$data->{'branchfax'}'></td></tr>
! <tr><td>E-mail</td><td><input type=text name=branchemail value='$data->{'branchemail'}'></td></tr>
! <tr><td> </td><td><input type=submit value='Submit'></td></tr>
! </table>
! </form>
! EOF
! return $form;
! }
!
! sub deleteconfirm {
! # message to print if the
! my ($branchcode) = @_;
! my $output = <<EOF;
! Confirm delete:
! <form action='$script_name' method=post><input type='hidden' name='op' value='delete_confirmed'>
! <input type='hidden' name='branchcode' value=$branchcode>
! <input type=submit value=YES></form>
! <form action='$script_name' method=post><input type='hidden' name='op' value=''>
! <input type=submit value=NO></form>
! EOF
! return $output;
! }
!
!
! sub branchinfotable {
! # makes the html for a table of branch info from reference to an array of hashs.
!
! my ($branchcode) = @_;
! my $branchinfo;
! if ($branchcode) {
! $branchinfo = getbranchinfo($branchcode);
! } else {
! $branchinfo = getbranchinfo();
! }
! my $table = <<EOF;
! <table border='1' cellpadding='5' cellspacing='0' width='550'>
! <tr> <th colspan='5' align='left' bgcolor='#99cc33' background=$backgroundimage>
! <font size='5'><b>Branches</b></font></th> </tr>
! <tr bgcolor='#889999'>
! <td width='175'><b>Name</b></td>
! <td width='25'><b>Code</b></td>
! <td width='175'><b>Address</b></td>
! <td width='175'><b>Categories</b></td>
! <td width='50'><b> </b></td>
! </tr>
! EOF
!
! my $color;
! foreach my $branch (@$branchinfo) {
! ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
! my $address = '';
! $address .= $branch->{'branchaddress1'} if ($branch->{'branchaddress1'});
! $address .= '<br>'.$branch->{'branchaddress2'} if ($branch->{'branchaddress2'});
! $address .= '<br>'.$branch->{'branchaddress3'} if ($branch->{'branchaddress3'});
! $address .= '<br>ph: '.$branch->{'branchphone'} if ($branch->{'branchphone'});
! $address .= '<br>fax: '.$branch->{'branchfax'} if ($branch->{'branchfax'});
! $address .= '<br>email: '.$branch->{'branchemail'} if ($branch->{'branchemail'});
! $address = '(nothing entered)' unless ($address);
! my $categories = '';
! foreach my $cat (@{$branch->{'categories'}}) {
! my ($catinfo) = @{getcategoryinfo($cat)};
! $categories .= $catinfo->{'categoryname'}."<br>";
! }
! $categories = '(no categories set)' unless ($categories);
! $table .= <<EOF;
! <tr bgcolor='$color'>
! <td align='left' valign='top'>$branch->{'branchname'}</td>
! <td align='left' valign='top'>$branch->{'branchcode'}</td>
! <td align='left' valign='top'>$address</td>
! <td align='left' valign='top'>$categories</td>
! <td align='left' valign='top'>
! <form action='$script_name' method=post>
! <input type='hidden' name='op' value='edit'>
! <input type='hidden' name='branchcode' value='$branch->{'branchcode'}'>
! <input type=submit value=Edit>
! </form>
! <form action='$script_name' method=post>
! <input type='hidden' name='branchcode' value='$branch->{'branchcode'}'>
! <input type='hidden' name='op' value='delete'><input type=submit value=Delete>
! </form></td>
! </tr>
! EOF
! }
! $table .= "</table><br>";
! return $table;
! }
!
! sub branchcategoriestable {
! #Needs to be implemented...
!
! my $categoryinfo = getcategoryinfo();
! my $table = <<EOF;
! <table border='1' cellpadding='5' cellspacing='0'>
! <tr> <th colspan='5' align='left' bgcolor='#99cc33' background=$backgroundimage>
! <font size='5'><b>Branches Categories</b></font></th> </tr>
! <tr bgcolor='#889999'>
! <td width='175'><b>Name</b></td>
! <td width='25'><b>Code</b></td>
! <td width='200'><b>Description</b></td>
! </tr>
! EOF
! my $color;
! foreach my $cat (@$categoryinfo) {
! ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
! $table .= <<EOF;
! <tr bgcolor='$color'>
! <td align='left' valign='top'>$cat->{'categoryname'}</td>
! <td align='left' valign='top'>$cat->{'categorycode'}</td>
! <td align='left' valign='top'>$cat->{'codedescription'}</td>
! </tr>
! EOF
! }
! $table .= "</table>";
! return $table;
! }
!
! ######################################################################################################
! #
! # Database functions....
!
! sub getbranchinfo {
! # returns a reference to an array of hashes containing branches,
!
! my ($branchcode) = @_;
! my $dbh = &C4Connect;
! my $query;
! if ($branchcode) {
! my $bc = $dbh->quote($branchcode);
! $query = "Select * from branches where branchcode = $bc";
! }
! else {$query = "Select * from branches";}
! my $sth = $dbh->prepare($query);
! $sth->execute;
! my @results;
! while (my $data = $sth->fetchrow_hashref) {
! my $tmp = $data->{'branchcode'}; my $brc = $dbh->quote($tmp);
! $query = "select categorycode from branchrelations where branchcode = $brc";
! my $nsth = $dbh->prepare($query);
! $nsth->execute;
! my @cats = ();
! while (my ($cat) = $nsth->fetchrow_array) {
! push(@cats, $cat);
! }
! $nsth->finish;
! $data->{'categories'} = \@cats;
! push(@results, $data);
! }
! $sth->finish;
! $dbh->disconnect;
! return \@results;
! }
!
! sub getcategoryinfo {
! # returns a reference to an array of hashes containing branches,
! my ($catcode) = @_;
! my $dbh = &C4Connect;
! my $query;
! if ($catcode) {
! my $cc = $dbh->quote($catcode);
! $query = "select * from branchcategories where categorycode = $cc";
! } else {
! $query = "Select * from branchcategories";
! }
! my $sth = $dbh->prepare($query);
! $sth->execute;
! my @results;
! while (my $data = $sth->fetchrow_hashref) {
! push(@results, $data);
! }
! $sth->finish;
! $dbh->disconnect;
! return \@results;
! }
!
! sub setbranchinfo {
! # sets the data from the editbranch form, and writes to the database...
! my ($data) = @_;
! my $dbh=&C4Connect;
! my $query = "replace branches (branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail) values (";
! my $tmp;
! $tmp = $data->{'branchcode'}; $query.= $dbh->quote($tmp).",";
! $tmp = $data->{'branchname'}; $query.= $dbh->quote($tmp).",";
! $tmp = $data->{'branchaddress1'}; $query.= $dbh->quote($tmp).",";
! $tmp = $data->{'branchaddress2'}; $query.= $dbh->quote($tmp).",";
! $tmp = $data->{'branchaddress3'}; $query.= $dbh->quote($tmp).",";
! $tmp = $data->{'branchphone'}; $query.= $dbh->quote($tmp).",";
! $tmp = $data->{'branchfax'}; $query.= $dbh->quote($tmp).",";
! $tmp = $data->{'branchemail'}; $query.= $dbh->quote($tmp).")";
! my $sth=$dbh->prepare($query);
! $sth->execute;
! $sth->finish;
! $dbh->disconnect;
! # sort out the categories....
! my @checkedcats;
! my $cats = getcategoryinfo();
! foreach my $cat (@$cats) {
! my $code = $cat->{'categorycode'};
! if ($data->{$code}) {
! push(@checkedcats, $code);
! }
! }
! my $branchcode = $data->{'branchcode'};
! my $branch = getbranchinfo($branchcode);
! $branch = $branch->[0];
! my $branchcats = $branch->{'categories'};
! my @addcats;
! my @removecats;
! foreach my $bcat (@$branchcats) {
! unless (grep {/^$bcat$/} @checkedcats) {
! push(@removecats, $bcat);
! }
! }
! foreach my $ccat (@checkedcats){
! unless (grep {/^$ccat$/} @$branchcats) {
! push(@addcats, $ccat);
! }
! }
! my $dbh=&C4Connect;
! foreach my $cat (@addcats) {
! my $query = "insert into branchrelations (branchcode, categorycode) values('$branchcode', '$cat')";
! my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
! }
! foreach my $cat (@removecats) {
! my $query = "delete from branchrelations where branchcode='$branchcode' and categorycode='$cat'";
! my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
! }
! $dbh->disconnect;
! }
!
! sub deletebranch {
! # delete branch...
! my ($branchcode) = @_;
! my $query = "delete from branches where branchcode = '$branchcode'";
! my $dbh=&C4Connect;
! my $sth=$dbh->prepare($query);
! $sth->execute;
! $sth->finish;
! $dbh->disconnect;
! }
!
! sub checkdatabasefor {
! # check to see if the branchcode is being used in the database somewhere....
! my ($branchcode) = @_;
! my $dbh = &C4Connect;
! my $sth=$dbh->prepare("select count(*) from items where holdingbranch='$branchcode' or homebranch='$branchcode'");
! $sth->execute;
! my ($total) = $sth->fetchrow_array;
! $sth->finish;
! $dbh->disconnect;
! my $message;
! if ($total) {
! $message = "Branch cannot be deleted because there are $total items using that branch.";
! }
! return $message;
! }
!
!
1
0
Update of /cvsroot/koha/koha/updater
In directory usw-pr-cvs1:/tmp/cvs-serv15441/updater
Modified Files:
updatedatabase
Log Message:
moredetail.pl presents circulation information taken from the
branchtransfers table
Circ2.pm has been changed a little
admin/branches.pl alows branches to be added, edited and deleted.
updatedatabase needs more fixing
Index: updatedatabase
===================================================================
RCS file: /cvsroot/koha/koha/updater/updatedatabase,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** updatedatabase 26 Mar 2002 05:08:52 -0000 1.4
--- updatedatabase 2 May 2002 00:08:53 -0000 1.5
***************
*** 138,156 ****
print "Setting type of categorycode in branchcategories to varchar(4),\n and making the primary key.\n";
my $sti=$dbh->prepare("alter table branchcategories change categorycode categorycode varchar(4) not null");
! $sti->execute;
! $sti=$dbh->prepare("alter table branchcategories add primary key (categorycode)");
! $sti->execute;
}
unless ($branchcategories{'branchcode'} eq 'varchar(4)') {
! print "Setting type of branchcode in branchcategories to varchar(4).\n";
! my $sti=$dbh->prepare("alter table branchcategories change branchcode branchcode varchar(4)");
! $sti->execute;
}
unless ($branchcategories{'codedescription'} eq 'text') {
print "Replacing branchholding in branchcategories with codedescription text.\n";
! my $sti=$dbh->prepare("alter table branchcategories change branchholding codedescription text");
! $sti->execute;
}
--- 138,173 ----
print "Setting type of categorycode in branchcategories to varchar(4),\n and making the primary key.\n";
my $sti=$dbh->prepare("alter table branchcategories change categorycode categorycode varchar(4) not null");
! $sth->execute;
! $sth=$dbh->prepare("alter table branchcategories add primary key (categorycode)");
! $sth->execute;
}
unless ($branchcategories{'branchcode'} eq 'varchar(4)') {
! print "Changing branchcode in branchcategories to categoryname text.\n";
! my $sth=$dbh->prepare("alter table branchcategories change branchcode categoryname text");
! $sth->execute;
}
unless ($branchcategories{'codedescription'} eq 'text') {
print "Replacing branchholding in branchcategories with codedescription text.\n";
! my $sth=$dbh->prepare("alter table branchcategories change branchholding codedescription text");
! $sth->execute;
! }
!
! # Create new branchrelations table if it doesnt already exist....
! my $branchrelationsexists;
!
! my $sth=$dbh->prepare("show tables");
! $sth->execute;
! while (my ($tablename) = $sth->fetchrow) {
! if ($tablename == "branchrelations") {
! $branchrelationsexists = 1;
! }
! }
!
! unless ($branchrelationsexists) {
! print "creating branchrelations table";
! my $sth->prepare("create table branchrelations (branchcode varchar(4), categorycode varchar(4))");
! $sth->execute;
}
1
0
Update of /cvsroot/koha/koha
In directory usw-pr-cvs1:/tmp/cvs-serv15441
Modified Files:
moredetail.pl
Added Files:
bookcount.pl
Log Message:
moredetail.pl presents circulation information taken from the
branchtransfers table
Circ2.pm has been changed a little
admin/branches.pl alows branches to be added, edited and deleted.
updatedatabase needs more fixing
--- NEW FILE ---
#!/usr/bin/perl
#written 7/3/2002 by Finlay
#script to display reports
use strict;
use CGI;
use C4::Search;
use C4::Circulation::Circ2;
use C4::Output;
# get all the data ....
my %env;
my $main='#cccc99';
my $secondary='#ffffcc';
my $input = new CGI;
my $itm = $input->param('itm');
my $bi = $input->param('bi');
my $bib = $input->param('bib');
my $branches = getbranches(\%env);
my $idata = itemdatanum($itm);
my $data = bibitemdata($bi);
my $homebranch = $branches->{$idata->{'homebranch'}}->{'branchname'};
my $holdingbranch = $branches->{$idata->{'holdingbranch'}}->{'branchname'};
my ($lastmove, $message) = lastmove($itm);
my $lastdate;
my $count;
if (not $lastmove) {
$lastdate = $message;
$count = issuessince($itm , 0);
} else {
$lastdate = $lastmove->{'datearrived'};
$count = issuessince($itm ,$lastdate);
}
# make the page ...
print $input->header;
print startpage;
print startmenu('report');
print center;
print <<"EOF";
<br>
<FONT SIZE=6><em><a href=/cgi-bin/koha/detail.pl?bib=$bib&type=intra>$data->{'title'} ($data->{'author'})</a></em></FONT><P>
<p>
<img src="/images/holder.gif" width=16 height=200 align=left>
<TABLE CELLSPACING=0 CELLPADDING=5 border=1 width=440 >
<TR VALIGN=TOP><td bgcolor="99cc33" background="/images/background-mem.gif">
<B>BARCODE $idata->{'barcode'}</b></TD>
</TR>
<TR VALIGN=TOP >
<TD width=440 >
<b>Home Branch: </b> $homebranch <br>
<b>Current Branch: </b> $holdingbranch<br>
<b>Date arrived at current branch: </b> $lastdate <br>
<b>Number of issues since since the above date :</b> $count <br>
<table cellspacing =0 cellpadding=5 border=1 width = 440>
<TR><TD > <b>Branch</b></td> <TD > <b>No. of Issues</b></td> <td><b>Last seen at branch</b></td></TR>
EOF
foreach my $branchcode (keys %$branches) {
my $issues = issuesat($itm, $branchcode);
my $date = lastseenat($itm, $branchcode);
my $seen = slashdate($date);
print << "EOF";
<TR><TD > <b>$branches->{$branchcode}->{'branchname'}</b></td>
<TD > <b> $issues </b></td> <td><b> $seen</b></td></TR>
EOF
}
print <<"EOF";
</table>
</TR>
</table>
EOF
print endmenu('report');
print endpage;
##############################################
# This stuff should probably go into C4::Search
# database includes
use DBI;
use C4::Database;
sub itemdatanum {
my ($itemnumber)=@_;
my $dbh=C4Connect;
my $itm = $dbh->quote("$itemnumber");
my $query = "select * from items where itemnumber=$itm";
my $sth=$dbh->prepare($query);
$sth->execute;
my $data=$sth->fetchrow_hashref;
$sth->finish;
$dbh->disconnect;
return($data);
}
sub lastmove {
my ($itemnumber)=@_;
my $dbh=C4Connect;
my $var1 = $dbh->quote($itemnumber);
my $sth =$dbh->prepare("select max(branchtransfers.datearrived) from branchtransfers where branchtransfers.itemnumber=$var1");
$sth->execute;
my ($date) = $sth->fetchrow_array;
return(0, "Item has no branch transfers record") if not $date;
my $var2 = $dbh->quote($date);
$sth=$dbh->prepare("Select * from branchtransfers where branchtransfers.itemnumber=$var1 and branchtransfers.datearrived=$var2");
$sth->execute;
my ($data) = $sth->fetchrow_hashref;
return(0, "Item has no branch transfers record") if not $data;
$sth->finish;
$dbh->disconnect;
return($data,"");
}
sub issuessince {
my ($itemnumber, $date)=@_;
my $dbh=C4Connect;
my $itm = $dbh->quote($itemnumber);
my $dat = $dbh->quote($date);
my $sth=$dbh->prepare("Select count(*) from issues where issues.itemnumber=$itm and issues.timestamp > $dat");
$sth->execute;
my $count=$sth->fetchrow_hashref;
$sth->finish;
$dbh->disconnect;
return($count->{'count(*)'});
}
sub issuesat {
my ($itemnumber, $brcd)=@_;
my $dbh=C4Connect;
my $itm = $dbh->quote($itemnumber);
my $brc = $dbh->quote($brcd);
my $query = "Select count(*) from issues where itemnumber=$itm and branchcode = $brc";
my $sth=$dbh->prepare($query);
$sth->execute;
my ($count)=$sth->fetchrow_array;
$sth->finish;
$dbh->disconnect;
return($count);
}
sub lastseenat {
my ($itemnumber, $brcd)=@_;
my $dbh=C4Connect;
my $itm = $dbh->quote($itemnumber);
my $brc = $dbh->quote($brcd);
my $query = "Select max(timestamp) from issues where itemnumber=$itm and branchcode = $brc";
my $sth=$dbh->prepare($query);
$sth->execute;
my ($date1)=$sth->fetchrow_array;
$sth->finish;
$query = "Select max(datearrived) from branchtransfers where itemnumber=$itm and tobranch = $brc";
my $sth=$dbh->prepare($query);
$sth->execute;
my ($date2)=$sth->fetchrow_array;
$sth->finish;
$dbh->disconnect;
$date2 =~ s/-//g;
$date2 =~ s/://g;
$date2 =~ s/ //g;
my $date;
if ($date1 < $date2) {
$date = $date2;
} else {
$date = $date1;
}
return($date);
}
#####################################################
# write date....
sub slashdate {
my ($date) = @_;
if (not $date) {
return "never";
}
my ($yr, $mo, $da, $hr, $mi) = (substr($date, 0, 4), substr($date, 4, 2), substr($date, 6, 2), substr($date, 8, 2), substr($date, 10, 2));
return "$hr:$mi $da/$mo/$yr";
}
Index: moredetail.pl
===================================================================
RCS file: /cvsroot/koha/koha/moredetail.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** moredetail.pl 8 Apr 2002 23:44:43 -0000 1.4
--- moredetail.pl 2 May 2002 00:08:53 -0000 1.5
***************
*** 172,176 ****
print <<printend
<b>Cancelled: $items[$i]->{'wthdrawn'}<br>
! <b>Total Issues:</b> $items[$i]->{'issues'}<br>
<b>Group Number:</b> $bi <br>
<b>Biblio number:</b> $bib <br>
--- 172,176 ----
print <<printend
<b>Cancelled: $items[$i]->{'wthdrawn'}<br>
! <b><a href=/cgi-bin/koha/bookcount.pl?&bib=$bib&bi=$bi&itm=$items[$i]->{'itemnumber'}>Total Issues:</a></b> $items[$i]->{'issues'}<br>
<b>Group Number:</b> $bi <br>
<b>Biblio number:</b> $bib <br>
1
0