From 9255f92b2102cbb29377134a232743f0c16732a1 Mon Sep 17 00:00:00 2001 From: finlayt Date: Thu, 2 May 2002 00:08:53 +0000 Subject: [PATCH] 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 --- C4/Circulation/Circ2.pm | 340 ++++++++++++++++++---- C4/Search.pm | 2 +- admin/branches.pl | 617 +++++++++++++++++++++++----------------- bookcount.pl | 194 +++++++++++++ moredetail.pl | 2 +- updater/updatedatabase | 33 ++- 6 files changed, 861 insertions(+), 327 deletions(-) create mode 100755 bookcount.pl diff --git a/C4/Circulation/Circ2.pm b/C4/Circulation/Circ2.pm index 5b23990171..13fc20628f 100755 --- a/C4/Circulation/Circ2.pm +++ b/C4/Circulation/Circ2.pm @@ -4,6 +4,7 @@ package C4::Circulation::Circ2; #written 3/11/99 by olwen@katipo.co.nz use strict; +# use warnings; require Exporter; use DBI; use C4::Database; @@ -23,8 +24,7 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 0.01; @ISA = qw(Exporter); -@EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook -&find_reserves &transferbook); +@EXPORT = qw(&getbranches &getprinters &getpatroninformation ¤tissues &getiteminformation &findborrower &issuebook &returnbook &returnbook2 &find_reserves &transferbook &decode); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], # your exported package globals go here, @@ -62,13 +62,20 @@ my $priv_func = sub { sub getbranches { - my ($env) = @_; +# returns a reference to a hash of references to branches... my %branches; my $dbh=&C4Connect; my $sth=$dbh->prepare("select * from branches"); $sth->execute; while (my $branch=$sth->fetchrow_hashref) { -# (next) if ($branch->{'branchcode'} eq 'TR'); + 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; } $dbh->disconnect; @@ -95,22 +102,23 @@ sub getpatroninformation { # returns 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) { - $sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber"); + $query = "select * from borrowers where borrowernumber=$borrowernumber"; } elsif ($cardnumber) { - $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber"); + $query = "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(); + $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); + my $borrower = $sth->fetchrow_hashref; + my $flags = patronflags($env, $borrower, $dbh); $sth->finish; $dbh->disconnect; print O "$borrower->{'surname'} <---\n"; @@ -119,6 +127,33 @@ sub getpatroninformation { return($borrower, $flags); } +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; +} @@ -187,20 +222,46 @@ sub findborrower { sub transferbook { - my ($env, $iteminformation, $barcode) = @_; - my $messages; +# 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 $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"); + 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 ..... - $sth = $dbh->prepare("update items set holdingbranch='$env->{'tobranchcd'}' where items.itemnumber=$iteminformation->{'itemnumber'}"); - $sth->execute || return (0,"database error: $sth->errstr"); - $sth->execute; + $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm"; + $sth = $dbh->prepare($query); + $sth->execute; $sth->finish; $dbh->disconnect; - return (1, $messages); + return (1, $message, $iteminformation); } @@ -395,7 +456,6 @@ sub returnbook { # 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; # alter fine to show that the book has been returned @@ -406,8 +466,8 @@ sub returnbook { $overduecharge=$data->{'amountoutstanding'}; } $sth->finish; - } - if ($iteminformation->{'itemlost'} eq '1'){ + } + if ($iteminformation->{'itemlost'} eq '1'){ # check for charge made for lost book my $query="select * from accountlines where (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='L' or accounttype='Rep') @@ -517,67 +577,223 @@ sub returnbook { } + +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); + 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; + $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount; + if ($amount > 5) { + $flaginfo{'noissues'} = 1; } - $flags{'CHARGES'}=\%flaginfo; + $flags{'CHARGES'} = \%flaginfo; } elsif ($amount < 0){ my %flaginfo; - $amount=$amount*-1; - $flaginfo{'message'}=sprintf "Patron has credit of \$%.02f", $amount; - $flags{'CHARGES'}=\%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; + $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; + $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; + $flaginfo{'message'} = 'Borrower is Debarred.'; + $flaginfo{'noissues'} = 1; + $flags{'DBARRED'} = \%flaginfo; } if ($patroninformation->{'borrowernotes'}) { my %flaginfo; - $flaginfo{'message'}="$patroninformation->{'borrowernotes'}"; - $flags{'NOTES'}=\%flaginfo; + $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; + $flags{'NOTES'} = \%flaginfo; } - my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh); + my ($odues, $itemsoverdue) = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh); if ($odues > 0) { my %flaginfo; - $flaginfo{'message'}="Yes"; - $flaginfo{'itemlist'}=$itemsoverdue; + $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; + $flags{'ODUES'} = \%flaginfo; } - my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'}); - if ($nowaiting>0) { + 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; + $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); } @@ -603,11 +819,11 @@ sub checkoverdues { 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 ($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; $sth->finish; @@ -616,13 +832,13 @@ sub updatelastseen { sub currentborrower { # Original subroutine for Circ2.pm my ($env, $itemnumber, $dbh) = @_; - my $q_itemnumber=$dbh->quote($itemnumber); + my $q_itemnumber = $dbh->quote($itemnumber); my $sth=$dbh->prepare("select borrowers.borrowernumber from issues,borrowers where issues.itemnumber=$q_itemnumber and issues.borrowernumber=borrowers.borrowernumber and issues.returndate is NULL"); $sth->execute; - my ($previousborrower)=$sth->fetchrow; + my ($previousborrower) = $sth->fetchrow; return($previousborrower); } diff --git a/C4/Search.pm b/C4/Search.pm index a99ff36276..9cb1c4a0e8 100755 --- a/C4/Search.pm +++ b/C4/Search.pm @@ -961,7 +961,7 @@ sub subtitle { sub itemissues { - my ($bibitem,$biblio)=@_; + my ($bibitem, $biblio)=@_; my $dbh=C4Connect; my $query="Select * from items where items.biblioitemnumber='$bibitem'"; diff --git a/admin/branches.pl b/admin/branches.pl index d8bee7e164..b0b01cf924 100755 --- a/admin/branches.pl +++ b/admin/branches.pl @@ -1,280 +1,387 @@ #!/usr/bin/perl -#script to administer the aqbudget table -#written 20/02/2002 by paul.poulain@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 +# Finlay working on this file from 26-03-2002 +# Reorganising this branches admin page..... use strict; -use C4::Output; use CGI; -use C4::Search; +use C4::Output; 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'); +# 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'); -$searchfield=~ s/\,//g; + +# header print $input->header; -#start the page and read in includes +# 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; +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"; } - return true; + $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'}."
"; } - ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// - function isDate(f) { - var t = Date.parse(f.value); - if (isNaN(t)) { - return false; - } + $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); } - ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// - 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); - } + $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); } - -printend -;#/ - if ($searchfield) { - print "

