From chris at katipo.co.nz Wed May 1 16:19:33 2002 From: chris at katipo.co.nz (Chris Cormack) Date: Wed May 1 16:19:33 2002 Subject: [Koha-devel] New tarball Message-ID: <20020501231756.GV21253@katipo.co.nz> Hi all Ive just popped up a new rc1 tarball at developer.koha.org. It has a new TODO file, and glens koha-sql-generator has been removed. (It was a tool for converting a GLAS database file into something koha can use) I figure we should put it in a contrib section or something instead. Chris -- Chris Cormack Programmer 025 500 789 Katipo Communications Ltd chris at katipo.co.nz www.katipo.co.nz From finlayt at users.sourceforge.net Wed May 1 17:09:16 2002 From: finlayt at users.sourceforge.net (Finlay Thompson) Date: Wed May 1 17:09:16 2002 Subject: [Koha-devel] CVS: koha bookcount.pl,NONE,1.1 moredetail.pl,1.4,1.5 Message-ID: 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";
$data->{'title'} ($data->{'author'})

BARCODE $idata->{'barcode'}
Home Branch: $homebranch
Current Branch: $holdingbranch
Date arrived at current branch: $lastdate
Number of issues since since the above date : $count
EOF foreach my $branchcode (keys %$branches) { my $issues = issuesat($itm, $branchcode); my $date = lastseenat($itm, $branchcode); my $seen = slashdate($date); print << "EOF"; EOF } print <<"EOF";
Branch No. of Issues Last seen at branch
$branches->{$branchcode}->{'branchname'} $issues $seen
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 <Cancelled: $items[$i]->{'wthdrawn'}
! Total Issues: $items[$i]->{'issues'}
Group Number: $bi
Biblio number: $bib
--- 172,176 ---- print <Cancelled: $items[$i]->{'wthdrawn'}
! {'itemnumber'}>Total Issues: $items[$i]->{'issues'}
Group Number: $bi
Biblio number: $bib
From finlayt at users.sourceforge.net Wed May 1 17:09:16 2002 From: finlayt at users.sourceforge.net (Finlay Thompson) Date: Wed May 1 17:09:16 2002 Subject: [Koha-devel] CVS: koha/updater updatedatabase,1.4,1.5 Message-ID: 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; } From finlayt at users.sourceforge.net Wed May 1 17:09:16 2002 From: finlayt at users.sourceforge.net (Finlay Thompson) Date: Wed May 1 17:09:16 2002 Subject: [Koha-devel] CVS: koha/admin branches.pl,1.1,1.2 Message-ID: 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 at 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 < ! ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! 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); ! } ! } ! ! printend ! ;#/ ! if ($searchfield) { ! print "

Modify branch

"; ! } else { ! print "

Add branch

"; ! } ! print "
"; ! print ""; ! print ""; ! if ($searchfield) { ! print ""; ! } else { ! print ""; ! } ! print ""; ! print ""; ! print ""; ! print ""; ! print ""; ! print ""; ! print ""; ! print ""; ! print ""; ! print "
Branch code$searchfield
Branch code
Name 
Adress
 
 
Phone
Fax
E-mail
Issuing
 
"; ! print "
"; ! ; ! # 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 "
"; ! print ""; ! print "
"; ! # 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 "
"; ! print "Branch code$data->{'branchcode'}"; ! print "  name$data->{'branchname'}"; ! print "  adress$data->{'branchaddress1'}"; ! print " $data->{'branchaddress2'}"; ! print " $data->{'branchaddress3'}"; ! print " phone$data->{'branchphone'}"; ! print "  fax$data->{'branchfax'}"; ! print "  e-mail$data->{'branchemail'}"; ! print "  issuing$data->{'issuing'}"; ! if ($total->{'total'} >0) { ! print "This record is used $total->{'total'} times. Deletion not possible"; ! print "
"; ! } else { ! print "CONFIRM DELETION"; ! print "
"; ! } ! # 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 "
"; ! print ""; ! print "
"; ! # 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", at inputs); ! print <$searchfield