Modify branch

"; - } else { - print "

Add branch

"; + } + 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); } - print "
"; - print ""; - print ""; - if ($searchfield) { - print ""; - } else { - print ""; + } + foreach my $ccat (@checkedcats){ + unless (grep {/^$ccat$/} @$branchcats) { + push(@addcats, $ccat); } - 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); + } + my $dbh=&C4Connect; + foreach my $cat (@addcats) { + my $query = "insert into branchrelations (branchcode, categorycode) values('$branchcode', '$cat')"; + my $sth = $dbh->prepare($query); $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); + } + foreach my $cat (@removecats) { + my $query = "delete from branchrelations where branchcode='$branchcode' and categorycode='$cat'"; + my $sth = $dbh->prepare($query); $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",@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(); + } + $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; +} + + diff --git a/bookcount.pl b/bookcount.pl new file mode 100755 index 0000000000..1057492d8f --- /dev/null +++ b/bookcount.pl @@ -0,0 +1,194 @@ +#!/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"; +} diff --git a/moredetail.pl b/moredetail.pl index 789508bf7f..06f221aeb2 100755 --- a/moredetail.pl +++ b/moredetail.pl @@ -171,7 +171,7 @@ if ($items[$i]->{'wthdrawn'} eq '1'){ } print <Cancelled: $items[$i]->{'wthdrawn'}
-Total Issues: $items[$i]->{'issues'}
+{'itemnumber'}>Total Issues: $items[$i]->{'issues'}
Group Number: $bi
Biblio number: $bib
diff --git a/updater/updatedatabase b/updater/updatedatabase index b0a493ae76..ebef170c22 100755 --- a/updater/updatedatabase +++ b/updater/updatedatabase @@ -137,21 +137,38 @@ while (my ($column, $type, $null, $key, $default, $extra) = $sth->fetchrow) { unless ($branchcategories{'categorycode'} eq 'varchar(4)') { 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; + $sth->execute; + $sth=$dbh->prepare("alter table branchcategories add primary key (categorycode)"); + $sth->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; + 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 $sti=$dbh->prepare("alter table branchcategories change branchholding codedescription text"); - $sti->execute; + 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; } $sth->finish; -- 2.39.5