"; ! } ! 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 "

"; ! print ""; ! 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 "

"; ! print "
"; ! } #---- 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 "$message"; ! print "
"; ! print branchinfotable(); ! print branchcategoriestable(); ! } ! ! sub heading { ! my ($head) = @_; ! return "$head
"; ! } ! ! 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 .= <$cat->{'categoryname'} ! $cat->{'codedescription'} ! EOF ! } ! my $form = < ! ! ! ! ! $catcheckbox ! ! ! ! ! ! ! !
Branch code
Name 
Address
 
 
Phone
Fax
E-mail
 
! ! EOF ! return $form; ! } ! ! sub deleteconfirm { ! # message to print if the ! my ($branchcode) = @_; ! my $output = < ! ! !
!
! 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 = < ! ! Branches ! ! Name ! Code ! Address ! Categories !   ! ! EOF ! ! my $color; ! foreach my $branch (@$branchinfo) { ! ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1); ! my $address = ''; ! $address .= $branch->{'branchaddress1'} if ($branch->{'branchaddress1'}); ! $address .= '
'.$branch->{'branchaddress2'} if ($branch->{'branchaddress2'}); ! $address .= '
'.$branch->{'branchaddress3'} if ($branch->{'branchaddress3'}); ! $address .= '
ph: '.$branch->{'branchphone'} if ($branch->{'branchphone'}); ! $address .= '
fax: '.$branch->{'branchfax'} if ($branch->{'branchfax'}); ! $address .= '
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'}."
"; ! } ! $categories = '(no categories set)' unless ($categories); ! $table .= < ! $branch->{'branchname'} ! $branch->{'branchcode'} ! $address ! $categories ! !
! ! ! !
!
! ! !
! ! EOF ! } ! $table .= "
"; ! return $table; ! } ! ! sub branchcategoriestable { ! #Needs to be implemented... ! ! my $categoryinfo = getcategoryinfo(); ! my $table = < ! ! Branches Categories ! ! Name ! Code ! Description ! ! EOF ! my $color; ! foreach my $cat (@$categoryinfo) { ! ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1); ! $table .= < ! $cat->{'categoryname'} ! $cat->{'categorycode'} ! $cat->{'codedescription'} ! ! EOF ! } ! $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; ! } ! ! From finlayt at users.sourceforge.net Wed May 1 17:09:17 2002 From: finlayt at users.sourceforge.net (Finlay Thompson) Date: Wed May 1 17:09:17 2002 Subject: [Koha-devel] CVS: koha/C4 Search.pm,1.18,1.19 Message-ID: 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 From finlayt at users.sourceforge.net Wed May 1 17:09:18 2002 From: finlayt at users.sourceforge.net (Finlay Thompson) Date: Wed May 1 17:09:18 2002 Subject: [Koha-devel] CVS: koha/C4/Circulation Circ2.pm,1.21,1.22 Message-ID: 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 = "There is no book with barcode: $barcode "; ! return (0, $message, 0); ! } ! my $fbr = $iteminformation->{'holdingbranch'}; ! if ($branches->{$fbr}->{'PE'}) { ! $message = "You cannot transfer a book that is in a permanant branch."; ! return (0, $message, $iteminformation); ! } ! if ($fbr eq $tbr) { ! $message = "You can't transfer the book to the branch it is already at! "; ! return (0, $message, $iteminformation); ! } my $dbh=&C4Connect; + my ($currentborrower) = currentborrower(\%env, $iteminformation->{'itemnumber'}, $dbh); + if ($currentborrower) { + $message = "Book cannot be transfered bracause it is currently on loan to: $currentborrower . Please return book first."; + 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, " There is no book with barcode: $barcode "); + 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, "Book: $barcode is not currently issued."); + 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, "RESERVED 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); } From finlayt at users.sourceforge.net Wed May 1 17:18:08 2002 From: finlayt at users.sourceforge.net (Finlay Thompson) Date: Wed May 1 17:18:08 2002 Subject: [Koha-devel] 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 Message-ID: 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.="