- Koha-devel - lists.koha-community.org

CVS: koha/C4/Circulation Circ2.pm,1.21,1.22
by Finlay Thompson 01 May '02

01 May '02

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 &currentissues &getiteminformation &findborrower &issuebook &returnbook ! &find_reserves &transferbook); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], --- 25,29 ---- @ISA = qw(Exporter); ! @EXPORT = qw(&getbranches &getprinters &getpatroninformation &currentissues &getiteminformation &findborrower &issuebook &returnbook &returnbook2 &find_reserves &transferbook &decode); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], *************** *** 63,67 **** sub getbranches { ! my ($env) = @_; my %branches; my $dbh=&C4Connect; --- 63,67 ---- sub getbranches { ! # returns a reference to a hash of references to branches... my %branches; my $dbh=&C4Connect; *************** *** 69,73 **** $sth->execute; while (my $branch=$sth->fetchrow_hashref) { ! # (next) if ($branch->{'branchcode'} eq 'TR'); $branches{$branch->{'branchcode'}}=$branch; } --- 69,80 ---- $sth->execute; while (my $branch=$sth->fetchrow_hashref) { ! my $tmp = $branch->{'branchcode'}; my $brc = $dbh->quote($tmp); ! my $query = "select categorycode from branchrelations where branchcode = $brc"; ! my $nsth = $dbh->prepare($query); ! $nsth->execute; ! while (my ($cat) = $nsth->fetchrow_array) { ! $branch->{$cat} = 1; ! } ! $nsth->finish; $branches{$branch->{'branchcode'}}=$branch; } *************** *** 96,115 **** my ($env, $borrowernumber,$cardnumber) = @_; my $dbh=&C4Connect; my $sth; open O, ">>/root/tkcirc.out"; print O "Looking up patron $borrowernumber / $cardnumber\n"; if ($borrowernumber) { ! $sth=$dbh->prepare("select * from borrowers where borrowernumber=$borrowernumber"); } elsif ($cardnumber) { ! $sth=$dbh->prepare("select * from borrowers where cardnumber=$cardnumber"); } else { ! # error condition. This subroutine must be called with either a ! # borrowernumber or a card number. ! $env->{'apierror'}="invalid borrower information passed to getpatroninformation subroutine"; ! return(); } $sth->execute; ! my $borrower=$sth->fetchrow_hashref; ! my $flags=patronflags($env, $borrower, $dbh); $sth->finish; $dbh->disconnect; --- 103,123 ---- my ($env, $borrowernumber,$cardnumber) = @_; my $dbh=&C4Connect; + my $query; my $sth; open O, ">>/root/tkcirc.out"; print O "Looking up patron $borrowernumber / $cardnumber\n"; if ($borrowernumber) { ! $query = "select * from borrowers where borrowernumber=$borrowernumber"; } elsif ($cardnumber) { ! $query = "select * from borrowers where cardnumber=$cardnumber"; } else { ! $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine"; ! return(); } + $env->{'mess'} = $query; + $sth = $dbh->prepare($query); $sth->execute; ! my $borrower = $sth->fetchrow_hashref; ! my $flags = patronflags($env, $borrower, $dbh); $sth->finish; $dbh->disconnect; *************** *** 120,123 **** --- 128,158 ---- } + sub decode { + my ($encoded) = @_; + my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-'; + my @s = map { index($seq,$_); } split(//,$encoded); + my $l = ($#s+1) % 4; + if ($l) + { + if ($l == 1) + { + print "Error!"; + return; + } + $l = 4-$l; + $#s += $l; + } + my $r = ''; + while ($#s >= 0) + { + my $n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3]; + $r .=chr(($n >> 16) ^ 67) . + chr(($n >> 8 & 255) ^ 67) . + chr(($n & 255) ^ 67); + @s = @s[4..$#s]; + } + $r = substr($r,0,length($r)-$l); + return $r; + } *************** *** 188,205 **** sub transferbook { ! my ($env, $iteminformation, $barcode) = @_; ! my $messages; my $dbh=&C4Connect; #new entry in branchtransfers.... ! my $sth = $dbh->prepare("insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) values($iteminformation->{'itemnumber'}, '$env->{'frbranchcd'}', now(), '$env->{'tobranchcd'}')"); ! $sth->execute || return (0,"database error: $sth->errstr"); $sth->finish; #update holdingbranch in items ..... ! $sth = $dbh->prepare("update items set holdingbranch='$env->{'tobranchcd'}' where items.itemnumber=$iteminformation->{'itemnumber'}"); ! $sth->execute || return (0,"database error: $sth->errstr"); ! $sth->execute; $sth->finish; $dbh->disconnect; ! return (1, $messages); } --- 223,266 ---- sub transferbook { ! # transfer book code.... ! my ($tbr, $barcode) = @_; ! my $message = ""; ! my %env; ! my $branches = getbranches(); ! my $iteminformation = getiteminformation(\%env,0, $barcode); ! if (not $iteminformation) { ! $message = "<font color='red' size='+2'>There is no book with barcode: $barcode </font>"; ! return (0, $message, 0); ! } ! my $fbr = $iteminformation->{'holdingbranch'}; ! if ($branches->{$fbr}->{'PE'}) { ! $message = "<font color='red' size='+2'>You cannot transfer a book that is in a permanant branch.</font>"; ! return (0, $message, $iteminformation); ! } ! if ($fbr eq $tbr) { ! $message = "<font color='red' size='+2'>You can't transfer the book to the branch it is already at! </font>"; ! return (0, $message, $iteminformation); ! } my $dbh=&C4Connect; + my ($currentborrower) = currentborrower(\%env, $iteminformation->{'itemnumber'}, $dbh); + if ($currentborrower) { + $message = "<font color='red' size='+2'>Book cannot be transfered bracause it is currently on loan to: $currentborrower . Please return book first.</font>"; + return (0, $message, $iteminformation); + } + my $itm = $dbh->quote($iteminformation->{'itemnumber'}); + $fbr = $dbh->quote($fbr); + $tbr = $dbh->quote($tbr); #new entry in branchtransfers.... ! my $query = "insert into branchtransfers (itemnumber, frombranch, datearrived, tobranch) values($itm, $fbr, now(), $tbr)"; ! my $sth = $dbh->prepare($query); ! $sth->execute; $sth->finish; #update holdingbranch in items ..... ! $query = "update items set datelastseen = now(), holdingbranch=$tbr where items.itemnumber=$itm"; ! $sth = $dbh->prepare($query); ! $sth->execute; $sth->finish; $dbh->disconnect; ! return (1, $message, $iteminformation); } *************** *** 396,400 **** # check for overdue fine - $overduecharge; $sth=$dbh->prepare("select * from accountlines where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber = $iteminformation->{'itemnumber'}) and (accounttype='FU' or accounttype='O')"); $sth->execute; --- 457,460 ---- *************** *** 407,412 **** } $sth->finish; ! } ! if ($iteminformation->{'itemlost'} eq '1'){ # check for charge made for lost book my $query="select * from accountlines where (itemnumber = --- 467,472 ---- } $sth->finish; ! } ! if ($iteminformation->{'itemlost'} eq '1'){ # check for charge made for lost book my $query="select * from accountlines where (itemnumber = *************** *** 518,582 **** sub patronflags { # Original subroutine for Circ2.pm my %flags; ! my ($env,$patroninformation,$dbh) = @_; ! my $amount = checkaccount($env,$patroninformation->{'borrowernumber'}, $dbh); if ($amount > 0) { my %flaginfo; ! $flaginfo{'message'}=sprintf "Patron owes \$%.02f", $amount; ! if ($amount>5) { ! $flaginfo{'noissues'}=1; } ! $flags{'CHARGES'}=\%flaginfo; } elsif ($amount < 0){ my %flaginfo; ! $amount=$amount*-1; ! $flaginfo{'message'}=sprintf "Patron has credit of \$%.02f", $amount; ! $flags{'CHARGES'}=\%flaginfo; } if ($patroninformation->{'gonenoaddress'} == 1) { my %flaginfo; ! $flaginfo{'message'}='Borrower has no valid address.'; ! $flaginfo{'noissues'}=1; ! $flags{'GNA'}=\%flaginfo; } if ($patroninformation->{'lost'} == 1) { my %flaginfo; ! $flaginfo{'message'}='Borrower\'s card reported lost.'; ! $flaginfo{'noissues'}=1; ! $flags{'LOST'}=\%flaginfo; } if ($patroninformation->{'debarred'} == 1) { my %flaginfo; ! $flaginfo{'message'}='Borrower is Debarred.'; ! $flaginfo{'noissues'}=1; ! $flags{'DBARRED'}=\%flaginfo; } if ($patroninformation->{'borrowernotes'}) { my %flaginfo; ! $flaginfo{'message'}="$patroninformation->{'borrowernotes'}"; ! $flags{'NOTES'}=\%flaginfo; } ! my ($odues, $itemsoverdue) = checkoverdues($env,$patroninformation->{'borrowernumber'},$dbh); if ($odues > 0) { my %flaginfo; ! $flaginfo{'message'}="Yes"; ! $flaginfo{'itemlist'}=$itemsoverdue; foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) { $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; } ! $flags{'ODUES'}=\%flaginfo; } ! my ($nowaiting,$itemswaiting) = checkwaiting($env,$dbh,$patroninformation->{'borrowernumber'}); ! if ($nowaiting>0) { my %flaginfo; ! $flaginfo{'message'}="Reserved items available"; ! $flaginfo{'itemlist'}=$itemswaiting; ! $flaginfo{'itemfields'}=['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch']; ! $flags{'WAITING'}=\%flaginfo; } - my $flag; - my $key; return(\%flags); } --- 578,798 ---- + + sub returnbook2 { + my ($env, $barcode) = @_; + my @messages; + my $dbh=&C4Connect; + # get information on item + my ($iteminformation) = getiteminformation($env, 0, $barcode); + if (not $iteminformation) { + push(@messages, "<font color='red' size='+2'> There is no book with barcode: $barcode </font>"); + return (0, \@messages, 0 ,0); + } + # updatelastseen($env, $dbh, $iteminformation->{'itemnumber'}); + + # find the borrower + my $borrower; + my ($currentborrower) = currentborrower($env, $iteminformation->{'itemnumber'}, $dbh); + if (not $currentborrower) { + push(@messages, "<font color='red' size='+2'>Book: $barcode is not currently issued.</font>"); + return (0, \@messages, 0,0); + } + # update issues, thereby returning book (should push this out into another subroutine + ($borrower) = getpatroninformation($env, $currentborrower, 0); + my $query = "update issues set returndate = now() + where (borrowernumber = '$borrower->{'borrowernumber'}') + and (itemnumber = '$iteminformation->{'itemnumber'}') and (returndate is null)"; + my $sth = $dbh->prepare($query); + $sth->execute; + $sth->finish; + push(@messages, "Book has been returned."); + + my $tbr = $env->{'branchcode'}; + my ($transfered, $message, $item) = transferbook($tbr, $barcode); + if ($transfered) { + push(@messages, "Book: as been transfered."); + } + + if ($iteminformation->{'itemlost'}) { + updateitemlost($dbh, $iteminformation->{'itemnumber'}); + # check for charge made for lost book + my $query = "select * from accountlines where (itemnumber = '$iteminformation->{'itemnumber'}') + and (accounttype='L' or accounttype='Rep') order by date desc"; + my $sth = $dbh->prepare($query); + $sth->execute; + if (my $data = $sth->fetchrow_hashref) { + # writeoff this amount + my $offset; + my $amount = $data->{'amount'}; + my $acctno = $data->{'accountno'}; + my $amountleft; + if ($data->{'amountoutstanding'} == $amount) { + $offset = $data->{'amount'}; + $amountleft = 0; + } else { + $offset = $amount - $data->{'amountoutstanding'}; + $amountleft = $data->{'amountoutstanding'} - $amount; + } + my $uquery = "update accountlines + set accounttype = 'LR',amountoutstanding='0' + where (borrowernumber = '$data->{'borrowernumber'}') + and (itemnumber = '$iteminformation->{'itemnumber'}') + and (accountno = '$acctno') "; + my $usth = $dbh->prepare($uquery); + $usth->execute; + $usth->finish; + #check if any credit is left if so writeoff other accounts + my $nextaccntno = getnextacctno($env,$data->{'borrowernumber'},$dbh); + if ($amountleft < 0){ + $amountleft*=-1; + } + if ($amountleft > 0){ + my $query = "select * from accountlines + where (borrowernumber = '$data->{'borrowernumber'}') and (amountoutstanding >0) + order by date"; + my $msth = $dbh->prepare($query); + $msth->execute; + # offset transactions + my $newamtos; + my $accdata; + while (($accdata=$msth->fetchrow_hashref) and ($amountleft>0)){ + if ($accdata->{'amountoutstanding'} < $amountleft) { + $newamtos = 0; + $amountleft = $amountleft - $accdata->{'amountoutstanding'}; + } else { + $newamtos = $accdata->{'amountoutstanding'} - $amountleft; + $amountleft = 0; + } + my $thisacct = $accdata->{accountno}; + my $updquery = "update accountlines set amountoutstanding= '$newamtos' + where (borrowernumber = '$data->{'borrowernumber'}') and (accountno='$thisacct')"; + my $usth = $dbh->prepare($updquery); + $usth->execute; + $usth->finish; + $updquery = "insert into accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + values + ('$data->{'borrowernumber'}','$accdata->{'accountno'}','$nextaccntno','$newamtos')"; + my $usth = $dbh->prepare($updquery); + $usth->execute; + $usth->finish; + } + $msth->finish; + } + if ($amountleft > 0){ + $amountleft*=-1; + } + my $desc="Book Returned ".$iteminformation->{'barcode'}; + $uquery = "insert into accountlines + (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding) + values ('$data->{'borrowernumber'}','$nextaccntno',now(),0-$amount,'$desc', + 'CR',$amountleft)"; + $usth = $dbh->prepare($uquery); + + $usth->execute; + $usth->finish; + $uquery = "insert into accountoffsets + (borrowernumber, accountno, offsetaccount, offsetamount) + values ($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset)"; + $usth = $dbh->prepare($uquery); + $usth->execute; + $usth->finish; + $uquery="update items set paidfor='' where itemnumber='$iteminformation->{'itemnumber'}'"; + $usth = $dbh->prepare($uquery); + $usth->execute; + $usth->finish; + } + $sth->finish; + } + + # check for overdue fine + my $query = "select * from accountlines where (borrowernumber='$borrower->{'borrowernumber'}') + and (itemnumber = '$iteminformation->{'itemnumber'}') and (accounttype='FU' or accounttype='O')"; + $sth = $dbh->prepare($query); + $sth->execute; + # alter fine to show that the book has been returned + if (my $data = $sth->fetchrow_hashref) { + my $query = "update accountlines set accounttype='F' + where (borrowernumber=$borrower->{'borrowernumber'}) and (itemnumber=$iteminformation->{'itemnumber'}) + and (acccountno='$data->{'accountno'}')"; + my $usth=$dbh->prepare($query); + $usth->execute(); + $usth->finish(); + } + $sth->finish; + + my ($resfound, $resrec) = find_reserves($env, $dbh, $iteminformation->{'itemnumber'}); + if ($resfound eq 'y') { + my ($borrower) = getpatroninformation($env,$resrec->{'borrowernumber'},0); + my ($branches) = getbranches(); + my $branchname = $branches->{$resrec->{'branchcode'}}->{'branchname'}; + push(@messages, "<b><font color=red>RESERVED</font></b> for collection by $borrower->{'firstname'} $borrower->{'surname'} ($borrower->{'cardnumber'}) at $branchname"); + } + UpdateStats($env,$env->{'branchcode'},'return','0','',$iteminformation->{'itemnumber'}); + $dbh->disconnect; + return (1, \@messages, $iteminformation, $borrower); + } + + + sub patronflags { # Original subroutine for Circ2.pm my %flags; ! my ($env, $patroninformation, $dbh) = @_; ! my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh); if ($amount > 0) { my %flaginfo; ! $flaginfo{'message'}= sprintf "Patron owes \$%.02f", $amount; ! if ($amount > 5) { ! $flaginfo{'noissues'} = 1; } ! $flags{'CHARGES'} = \%flaginfo; } elsif ($amount < 0){ my %flaginfo; ! $amount = $amount*-1; ! $flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", $amount; ! $flags{'CHARGES'} = \%flaginfo; } if ($patroninformation->{'gonenoaddress'} == 1) { my %flaginfo; ! $flaginfo{'message'} = 'Borrower has no valid address.'; ! $flaginfo{'noissues'} = 1; ! $flags{'GNA'} = \%flaginfo; } if ($patroninformation->{'lost'} == 1) { my %flaginfo; ! $flaginfo{'message'} = 'Borrower\'s card reported lost.'; ! $flaginfo{'noissues'} = 1; ! $flags{'LOST'} = \%flaginfo; } if ($patroninformation->{'debarred'} == 1) { my %flaginfo; ! $flaginfo{'message'} = 'Borrower is Debarred.'; ! $flaginfo{'noissues'} = 1; ! $flags{'DBARRED'} = \%flaginfo; } if ($patroninformation->{'borrowernotes'}) { my %flaginfo; ! $flaginfo{'message'} = "$patroninformation->{'borrowernotes'}"; ! $flags{'NOTES'} = \%flaginfo; } ! my ($odues, $itemsoverdue) = checkoverdues($env, $patroninformation->{'borrowernumber'}, $dbh); if ($odues > 0) { my %flaginfo; ! $flaginfo{'message'} = "Yes"; ! $flaginfo{'itemlist'} = $itemsoverdue; foreach (sort {$a->{'date_due'} cmp $b->{'date_due'}} @$itemsoverdue) { $flaginfo{'itemlisttext'}.="$_->{'date_due'} $_->{'barcode'} $_->{'title'} \n"; } ! $flags{'ODUES'} = \%flaginfo; } ! my ($nowaiting, $itemswaiting) = checkwaiting($env, $dbh, $patroninformation->{'borrowernumber'}); ! if ($nowaiting > 0) { my %flaginfo; ! $flaginfo{'message'} = "Reserved items available"; ! $flaginfo{'itemlist'} = $itemswaiting; ! $flaginfo{'itemfields'} = ['barcode', 'title', 'author', 'dewey', 'subclass', 'holdingbranch']; ! $flags{'WAITING'} = \%flaginfo; } return(\%flags); } *************** *** 604,612 **** sub updatelastseen { # Stolen from Returns.pm ! my ($env,$dbh,$itemnumber)= @_; ! my $br = $env->{'branchcode'}; ! my $query = "update items ! set datelastseen = now(), holdingbranch = '$br' ! where (itemnumber = '$itemnumber')"; my $sth = $dbh->prepare($query); $sth->execute; --- 820,828 ---- sub updatelastseen { # Stolen from Returns.pm ! my ($env, $dbh, $itemnumber) = @_; ! my $brc = $env->{'branchcode'}; ! $brc = $dbh->quote($brc); ! my $itm = $dbh->quote($itemnumber); ! my $query = "update items set datelastseen = now(), holdingbranch = $brc where (itemnumber = $itm)"; my $sth = $dbh->prepare($query); $sth->execute; *************** *** 617,621 **** # Original subroutine for Circ2.pm my ($env, $itemnumber, $dbh) = @_; ! my $q_itemnumber=$dbh->quote($itemnumber); my $sth=$dbh->prepare("select borrowers.borrowernumber from issues,borrowers where issues.itemnumber=$q_itemnumber and --- 833,837 ---- # Original subroutine for Circ2.pm my ($env, $itemnumber, $dbh) = @_; ! my $q_itemnumber = $dbh->quote($itemnumber); my $sth=$dbh->prepare("select borrowers.borrowernumber from issues,borrowers where issues.itemnumber=$q_itemnumber and *************** *** 623,627 **** NULL"); $sth->execute; ! my ($previousborrower)=$sth->fetchrow; return($previousborrower); } --- 839,843 ---- NULL"); $sth->execute; ! my ($previousborrower) = $sth->fetchrow; return($previousborrower); }

1 0

CVS: koha/C4 Search.pm,1.18,1.19
by Finlay Thompson 01 May '02

01 May '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv15441/C4 Modified Files: Search.pm Log Message: moredetail.pl presents circulation information taken from the branchtransfers table Circ2.pm has been changed a little admin/branches.pl alows branches to be added, edited and deleted. updatedatabase needs more fixing Index: Search.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Search.pm,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -r1.18 -r1.19 *** Search.pm 10 Apr 2002 09:55:17 -0000 1.18 --- Search.pm 2 May 2002 00:08:53 -0000 1.19 *************** *** 962,966 **** sub itemissues { ! my ($bibitem,$biblio)=@_; my $dbh=C4Connect; my $query="Select * from items where --- 962,966 ---- sub itemissues { ! my ($bibitem, $biblio)=@_; my $dbh=C4Connect; my $query="Select * from items where

1 0

CVS: koha/admin branches.pl,1.1,1.2
by Finlay Thompson 01 May '02

01 May '02

Update of /cvsroot/koha/koha/admin In directory usw-pr-cvs1:/tmp/cvs-serv15441/admin Modified Files: branches.pl Log Message: moredetail.pl presents circulation information taken from the branchtransfers table Circ2.pm has been changed a little admin/branches.pl alows branches to be added, edited and deleted. updatedatabase needs more fixing Index: branches.pl =================================================================== RCS file: /cvsroot/koha/koha/admin/branches.pl,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -r1.1 -r1.2 *** branches.pl 5 Mar 2002 20:48:42 -0000 1.1 --- branches.pl 2 May 2002 00:08:53 -0000 1.2 *************** *** 1,280 **** #!/usr/bin/perl ! #script to administer the aqbudget table ! #written 20/02/2002 by paul.poulain(a)free.fr ! # This software is placed under the gnu General Public License, v2 (http://www.gnu.org/licenses/gpl.html) ! ! # ALGO : ! # this script use an $op to know what to do. ! # if $op is empty or none of the above values, ! # - the default screen is build (with all records, or filtered datas). ! # - the user can clic on add, modify or delete record. ! # if $op=add_form ! # - if primkey exists, this is a modification,so we read the $primkey record ! # - builds the add/modify form ! # if $op=add_validate ! # - the user has just send datas, so we create/modify the record ! # if $op=delete_form ! # - we show the record having primkey=$primkey and ask for deletion validation form ! # if $op=delete_confirm ! # - we delete the record having primkey=$primkey use strict; - use C4::Output; use CGI; ! use C4::Search; use C4::Database; ! sub StringSearch { ! my ($env,$searchstring,$type)=@_; ! my $dbh = &C4Connect; ! $searchstring=~ s/\'/\\\'/g; ! my @data=split(' ',$searchstring); ! my $count=@data; ! my $query="Select branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing from branches where (branchcode like \"$data[0]%\") order by branchcode"; ! my $sth=$dbh->prepare($query); ! $sth->execute; ! my @results; ! my $cnt=0; ! while (my $data=$sth->fetchrow_hashref){ ! push(@results,$data); ! $cnt ++; ! } ! # $sth->execute; ! $sth->finish; ! $dbh->disconnect; ! return ($cnt,\@results); ! } ! ! my $input = new CGI; ! my $searchfield=$input->param('searchfield'); ! my $pkfield="branchcode"; ! my $reqsel="select branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing from branches where branchcode='$searchfield'"; ! my $reqdel="delete from branches where branchcode='$searchfield'"; ! #my $branchcode=$input->param('branchcode'); ! my $offset=$input->param('offset'); my $script_name="/cgi-bin/koha/admin/branches.pl"; - my $pagesize=20; my $op = $input->param('op'); ! $searchfield=~ s/\,//g; print $input->header; ! #start the page and read in includes print startpage(); print startmenu('admin'); ! ################## ADD_FORM ################################## ! # called by default. Used to create form to add or modify a record ! if ($op eq 'add_form') { ! #---- if primkey exists, it's a modify action, so read values to modify... ! my $data; ! if ($searchfield) { ! my $dbh = &C4Connect; ! my $sth=$dbh->prepare("select branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing from branches where branchcode='$searchfield'"); ! $sth->execute; ! $data=$sth->fetchrow_hashref; ! $sth->finish; ! } ! print <<printend ! <script> ! ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! function isNotNull(f,noalert) { ! if (f.value.length ==0) { ! return false; ! } ! return true; ! } ! ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! function toUC(f) { ! var x=f.value.toUpperCase(); ! f.value=x; ! return true; ! } ! ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! function isNum(v,maybenull) { ! var n = new Number(v.value); ! if (isNaN(n)) { ! return false; ! } ! if (maybenull==0 && v.value=='') { ! return false; ! } ! return true; ! } ! ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! function isDate(f) { ! var t = Date.parse(f.value); ! if (isNaN(t)) { ! return false; ! } ! } ! ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// ! function Check(f) { ! var ok=1; ! var _alertString=""; ! var alertString2; ! if (f.searchfield.value.length==0) { ! _alertString += "- branch code missing\\n"; ! } ! if (f.branchname.value.length==0) { ! _alertString += "- branch name missing\\n"; ! } ! if (_alertString.length==0) { ! document.Aform.submit(); ! } else { ! alertString2 = "Form not submitted because of the following problem(s)\\n"; ! alertString2 += "------------------------------------------------------------------------------------\\n\\n"; ! alertString2 += _alertString; ! alert(alertString2); ! } ! } ! </SCRIPT> ! printend ! ;#/ ! if ($searchfield) { ! print "<h1>Modify branch</h1>"; ! } else { ! print "<h1>Add branch</h1>"; ! } ! print "<form action='$script_name' name=Aform method=post>"; ! print "<input type=hidden name=op value='add_validate'>"; ! print "<table>"; ! if ($searchfield) { ! print "<tr><td>Branch code</td><td><input type=hidden name=searchfield value=$searchfield>$searchfield</td></tr>"; ! } else { ! print "<tr><td>Branch code</td><td><input type=text name=searchfield size=5 maxlength=5 onBlur=toUC(this)></td></tr>"; ! } ! print "<tr><td>Name</td><td><input type=text name=branchname size=40 maxlength=80 value='$data->{'branchname'}'> </td></tr>"; ! print "<tr><td>Adress</td><td><input type=text name=branchaddress1 value='$data->{'branchaddress1'}'></td></tr>"; ! print "<tr><td> </td><td><input type=text name=branchaddress2 value='$data->{'branchaddress2'}'></td></tr>"; ! print "<tr><td> </td><td><input type=text name=branchaddress3 value='$data->{'branchaddress3'}'></td></tr>"; ! print "<tr><td>Phone</td><td><input type=text name=branchphone value='$data->{'branchphone'}'></td></tr>"; ! print "<tr><td>Fax</td><td><input type=text name=branchfax value='$data->{'branchfax'}'></td></tr>"; ! print "<tr><td>E-mail</td><td><input type=text name=branchemail value='$data->{'branchemail'}'></td></tr>"; ! print "<tr><td>Issuing</td><td><input type=text name=issuing value='$data->{'issuing'}'></td></tr>"; ! print "<tr><td> </td><td><INPUT type=button value='OK' onClick='Check(this.form)'></td></tr>"; ! print "</table>"; ! print "</form>"; ! ; ! # END $OP eq ADD_FORM ! ################## ADD_VALIDATE ################################## ! # called by add_form, used to insert/modify data in DB } elsif ($op eq 'add_validate') { ! my $dbh=C4Connect; ! my $query = "replace branches (branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,issuing) values ("; ! $query.= $dbh->quote($input->param('branchcode')).","; ! $query.= $dbh->quote($input->param('branchname')).","; ! $query.= $dbh->quote($input->param('branchaddress1')).","; ! $query.= $dbh->quote($input->param('branchaddress2')).","; ! $query.= $dbh->quote($input->param('branchaddress3')).","; ! $query.= $dbh->quote($input->param('branchphone')).","; ! $query.= $dbh->quote($input->param('branchfax')).","; ! $query.= $dbh->quote($input->param('branchemail')).","; ! $query.= $dbh->quote($input->param('issuing')).")"; ! my $sth=$dbh->prepare($query); ! $sth->execute; ! $sth->finish; ! print "data recorded"; ! print "<form action='$script_name' method=post>"; ! print "<input type=submit value=OK>"; ! print "</form>"; ! # END $OP eq ADD_VALIDATE ! ################## DELETE_CONFIRM ################################## ! # called by default form, used to confirm deletion of data in DB ! } elsif ($op eq 'delete_confirm') { ! my $dbh = &C4Connect; ! my $sth=$dbh->prepare("select count(*) as total from borrowers where branchcode='$searchfield'"); ! $sth->execute; ! my $total = $sth->fetchrow_hashref; ! $sth->finish; ! print "$reqsel"; ! my $sth=$dbh->prepare($reqsel); $sth->execute; - my $data=$sth->fetchrow_hashref; $sth->finish; ! print mktablehdr; ! print mktablerow(2,'#99cc33',bold('Branch code'),bold("$searchfield"),'/images/background-mem.gif'); ! print "<form action='$script_name' method=post><input type=hidden name=op value=delete_confirmed><input type=hidden name=searchfield value='$searchfield'>"; ! print "<tr><td>Branch code</td><td>$data->{'branchcode'}</td></tr>"; ! print "<tr><td>  name</td><td>$data->{'branchname'}</td></tr>"; ! print "<tr><td>  adress</td><td>$data->{'branchaddress1'}</td></tr>"; ! print "<tr><td> </td><td>$data->{'branchaddress2'}</td></tr>"; ! print "<tr><td> </td><td>$data->{'branchaddress3'}</td></tr>"; ! print "<tr><td> phone</td><td>$data->{'branchphone'}</td></tr>"; ! print "<tr><td>  fax</td><td>$data->{'branchfax'}</td></tr>"; ! print "<tr><td>  e-mail</td><td>$data->{'branchemail'}</td></tr>"; ! print "<tr><td>  issuing</td><td>$data->{'issuing'}</td></tr>"; ! if ($total->{'total'} >0) { ! print "<tr><td colspan=2 align=center><b>This record is used $total->{'total'} times. Deletion not possible</b></td></tr>"; ! print "<tr><td colspan=2></form><form action='$script_name' method=post><input type=submit value=OK></form></td></tr>"; ! } else { ! print "<tr><td colspan=2 align=center>CONFIRM DELETION</td></tr>"; ! print "<tr><td><INPUT type=submit value='YES'></form></td><td><form action='$script_name' method=post><input type=submit value=NO></form></td></tr>"; ! } ! # END $OP eq DELETE_CONFIRM ! ################## DELETE_CONFIRMED ################################## ! # called by delete_confirm, used to effectively confirm deletion of data in DB ! } elsif ($op eq 'delete_confirmed') { ! my $dbh=C4Connect; ! # my $searchfield=$input->param('branchcode'); ! my $sth=$dbh->prepare($reqdel); $sth->execute; $sth->finish; ! print "data deleted"; ! print "<form action='$script_name' method=post>"; ! print "<input type=submit value=OK>"; ! print "</form>"; ! # END $OP eq DELETE_CONFIRMED ! ################## DEFAULT ################################## ! } else { # DEFAULT ! my @inputs=(["text","searchfield",$searchfield], ! ["reset","reset","clr"]); ! print mkheadr(2,'branches admin'); ! print mkformnotable("$script_name",@inputs); ! print <<printend ! ! printend ! ; ! if ($searchfield ne '') { ! print "You Searched for <b>$searchfield<b><p>"; ! } ! print mktablehdr; ! print mktablerow(9,'#99cc33',bold('Branch code'),bold('name'),bold('adress'), ! bold('phone'),bold('fax'),bold('mail'),bold('issuing'), ! ' ',' ','/images/background-mem.gif'); ! my $env; ! my ($count,$results)=StringSearch($env,$searchfield,'web'); ! my $toggle="white"; ! for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){ ! #find out stats ! # my ($od,$issue,$fines)=categdata2($env,$results->[$i]{'borrowernumber'}); ! # $fines=$fines+0; ! if ($toggle eq 'white'){ ! $toggle="#ffffcc"; ! } else { ! $toggle="white"; ! } ! print mktablerow(9,$toggle,$results->[$i]{'branchcode'},$results->[$i]{'branchname'}, ! $results->[$i]{'branchaddress1'}.$results->[$i]{'branchaddress2'}.$results->[$i]{'branchaddress3'}, ! $results->[$i]{'branchphone'},,$results->[$i]{'branchfax'},,$results->[$i]{'branchmail'},,$results->[$i]{'issuing'}, ! mklink("$script_name?op=add_form&searchfield=".$results->[$i]{'branchcode'},'Edit'), ! mklink("$script_name?op=delete_confirm&searchfield=".$results->[$i]{'branchcode'},'Delete','')); ! } ! print mktableft; ! print "<form action='$script_name' method=post>"; ! print "<input type=hidden name=op value=add_form>"; ! if ($offset>0) { ! my $prevpage = $offset-$pagesize; ! print mklink("$script_name?offset=".$prevpage,'<< Prev'); ! } ! print "      "; ! if ($offset+$pagesize<$count) { ! my $nextpage =$offset+$pagesize; ! print mklink("$script_name?offset=".$nextpage,'Next >>'); ! } ! print "<br><input type=image src=\"/images/button-add-member.gif\" WIDTH=188 HEIGHT=44 ALT=\"Add budget\" BORDER=0 ></a><br>"; ! print "</form>"; ! } #---- END $OP eq DEFAULT ! print endmenu('admin'); ! print endpage(); --- 1,387 ---- #!/usr/bin/perl ! # Finlay working on this file from 26-03-2002 ! # Reorganising this branches admin page..... use strict; use CGI; ! use C4::Output; use C4::Database; ! # Fixed variables ! my $linecolor1='#ffffcc'; ! my $linecolor2='white'; ! my $backgroundimage="/images/background-mem.gif"; my $script_name="/cgi-bin/koha/admin/branches.pl"; my $pagesize=20; + + + ####################################################################################### + # Main loop.... + + my $input = new CGI; + my $branchcode=$input->param('branchcode'); my $op = $input->param('op'); ! ! # header print $input->header; ! # start the page and read in includes print startpage(); print startmenu('admin'); ! if ($op eq 'add') { ! # If the user has pressed the "add new branch" button. ! print heading("Branches: Add Branch"); ! print editbranchform(); ! ! } elsif ($op eq 'edit') { ! # if the user has pressed the "edit branch settings" button. ! print heading("Branches: Edit Branch"); ! print editbranchform($branchcode); ! } elsif ($op eq 'add_validate') { ! # confirm settings change... ! my $params = $input->Vars; ! unless ($params->{'branchcode'} && $params->{'branchname'}) { ! default ("Cannot change branch record: You must specify a Branchname and a Branchcode"); ! } else { ! setbranchinfo($params); ! default ("Branch record changed for branch: $params->{'branchname'}"); ! } ! ! } elsif ($op eq 'delete') { ! # if the user has pressed the "delete branch" button. ! my $message = checkdatabasefor($branchcode); ! if ($message) { ! default($message); ! } else { ! print deleteconfirm($branchcode); ! } ! ! } elsif ($op eq 'delete_confirmed') { ! # actually delete branch and return to the main screen.... ! deletebranch($branchcode); ! default("The branch with code $branchcode has been deleted."); ! ! } else { ! # if no operation has been set... ! default(); ! } ! ! ! print endmenu('admin'); ! print endpage(); ! ! ###################################################################################################### ! # ! # html output functions.... ! ! sub default { ! my ($message) = @_; ! print heading("Branches"); ! print "<font color='red'>$message</font>"; ! print "<form action='$script_name' method=post><input type='hidden' name='op' value='add'><input type=submit value='Add New Branch'></form>"; ! print branchinfotable(); ! print branchcategoriestable(); ! } ! ! sub heading { ! my ($head) = @_; ! return "<FONT SIZE=6><em>$head</em></FONT><br>"; ! } ! ! sub editbranchform { ! # prepares the edit form... ! my ($branchcode) = @_; ! my $data; ! if ($branchcode) { ! $data = getbranchinfo($branchcode); ! $data = $data->[0]; ! } ! # make the checkboxs..... ! my $catinfo = getcategoryinfo(); ! my $catcheckbox; ! foreach my $cat (@$catinfo) { ! my $checked = ""; ! my $tmp = $cat->{'categorycode'}; ! if (grep {/^$tmp$/} @{$data->{'categories'}}) { ! $checked = "CHECKED"; ! } ! $catcheckbox .= <<EOF; ! <tr><td>$cat->{'categoryname'}</td> ! <td><INPUT TYPE="checkbox" NAME="$cat->{'categorycode'}" VALUE="1" $checked>$cat->{'codedescription'}</td></tr> ! EOF ! } ! my $form = <<EOF; ! <form action='$script_name' name=Aform method=post> ! <input type=hidden name=op value='add_validate'> ! <table> ! <tr><td>Branch code</td><td><input type=text name=branchcode size=5 maxlength=5 value='$data->{'branchcode'}'></td></tr> ! <tr><td>Name</td><td><input type=text name=branchname size=40 maxlength=80 value='$data->{'branchname'}'> </td></tr> ! $catcheckbox ! <tr><td>Address</td><td><input type=text name=branchaddress1 value='$data->{'branchaddress1'}'></td></tr> ! <tr><td> </td><td><input type=text name=branchaddress2 value='$data->{'branchaddress2'}'></td></tr> ! <tr><td> </td><td><input type=text name=branchaddress3 value='$data->{'branchaddress3'}'></td></tr> ! <tr><td>Phone</td><td><input type=text name=branchphone value='$data->{'branchphone'}'></td></tr> ! <tr><td>Fax</td><td><input type=text name=branchfax value='$data->{'branchfax'}'></td></tr> ! <tr><td>E-mail</td><td><input type=text name=branchemail value='$data->{'branchemail'}'></td></tr> ! <tr><td> </td><td><input type=submit value='Submit'></td></tr> ! </table> ! </form> ! EOF ! return $form; ! } ! ! sub deleteconfirm { ! # message to print if the ! my ($branchcode) = @_; ! my $output = <<EOF; ! Confirm delete: ! <form action='$script_name' method=post><input type='hidden' name='op' value='delete_confirmed'> ! <input type='hidden' name='branchcode' value=$branchcode> ! <input type=submit value=YES></form> ! <form action='$script_name' method=post><input type='hidden' name='op' value=''> ! <input type=submit value=NO></form> ! EOF ! return $output; ! } ! ! ! sub branchinfotable { ! # makes the html for a table of branch info from reference to an array of hashs. ! ! my ($branchcode) = @_; ! my $branchinfo; ! if ($branchcode) { ! $branchinfo = getbranchinfo($branchcode); ! } else { ! $branchinfo = getbranchinfo(); ! } ! my $table = <<EOF; ! <table border='1' cellpadding='5' cellspacing='0' width='550'> ! <tr> <th colspan='5' align='left' bgcolor='#99cc33' background=$backgroundimage> ! <font size='5'><b>Branches</b></font></th> </tr> ! <tr bgcolor='#889999'> ! <td width='175'><b>Name</b></td> ! <td width='25'><b>Code</b></td> ! <td width='175'><b>Address</b></td> ! <td width='175'><b>Categories</b></td> ! <td width='50'><b> </b></td> ! </tr> ! EOF ! ! my $color; ! foreach my $branch (@$branchinfo) { ! ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1); ! my $address = ''; ! $address .= $branch->{'branchaddress1'} if ($branch->{'branchaddress1'}); ! $address .= '<br>'.$branch->{'branchaddress2'} if ($branch->{'branchaddress2'}); ! $address .= '<br>'.$branch->{'branchaddress3'} if ($branch->{'branchaddress3'}); ! $address .= '<br>ph: '.$branch->{'branchphone'} if ($branch->{'branchphone'}); ! $address .= '<br>fax: '.$branch->{'branchfax'} if ($branch->{'branchfax'}); ! $address .= '<br>email: '.$branch->{'branchemail'} if ($branch->{'branchemail'}); ! $address = '(nothing entered)' unless ($address); ! my $categories = ''; ! foreach my $cat (@{$branch->{'categories'}}) { ! my ($catinfo) = @{getcategoryinfo($cat)}; ! $categories .= $catinfo->{'categoryname'}."<br>"; ! } ! $categories = '(no categories set)' unless ($categories); ! $table .= <<EOF; ! <tr bgcolor='$color'> ! <td align='left' valign='top'>$branch->{'branchname'}</td> ! <td align='left' valign='top'>$branch->{'branchcode'}</td> ! <td align='left' valign='top'>$address</td> ! <td align='left' valign='top'>$categories</td> ! <td align='left' valign='top'> ! <form action='$script_name' method=post> ! <input type='hidden' name='op' value='edit'> ! <input type='hidden' name='branchcode' value='$branch->{'branchcode'}'> ! <input type=submit value=Edit> ! </form> ! <form action='$script_name' method=post> ! <input type='hidden' name='branchcode' value='$branch->{'branchcode'}'> ! <input type='hidden' name='op' value='delete'><input type=submit value=Delete> ! </form></td> ! </tr> ! EOF ! } ! $table .= "</table><br>"; ! return $table; ! } ! ! sub branchcategoriestable { ! #Needs to be implemented... ! ! my $categoryinfo = getcategoryinfo(); ! my $table = <<EOF; ! <table border='1' cellpadding='5' cellspacing='0'> ! <tr> <th colspan='5' align='left' bgcolor='#99cc33' background=$backgroundimage> ! <font size='5'><b>Branches Categories</b></font></th> </tr> ! <tr bgcolor='#889999'> ! <td width='175'><b>Name</b></td> ! <td width='25'><b>Code</b></td> ! <td width='200'><b>Description</b></td> ! </tr> ! EOF ! my $color; ! foreach my $cat (@$categoryinfo) { ! ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1); ! $table .= <<EOF; ! <tr bgcolor='$color'> ! <td align='left' valign='top'>$cat->{'categoryname'}</td> ! <td align='left' valign='top'>$cat->{'categorycode'}</td> ! <td align='left' valign='top'>$cat->{'codedescription'}</td> ! </tr> ! EOF ! } ! $table .= "</table>"; ! return $table; ! } ! ! ###################################################################################################### ! # ! # Database functions.... ! ! sub getbranchinfo { ! # returns a reference to an array of hashes containing branches, ! ! my ($branchcode) = @_; ! my $dbh = &C4Connect; ! my $query; ! if ($branchcode) { ! my $bc = $dbh->quote($branchcode); ! $query = "Select * from branches where branchcode = $bc"; ! } ! else {$query = "Select * from branches";} ! my $sth = $dbh->prepare($query); ! $sth->execute; ! my @results; ! while (my $data = $sth->fetchrow_hashref) { ! my $tmp = $data->{'branchcode'}; my $brc = $dbh->quote($tmp); ! $query = "select categorycode from branchrelations where branchcode = $brc"; ! my $nsth = $dbh->prepare($query); ! $nsth->execute; ! my @cats = (); ! while (my ($cat) = $nsth->fetchrow_array) { ! push(@cats, $cat); ! } ! $nsth->finish; ! $data->{'categories'} = \@cats; ! push(@results, $data); ! } ! $sth->finish; ! $dbh->disconnect; ! return \@results; ! } ! ! sub getcategoryinfo { ! # returns a reference to an array of hashes containing branches, ! my ($catcode) = @_; ! my $dbh = &C4Connect; ! my $query; ! if ($catcode) { ! my $cc = $dbh->quote($catcode); ! $query = "select * from branchcategories where categorycode = $cc"; ! } else { ! $query = "Select * from branchcategories"; ! } ! my $sth = $dbh->prepare($query); ! $sth->execute; ! my @results; ! while (my $data = $sth->fetchrow_hashref) { ! push(@results, $data); ! } ! $sth->finish; ! $dbh->disconnect; ! return \@results; ! } ! ! sub setbranchinfo { ! # sets the data from the editbranch form, and writes to the database... ! my ($data) = @_; ! my $dbh=&C4Connect; ! my $query = "replace branches (branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail) values ("; ! my $tmp; ! $tmp = $data->{'branchcode'}; $query.= $dbh->quote($tmp).","; ! $tmp = $data->{'branchname'}; $query.= $dbh->quote($tmp).","; ! $tmp = $data->{'branchaddress1'}; $query.= $dbh->quote($tmp).","; ! $tmp = $data->{'branchaddress2'}; $query.= $dbh->quote($tmp).","; ! $tmp = $data->{'branchaddress3'}; $query.= $dbh->quote($tmp).","; ! $tmp = $data->{'branchphone'}; $query.= $dbh->quote($tmp).","; ! $tmp = $data->{'branchfax'}; $query.= $dbh->quote($tmp).","; ! $tmp = $data->{'branchemail'}; $query.= $dbh->quote($tmp).")"; ! my $sth=$dbh->prepare($query); ! $sth->execute; ! $sth->finish; ! $dbh->disconnect; ! # sort out the categories.... ! my @checkedcats; ! my $cats = getcategoryinfo(); ! foreach my $cat (@$cats) { ! my $code = $cat->{'categorycode'}; ! if ($data->{$code}) { ! push(@checkedcats, $code); ! } ! } ! my $branchcode = $data->{'branchcode'}; ! my $branch = getbranchinfo($branchcode); ! $branch = $branch->[0]; ! my $branchcats = $branch->{'categories'}; ! my @addcats; ! my @removecats; ! foreach my $bcat (@$branchcats) { ! unless (grep {/^$bcat$/} @checkedcats) { ! push(@removecats, $bcat); ! } ! } ! foreach my $ccat (@checkedcats){ ! unless (grep {/^$ccat$/} @$branchcats) { ! push(@addcats, $ccat); ! } ! } ! my $dbh=&C4Connect; ! foreach my $cat (@addcats) { ! my $query = "insert into branchrelations (branchcode, categorycode) values('$branchcode', '$cat')"; ! my $sth = $dbh->prepare($query); $sth->execute; $sth->finish; ! } ! foreach my $cat (@removecats) { ! my $query = "delete from branchrelations where branchcode='$branchcode' and categorycode='$cat'"; ! my $sth = $dbh->prepare($query); $sth->execute; $sth->finish; ! } ! $dbh->disconnect; ! } ! ! sub deletebranch { ! # delete branch... ! my ($branchcode) = @_; ! my $query = "delete from branches where branchcode = '$branchcode'"; ! my $dbh=&C4Connect; ! my $sth=$dbh->prepare($query); ! $sth->execute; ! $sth->finish; ! $dbh->disconnect; ! } ! ! sub checkdatabasefor { ! # check to see if the branchcode is being used in the database somewhere.... ! my ($branchcode) = @_; ! my $dbh = &C4Connect; ! my $sth=$dbh->prepare("select count(*) from items where holdingbranch='$branchcode' or homebranch='$branchcode'"); ! $sth->execute; ! my ($total) = $sth->fetchrow_array; ! $sth->finish; ! $dbh->disconnect; ! my $message; ! if ($total) { ! $message = "Branch cannot be deleted because there are $total items using that branch."; ! } ! return $message; ! } ! !

1 0

CVS: koha/updater updatedatabase,1.4,1.5
by Finlay Thompson 01 May '02

01 May '02

Update of /cvsroot/koha/koha/updater In directory usw-pr-cvs1:/tmp/cvs-serv15441/updater Modified Files: updatedatabase Log Message: moredetail.pl presents circulation information taken from the branchtransfers table Circ2.pm has been changed a little admin/branches.pl alows branches to be added, edited and deleted. updatedatabase needs more fixing Index: updatedatabase =================================================================== RCS file: /cvsroot/koha/koha/updater/updatedatabase,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -r1.4 -r1.5 *** updatedatabase 26 Mar 2002 05:08:52 -0000 1.4 --- updatedatabase 2 May 2002 00:08:53 -0000 1.5 *************** *** 138,156 **** print "Setting type of categorycode in branchcategories to varchar(4),\n and making the primary key.\n"; my $sti=$dbh->prepare("alter table branchcategories change categorycode categorycode varchar(4) not null"); ! $sti->execute; ! $sti=$dbh->prepare("alter table branchcategories add primary key (categorycode)"); ! $sti->execute; } unless ($branchcategories{'branchcode'} eq 'varchar(4)') { ! print "Setting type of branchcode in branchcategories to varchar(4).\n"; ! my $sti=$dbh->prepare("alter table branchcategories change branchcode branchcode varchar(4)"); ! $sti->execute; } unless ($branchcategories{'codedescription'} eq 'text') { print "Replacing branchholding in branchcategories with codedescription text.\n"; ! my $sti=$dbh->prepare("alter table branchcategories change branchholding codedescription text"); ! $sti->execute; } --- 138,173 ---- print "Setting type of categorycode in branchcategories to varchar(4),\n and making the primary key.\n"; my $sti=$dbh->prepare("alter table branchcategories change categorycode categorycode varchar(4) not null"); ! $sth->execute; ! $sth=$dbh->prepare("alter table branchcategories add primary key (categorycode)"); ! $sth->execute; } unless ($branchcategories{'branchcode'} eq 'varchar(4)') { ! print "Changing branchcode in branchcategories to categoryname text.\n"; ! my $sth=$dbh->prepare("alter table branchcategories change branchcode categoryname text"); ! $sth->execute; } unless ($branchcategories{'codedescription'} eq 'text') { print "Replacing branchholding in branchcategories with codedescription text.\n"; ! my $sth=$dbh->prepare("alter table branchcategories change branchholding codedescription text"); ! $sth->execute; ! } ! ! # Create new branchrelations table if it doesnt already exist.... ! my $branchrelationsexists; ! ! my $sth=$dbh->prepare("show tables"); ! $sth->execute; ! while (my ($tablename) = $sth->fetchrow) { ! if ($tablename == "branchrelations") { ! $branchrelationsexists = 1; ! } ! } ! ! unless ($branchrelationsexists) { ! print "creating branchrelations table"; ! my $sth->prepare("create table branchrelations (branchcode varchar(4), categorycode varchar(4))"); ! $sth->execute; }

1 0

CVS: koha bookcount.pl,NONE,1.1 moredetail.pl,1.4,1.5
by Finlay Thompson 01 May '02

01 May '02

Update of /cvsroot/koha/koha In directory usw-pr-cvs1:/tmp/cvs-serv15441 Modified Files: moredetail.pl Added Files: bookcount.pl Log Message: moredetail.pl presents circulation information taken from the branchtransfers table Circ2.pm has been changed a little admin/branches.pl alows branches to be added, edited and deleted. updatedatabase needs more fixing --- NEW FILE --- #!/usr/bin/perl #written 7/3/2002 by Finlay #script to display reports use strict; use CGI; use C4::Search; use C4::Circulation::Circ2; use C4::Output; # get all the data .... my %env; my $main='#cccc99'; my $secondary='#ffffcc'; my $input = new CGI; my $itm = $input->param('itm'); my $bi = $input->param('bi'); my $bib = $input->param('bib'); my $branches = getbranches(\%env); my $idata = itemdatanum($itm); my $data = bibitemdata($bi); my $homebranch = $branches->{$idata->{'homebranch'}}->{'branchname'}; my $holdingbranch = $branches->{$idata->{'holdingbranch'}}->{'branchname'}; my ($lastmove, $message) = lastmove($itm); my $lastdate; my $count; if (not $lastmove) { $lastdate = $message; $count = issuessince($itm , 0); } else { $lastdate = $lastmove->{'datearrived'}; $count = issuessince($itm ,$lastdate); } # make the page ... print $input->header; print startpage; print startmenu('report'); print center; print <<"EOF"; <br> <FONT SIZE=6><em><a href=/cgi-bin/koha/detail.pl?bib=$bib&type=intra>$data->{'title'} ($data->{'author'})</a></em></FONT><P> <p> <img src="/images/holder.gif" width=16 height=200 align=left> <TABLE CELLSPACING=0 CELLPADDING=5 border=1 width=440 > <TR VALIGN=TOP><td bgcolor="99cc33" background="/images/background-mem.gif"> <B>BARCODE $idata->{'barcode'}</b></TD> </TR> <TR VALIGN=TOP > <TD width=440 > <b>Home Branch: </b> $homebranch <br> <b>Current Branch: </b> $holdingbranch<br> <b>Date arrived at current branch: </b> $lastdate <br> <b>Number of issues since since the above date :</b> $count <br> <table cellspacing =0 cellpadding=5 border=1 width = 440> <TR><TD > <b>Branch</b></td> <TD > <b>No. of Issues</b></td> <td><b>Last seen at branch</b></td></TR> EOF foreach my $branchcode (keys %$branches) { my $issues = issuesat($itm, $branchcode); my $date = lastseenat($itm, $branchcode); my $seen = slashdate($date); print << "EOF"; <TR><TD > <b>$branches->{$branchcode}->{'branchname'}</b></td> <TD > <b> $issues </b></td> <td><b> $seen</b></td></TR> EOF } print <<"EOF"; </table> </TR> </table> EOF print endmenu('report'); print endpage; ############################################## # This stuff should probably go into C4::Search # database includes use DBI; use C4::Database; sub itemdatanum { my ($itemnumber)=@_; my $dbh=C4Connect; my $itm = $dbh->quote("$itemnumber"); my $query = "select * from items where itemnumber=$itm"; my $sth=$dbh->prepare($query); $sth->execute; my $data=$sth->fetchrow_hashref; $sth->finish; $dbh->disconnect; return($data); } sub lastmove { my ($itemnumber)=@_; my $dbh=C4Connect; my $var1 = $dbh->quote($itemnumber); my $sth =$dbh->prepare("select max(branchtransfers.datearrived) from branchtransfers where branchtransfers.itemnumber=$var1"); $sth->execute; my ($date) = $sth->fetchrow_array; return(0, "Item has no branch transfers record") if not $date; my $var2 = $dbh->quote($date); $sth=$dbh->prepare("Select * from branchtransfers where branchtransfers.itemnumber=$var1 and branchtransfers.datearrived=$var2"); $sth->execute; my ($data) = $sth->fetchrow_hashref; return(0, "Item has no branch transfers record") if not $data; $sth->finish; $dbh->disconnect; return($data,""); } sub issuessince { my ($itemnumber, $date)=@_; my $dbh=C4Connect; my $itm = $dbh->quote($itemnumber); my $dat = $dbh->quote($date); my $sth=$dbh->prepare("Select count(*) from issues where issues.itemnumber=$itm and issues.timestamp > $dat"); $sth->execute; my $count=$sth->fetchrow_hashref; $sth->finish; $dbh->disconnect; return($count->{'count(*)'}); } sub issuesat { my ($itemnumber, $brcd)=@_; my $dbh=C4Connect; my $itm = $dbh->quote($itemnumber); my $brc = $dbh->quote($brcd); my $query = "Select count(*) from issues where itemnumber=$itm and branchcode = $brc"; my $sth=$dbh->prepare($query); $sth->execute; my ($count)=$sth->fetchrow_array; $sth->finish; $dbh->disconnect; return($count); } sub lastseenat { my ($itemnumber, $brcd)=@_; my $dbh=C4Connect; my $itm = $dbh->quote($itemnumber); my $brc = $dbh->quote($brcd); my $query = "Select max(timestamp) from issues where itemnumber=$itm and branchcode = $brc"; my $sth=$dbh->prepare($query); $sth->execute; my ($date1)=$sth->fetchrow_array; $sth->finish; $query = "Select max(datearrived) from branchtransfers where itemnumber=$itm and tobranch = $brc"; my $sth=$dbh->prepare($query); $sth->execute; my ($date2)=$sth->fetchrow_array; $sth->finish; $dbh->disconnect; $date2 =~ s/-//g; $date2 =~ s/://g; $date2 =~ s/ //g; my $date; if ($date1 < $date2) { $date = $date2; } else { $date = $date1; } return($date); } ##################################################### # write date.... sub slashdate { my ($date) = @_; if (not $date) { return "never"; } my ($yr, $mo, $da, $hr, $mi) = (substr($date, 0, 4), substr($date, 4, 2), substr($date, 6, 2), substr($date, 8, 2), substr($date, 10, 2)); return "$hr:$mi $da/$mo/$yr"; } Index: moredetail.pl =================================================================== RCS file: /cvsroot/koha/koha/moredetail.pl,v retrieving revision 1.4 retrieving revision 1.5 diff -C2 -r1.4 -r1.5 *** moredetail.pl 8 Apr 2002 23:44:43 -0000 1.4 --- moredetail.pl 2 May 2002 00:08:53 -0000 1.5 *************** *** 172,176 **** print <<printend <b>Cancelled: $items[$i]->{'wthdrawn'}<br> ! <b>Total Issues:</b> $items[$i]->{'issues'}<br> <b>Group Number:</b> $bi <br> <b>Biblio number:</b> $bib <br> --- 172,176 ---- print <<printend <b>Cancelled: $items[$i]->{'wthdrawn'}<br> ! <b><a href=/cgi-bin/koha/bookcount.pl?&bib=$bib&bi=$bi&itm=$items[$i]->{'itemnumber'}>Total Issues:</a></b> $items[$i]->{'issues'}<br> <b>Group Number:</b> $bi <br> <b>Biblio number:</b> $bib <br>

1 0

New tarball
by Chris Cormack 01 May '02

01 May '02

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(a)katipo.co.nz www.katipo.co.nz

1 0

CVS: koha/C4 Database.pm,1.2.2.1,1.2.2.2
by Chris Cormack 30 Apr '02

30 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv4942/C4 Modified Files: Tag: rel-1-2 Database.pm Log Message: Commiting the uncrufted Database module into the stable branch Index: Database.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Database.pm,v retrieving revision 1.2.2.1 retrieving revision 1.2.2.2 diff -C2 -r1.2.2.1 -r1.2.2.2 *** Database.pm 25 Apr 2002 21:59:55 -0000 1.2.2.1 --- Database.pm 30 Apr 2002 09:30:52 -0000 1.2.2.2 *************** *** 1,3 **** ! package C4::Database; #assumes C4/Database use strict; --- 1,5 ---- ! package C4::Database; #asummes C4/Database ! ! #requires DBI.pm to be installed use strict; *************** *** 6,15 **** use vars qw($VERSION @ISA @EXPORT); - # set the version for version checking $VERSION = 0.01; @ISA = qw(Exporter); ! @EXPORT = qw(&C4Connect &sqlinsert &sqlupdate &getmax &makelist ! &OpacConnect); sub C4Connect { --- 8,16 ---- use vars qw($VERSION @ISA @EXPORT); $VERSION = 0.01; @ISA = qw(Exporter); ! @EXPORT = qw(&C4Connect); ! sub C4Connect { *************** *** 40,133 **** } - sub Opaconnect { - my $dbname="c4"; - # my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "chris", ""); - my $database='c4test'; - my $hostname='localhost'; - my $user='hdl'; - my $pass='testing'; - my $dbh=DBI->connect("DBI:mysql:$database:$hostname",$user,$pass); - return $dbh; - } ! sub sqlinsert { ! my ($table,%data)=@_; ! my $dbh=C4Connect; ! my $query="INSERT INTO $table $"; ! while (my ($key,$value) = each %data){ ! if ($key ne 'type' && $key ne 'updtype'){ ! $query=$query."$key,"; ! } ! } ! $query=~ s/\,$/$/; ! $query=$query." VALUES ("; ! while (my ($key,$value) = each %data){ ! if ($key ne 'type' && $key ne 'updtype'){ ! $query=$query."'$value',"; ! } ! } ! $query=~ s/\,$/\)/; ! print $query; ! my $sth=$dbh->prepare($query); ! $sth->execute; ! $sth->finish; ! $dbh->disconnect; ! } ! ! sub sqlupdate { ! my ($table,$keyfld,$keyval,%data)=@_; ! my $dbh=C4Connect; ! my $query="UPDATE $table SET "; ! my @sets; ! my @keyarr = split("\t",$keyfld); ! my @keyvalarr = split("\t",$keyval); ! my $numkeys = @keyarr; ! while (my ($key,$value) = each %data){ ! if (($key ne 'type')&&($key ne 'updtype')){ ! my $temp = " ".$key."='".$value."' "; ! push(@sets,$temp); ! } ! } ! my $fsets = join(",", @sets); ! $query=$query.$fsets." WHERE $keyarr[0] = '$keyvalarr[0]'"; ! if ($numkeys > 1) { ! my $i = 1; ! while ($i < $numkeys) { ! $query=$query." AND $keyarr[$i] = '$keyvalarr[$i]'"; ! $i++; ! } ! } ! # $query=~ s/\,$/\)/; ! print $query; ! my $sth=$dbh->prepare($query); ! $sth->execute; ! $sth->finish; ! $dbh->disconnect; ! } ! ! ! sub getmax { ! my ($table,$item)=@_; ! my $dbh=C4Connect; ! my $sth=$dbh->prepare("Select max($item) from $table"); ! $sth->execute; ! my $data=$sth->fetchrow_hashref; ! $sth->finish; ! $dbh->disconnect; ! return($data); ! } ! ! sub makelist { ! my ($table,$kfld,$dfld)=@_; ! my $data; ! my $dbh=C4Connect; ! my $sth=$dbh->prepare("Select $kfld,$dfld from $table order by $dfld"); ! $sth->execute; ! while (my $drec=$sth->fetchrow_hashref) { ! $data = $data."\t".$drec->{$kfld}."\t".$drec->{$dfld}; ! } ! $sth->finish; ! $dbh->disconnect; ! return($data); ! } ! END { } # module clean-up code here (global destructor) --- 41,44 ---- } ! END { }

1 0

CVS: koha/C4 Database.pm,1.2,1.3
by Chris Cormack 30 Apr '02

30 Apr '02

Update of /cvsroot/koha/koha/C4 In directory usw-pr-cvs1:/tmp/cvs-serv781/C4 Modified Files: Database.pm Log Message: Cleaning out all unused cruft. C4Connect is the only function that was actually being used in this module Index: Database.pm =================================================================== RCS file: /cvsroot/koha/koha/C4/Database.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -r1.2 -r1.3 *** Database.pm 21 Dec 2000 19:56:43 -0000 1.2 --- Database.pm 30 Apr 2002 09:21:03 -0000 1.3 *************** *** 2,53 **** #requires DBI.pm to be installed - #uses DBD:Pg use strict; require Exporter; use DBI; ! use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - # set the version for version checking $VERSION = 0.01; @ISA = qw(Exporter); ! @EXPORT = qw(&C4Connect &sqlinsert &sqlupdate &getmax &makelist ! &OpacConnect); ! %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], ! ! # your exported package globals go here, ! # as well as any optionally exported functions ! ! @EXPORT_OK = qw($Var1 %Hashit); ! ! ! # non-exported package globals go here ! use vars qw(@more $stuff); ! ! # initalize package globals, first exported ones ! ! my $Var1 = ''; ! my %Hashit = (); ! ! # then the others (which are still accessible as $Some::Module::stuff) ! my $stuff = ''; ! my @more = (); ! ! # all file-scoped lexicals must be created before ! # the functions below that use them. ! ! # file-private lexicals go here ! my $priv_var = ''; ! my %secret_hash = (); ! ! # here's a file-private function as a closure, ! # callable as &$priv_func; it cannot be prototyped. ! my $priv_func = sub { ! # stuff goes here. ! }; ! ! # make all your functions, whether exported or not; ! --- 2,15 ---- #requires DBI.pm to be installed use strict; require Exporter; use DBI; ! use vars qw($VERSION @ISA @EXPORT); $VERSION = 0.01; @ISA = qw(Exporter); ! @EXPORT = qw(&C4Connect); *************** *** 79,172 **** } - sub Opaconnect { - my $dbname="c4"; - # my $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "chris", ""); - my $database='c4test'; - my $hostname='localhost'; - my $user='hdl'; - my $pass='testing'; - my $dbh=DBI->connect("DBI:mysql:$database:$hostname",$user,$pass); - return $dbh; - } - - sub sqlinsert { - my ($table,%data)=@_; - my $dbh=C4Connect; - my $query="INSERT INTO $table $"; - while (my ($key,$value) = each %data){ - if ($key ne 'type' && $key ne 'updtype'){ - $query=$query."$key,"; - } - } - $query=~ s/\,$/$/; - $query=$query." VALUES ("; - while (my ($key,$value) = each %data){ - if ($key ne 'type' && $key ne 'updtype'){ - $query=$query."'$value',"; - } - } - $query=~ s/\,$/\)/; - print $query; - my $sth=$dbh->prepare($query); - $sth->execute; - $sth->finish; - $dbh->disconnect; - } - - sub sqlupdate { - my ($table,$keyfld,$keyval,%data)=@_; - my $dbh=C4Connect; - my $query="UPDATE $table SET "; - my @sets; - my @keyarr = split("\t",$keyfld); - my @keyvalarr = split("\t",$keyval); - my $numkeys = @keyarr; - while (my ($key,$value) = each %data){ - if (($key ne 'type')&&($key ne 'updtype')){ - my $temp = " ".$key."='".$value."' "; - push(@sets,$temp); - } - } - my $fsets = join(",", @sets); - $query=$query.$fsets." WHERE $keyarr[0] = '$keyvalarr[0]'"; - if ($numkeys > 1) { - my $i = 1; - while ($i < $numkeys) { - $query=$query." AND $keyarr[$i] = '$keyvalarr[$i]'"; - $i++; - } - } - # $query=~ s/\,$/\)/; - print $query; - my $sth=$dbh->prepare($query); - $sth->execute; - $sth->finish; - $dbh->disconnect; - } - - - sub getmax { - my ($table,$item)=@_; - my $dbh=C4Connect; - my $sth=$dbh->prepare("Select max($item) from $table"); - $sth->execute; - my $data=$sth->fetchrow_hashref; - $sth->finish; - $dbh->disconnect; - return($data); - } ! sub makelist { ! my ($table,$kfld,$dfld)=@_; ! my $data; ! my $dbh=C4Connect; ! my $sth=$dbh->prepare("Select $kfld,$dfld from $table order by $dfld"); ! $sth->execute; ! while (my $drec=$sth->fetchrow_hashref) { ! $data = $data."\t".$drec->{$kfld}."\t".$drec->{$dfld}; ! } ! $sth->finish; ! $dbh->disconnect; ! return($data); ! } ! END { } # module clean-up code here (global destructor) --- 41,44 ---- } ! END { }

1 0

koha 1.1.2 thoughts
by Pat Eyler 29 Apr '02

29 Apr '02

Just to toss out some ideas for what should entail a 1.1.2 release (mostly culled from the RoadMap and ToDo pages on the wiki): TASK TARGET COMPLETION Create a new branch on CVS (done - thanks Chris) Create an RC1 tarball (done - thanks Chris) Winnow out useless code 5/10 Start buglist 4/26 Make 'ethnicity' a db and 5/3 module issue. Identify Show-Stoppers 5/10 Modify memberentry.pl to get 5/10 contents of 'categories' from 'borrowers' Create an RC2 tarball 5/17 Separate out the select list 5/17 of classes from /cat/index.html and /catalogue/index.html Separate out the select list 5/17 for "Membership category" from memberentry.pl create /includes/member-category-list.inc Create an RC3 tarball 5/31 (if all goes well) Create a 1.1.2 release 6/7

2 1

CVS: koha/acqui.simple addbiblio.pl,NONE,1.1 addbiblioitem.pl,NONE,1.1 additem.pl,NONE,1.1 isbnsearch.pl,NONE,1.1 keywordsearch.pl,NONE,1.1 savebiblio.pl,NONE,1.1 savebiblioitem.pl,NONE,1.1 saveitem.pl,NONE,1.1 websitesearch.pl,NONE,1.1
by Gynn Lomax 29 Apr '02

29 Apr '02

Update of /cvsroot/koha/koha/acqui.simple In directory usw-pr-cvs1:/tmp/cvs-serv28376 Added Files: addbiblio.pl addbiblioitem.pl additem.pl isbnsearch.pl keywordsearch.pl savebiblio.pl savebiblioitem.pl saveitem.pl websitesearch.pl Log Message: scripts for new acqui.simple system --- NEW FILE --- #!/usr/bin/perl # # TODO # # Add info on biblioitems and items already entered as you enter new ones # use CGI; use strict; use C4::Output; my $input = new CGI; my $error = $input->param('error'); print $input->header; print startpage(); print startmenu('acquisitions'); print << "EOF"; <FONT SIZE=6><em>Adding a new Biblio</em></FONT><br> <table bgcolor="#ffcc00" width="80%" cellpadding="5"> <tr> <td><FONT SIZE=5>Section One: Copyright Information </font></td> </tr> </table> EOF if ($error eq "notitle") { print << "EOF"; <p /> <center> <font color="#FF0000">Please Specify a Title</font> </center> EOF } # if print << "EOF"; <FORM action="savebiblio.pl" method="post"> <table align="center"> <tr> <td>Title: *</td> <td><INPUT name="title" size="40" /></td> </tr> <tr> <td>Subtitle:</td> <td><INPUT name="subtitle" size="40" /></td> </tr> <tr> <td>Author:</td> <td><INPUT name="author" size="40" /></td> </tr> <tr valign="top"> <td>Series Title:<br /> <i>(if applicable)</i></td> <td><INPUT name="seriestitle" size="40" /></td> </tr> <tr> <td>Copyright Date:</td> <td><INPUT name="copyrightdate" size="40" /></td> </tr> <tr valign="top"> <td>Abstract:</td> <td><textarea cols="30" rows="6" name="abstract"></textarea></td> </tr> <tr valign="top"> <td>Notes:</td> <td><textarea cols="30" rows="6" name="notes"></textarea></td> </tr> <tr valign="top"> <td colspan="2"><center><input type="submit" value="Submit"></center></td> </tr> </table> </FORM> * Required EOF print endmenu(); print endpage(); --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; use C4::Output; my $input = new CGI; my $biblionumber = $input->param('biblionumber'); my $title; my $count; my @results; if (! $biblionumber) { print $input->redirect('addbooks.pl'); } else { ($count, @results) = &getbiblio($biblionumber); $title = @results[0]->{'title'}; print $input->header; print startpage(); print startmenu('acquisitions'); print << "EOF"; <font size="6"><em>Adding New Group Information - $title</em></font> <table bgcolor="#ffcc00" width="80%" cellpadding="5"> <tr valign="center"> <td><font size="5">Section Two: Publication information</font></td> </tr></table> <p /> <form action="savebiblioitem.pl" method="post"> <input type="hidden" name="biblionumber" value="$biblionumber"> <table align="center"> <tr> <td align="right">Publisher:</td> <td colspan="3"><INPUT name="publishercode" size="40"></td> </tr> <tr> <td align="right">Publication Year:</td> <td><INPUT name="publicationyear" size="20"></td> <td align="right">Place of Publication:</td> <td><input name="place" size="20"></td> </tr> <tr> <td align="right">Illustrator:</td> <td colspan="3"><INPUT name="illus" size="40"></td> </tr> <tr> <td align="right">ISBN:</td> <td colspan="3"><input name="isbn" size="40"></td> </tr> <tr valign="top"> <td align="right">Additional Authors:<br><i>One Author per line</i></td> <td colspan="3"><textarea name="additionalauthors" cols="30" rows="6"></textarea></td> </tr> <tr valign="top"> <td align="right">Subject Headings:<br><i>One Subject per line</i></td> <td colspan="3"><textarea name="subjectheadings" cols="30" rows="6"></textarea></td> </tr> <tr> <td align="right">Format:</td> <td colspan="3"><select name="itemtype"> EOF ($count, @results) = &getitemtypes; for (my $i = 0; $i < $count; $i++) { print << "EOF"; <option value="$results[$i]->{'itemtype'}">$results[$i]->{'itemtype'} - $results[$i]->{'description'} EOF } # for print << "EOF"; </select></td> </tr> <tr> <td align="right">URL:</td> <td colspan="3"><INPUT name="url" size="40"></td> </tr> <tr> <td align="right">Dewey:</td> <td><INPUT name="dewey" size="20"></td> <td align="right">Dewey Subclass:</td> <td><input name="subclass" size="20"></td> </tr> <tr> <td align="right">ISSN:</td> <td><input name="issn" size="20"></td> <td align="right">LCCN:</td> <td><input name="lccn" size="20"</td> </tr> <tr> <td align="right">Volume:</td> <td><input name="volume" size="20"></td> <td align="right">Number:</td> <td><input name="number" size="20"></td> </tr> <tr> <td align="right">Volume Description:</td> <td colspan="3"><input name="volumeddesc" size="40"></td> </tr> <tr> <td align="right">Pages:</td> <td><input name="pages" size="20"></td> <td align="right">Size:</td> <td><input name="size" size="20"></td> </tr> <tr valign="top"> <td align="right">Notes:</td> <td colspan="3"><textarea name="notes" cols="30" rows="6"></textarea></td> </tr> <tr valign="top"> <td colspan="4" align="center"><input type="submit" value="Add New Item"></td> </tr> </table></FORM> EOF print endmenu(); print endpage(); } # else --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; use C4::Output; my $input = new CGI; my $biblioitemnum = $input->param('biblioitemnum'); my $maxbarcode; my $isbn; my $count; my @results; if (! $biblioitemnum) { print $input->redirect('addbooks.pl'); } else { ($count, @results) = &getbiblioitem($biblioitemnum); if (! $count) { print $input->redirect('addbooks.pl'); } else { $isbn = $results[0]->{'isbn'}; $maxbarcode = $results[0]->{'biblionumber'}; print $input->header; print startpage(); print startmenu('acquisitions'); ($count, @results) = &getitemsbybiblioitem($biblioitemnum); if ($count) { print << "EOF"; <center> <p> <table border=1 bgcolor=#dddddd> <tr> <th colspan=4>Existing Items with ISBN $isbn</th> </tr> <tr> <th>Barcode</th><th>Title</th><th>Author</th><th>Notes</th></tr> EOF for (my $i = 0; $i < $count; $i++) { print << "EOF"; <tr> <td align=center>$results[$i]->{'barcode'}</td> <td><u>$results[$i]->{'title'}</u></td> <td>$results[$i]->{'author'}</td> <td>$results[$i]->{'itemnotes'}</td> </tr> EOF } # for print << "EOF"; </table> </center> EOF } # if print << "EOF"; <center> <h2>Section Three: Specific Item Information</h2> <form action="saveitems" method="post"> <input type="hidden" name="biblioitemnum" value="$biblioitemnum"> <table> <tr> <td align="right">BARCODE:</td> <td><input name="barcode" size="10" value="$maxbarcode" /></td> <td align="right">Home Branch:</td> <td><select name="homebranch"><option value="STWE">Stewart Elementary<option value="MEZ">Meziadin Elementary</select></td> </tr> <tr> <td align="right">Replacement Price:</td> <td colspan="3"><input name="replacementprice" size="10"></td> </tr> <tr valign="top"> <td align="right">Notes:</td> <td colspan="3"><textarea name="notes" rows="4" cols="40" wrap="physical"></textarea></td> </tr> </table> <input type="submit" value="Add Item" /> </form> </center> EOF print endmenu(); print endpage(); } # if } # if --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; my $input = new CGI; my $isbn = $input->param('isbn'); my $biblioitemnum; my $count; my @results; if (! $isbn) { print $input->redirect('addbooks.pl'); } else { ($count, @results) = &isbnsearch($isbn); if (! $count) { print $input->redirect("addbooks.pl?error=notfound"); } else { $biblioitemnum = $results[0]->{'biblioitemnumber'}; print $input->redirect("additem.pl?biblioitemnum=$biblioitemnum"); } # else } # else --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; use C4::Output; my $input = new CGI; my $keywords = $input->param('keyword'); my $offset = $input->param('offset'); my $num = $input->param('num'); my $total; my $count; my @results; if (! $keywords) { print $input->redirect('addbooks.pl'); } else { if (! $offset) { $offset = 0 }; if (! $num) { $num = 10 }; ($count, @results) = &keywordsearch($keywords); if ($count < ($offset + $num)) { $total = $count; } else { $total = $offset + $num; } # else print $input->header; print startpage(); print startmenu('acquisitions'); print << "EOF"; <font size="6"><em>Biblio Search Results</em></font><br /> <CENTER> You searched on <b>keywords $keywords,</b> $count results found <br /> Results $offset to $total displayed <div align="right"> <h2><a href="addbiblio.pl">Add New Biblio</a></h2> </div> <p /> <table border="0" cellspacing="0" cellpadding="5"> <tr valign=top bgcolor=#cccc99> <td background="/images/background-mem.gif"><b>TITLE</b></td> <td background="/images/background-mem.gif"><b>AUTHOR</b></td> <td background="/images/background-mem.gif"><b>©</b></td> </tr> EOF for (my $i = $offset; $i < $total; $i++) { if ($i % 2) { print << "EOF"; <tr valign="top" bgcolor="#ffffcc"> EOF } else { print << "EOF"; <tr valign="top" bgcolor="#ffffff"> EOF } # else print << "EOF"; <td><a href="addbiblioitem.pl?biblionumber=$results[$i]->{'biblionumber'}">$results[$i]->{'title'}</a></td> <td><a href="addbiblioitem.pl?biblionumber=$results[$i]->{'biblionumber'}">$results[$i]->{'author'}</a></td> <td>$results[$i]->{'copyrightdate'}</td> </tr> EOF } # for print << "EOF"; <tr valign=top bgcolor=#cccc99> <td background="/images/background-mem.gif"> </td> <td background="/images/background-mem.gif"> </td> <td background="/images/background-mem.gif"> </td> </tr> </table> <br /> EOF for (my $i = 0; ($i * $num) < $count; $i++) { my $newoffset = $i * $num; print << "EOF"; <a href="keywordsearch.pl?keyword=$keywords&offset=$newoffset&num=$num">$i</a> EOF } # for print << "EOF"; <p /> Results per page: <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=5">5</a> <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=10">10</a> <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=20">20</a> <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=50">50</a> </CENTER> <br clear="all" /> <p> </p> EOF print endmenu(); print endpage(); } # else --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; my $input = new CGI; my $biblio->{'title'} = $input->param('title'); my $biblio->{'subtitle'} = $input->param('subtitle'); my $biblio->{'author'} = $input->param('author'); my $biblio->{'seriestitle'} = $input->param('seriestitle'); my $biblio->{'copyright'} = $input->param('copyrightdate'); my $biblio->{'abstract'} = $input->param('abstract'); my $biblio->{'notes'} = $input->param('notes'); my $biblionumber; if (! $biblio->{'title'}) { print $input->redirect('addbiblio.pl?error=notitle'); } else { $biblionumber = &newbiblio($biblio); &newsubtitle($biblionumber, $subtitle); print $input->redirect('addbiblioitem.pl?biblionumber=$biblionumber'); } # else --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; my $input = new CGI; my $biblionumber = $input->param('biblionumber'); my $biblioitem = { biblionumber => $biblionumber, publishercode => $input->param('publishercode'), publicationyear => $input->param('publicationyear'), place => $input->param('year'), illus => $input->param('illus'), isbn => $input->param('isbn'), additionalauthors => $input->param('additionalauthors'), subjectheadings => $input->param('subjectheadings'), itemtype => $input->param('itemtype'), url => $input->param('url'), dewey => $input->param('dewey'), subclass => $input->param('subclass'), issn => $input->param('issn'), lccn => $input->param('lccn'), volume => $input->param('volume'), number => $input->param('number'), volumeddesc => $input->param('volumeddesc'), pages => $input->param('pages'), size => $input->param('size'), notes => $input->param('notes') }; my $biblioitemnum; if (! $biblionumber) { print $input->redirect('addbooks.pl'); } else { $biblioitemnum = &newbiblioitem($biblioitem); print $input->redirect('additem.pl?biblioitemnum=$biblioitemnum'); } # else --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; my $input = new CGI; my $barcode = $input->param('barcode'); my $biblioitemnum = $input->param('biblioitemnum'); my $item = { biblioitemnum => $biblioitemnum, homebranch => $input->param('homebranch'), replacementprice => $input->param('replacementprice'), itemnotes => $input->param('notes') }; my $count; my @results; if (! $barcode) { print $input->redirect('additem.pl?error=nobarcode'); } elsif (! $biblioitemnum) { print $input->redirect('addbooks.pl'); } else { ($count, @results) = &getbiblioitem($biblioitemnum); if (! $count) { print->redirect('addbooks.pl'); } else { $item->{'biblionumber'} = $results[0]->{'biblionumber'}; &newitems($item, ($barcode)); print $input->redirect('additem.pl?biblioitemnum=$biblioitemnum'); } # else } # else --- NEW FILE --- #!/usr/bin/perl use CGI; use strict; use C4::Acquisitions; use C4::Output; my $input = new CGI; my $keywords = $input->param('keyword'); my $offset = $input->param('offset'); my $num = $input->param('num'); my $total; my $count; my @results; if (! $keywords) { print $input->redirect('addbooks.pl'); } else { if (! $offset) { $offset = 0 }; if (! $num) { $num = 10 }; ($count, @results) = &websitesearch($keywords); if ($count < ($offset + $num)) { $total = $count; } else { $total = $offset + $num; } # else print $input->header; print startpage(); print startmenu('acquisitions'); print << "EOF"; <font size="6"><em>Website Search Results</em></font><br /> <CENTER> You searched on <b>keywords $keywords,</b> $count results found <br /> Results $offset to $total displayed <div align="right"> <h2><a href="addbiblio.pl">Add New Biblio</a></h2> </div> <p /> <table border="0" cellspacing="0" cellpadding="5"> <tr valign=top bgcolor=#cccc99> <td background="/images/background-mem.gif"><b>TITLE</b></td> <td background="/images/background-mem.gif"><b>AUTHOR</b></td> <td background="/images/background-mem.gif"><b>©</b></td> </tr> EOF for (my $i = $offset; $i < $total; $i++) { if ($i % 2) { print << "EOF"; <tr valign="top" bgcolor="#ffffcc"> EOF } else { print << "EOF"; <tr valign="top" bgcolor="#ffffff"> EOF } # else print << "EOF"; <td><a href="addbiblioitem.pl?biblionumber=$results[$i]->{'biblionumber'}">$results[$i]->{'title'}</a></td> <td><a href="addbiblioitem.pl?biblionumber=$results[$i]->{'biblionumber'}">$results[$i]->{'author'}</a></td> <td>$results[$i]->{'copyrightdate'}</td> </tr> EOF } # for print << "EOF"; <tr valign=top bgcolor=#cccc99> <td background="/images/background-mem.gif"> </td> <td background="/images/background-mem.gif"> </td> <td background="/images/background-mem.gif"> </td> </tr> </table> <br /> EOF for (my $i = 0; ($i * $num) < $count; $i++) { my $newoffset = $i * $num; print << "EOF"; <a href="keywordsearch.pl?keyword=$keywords&offset=$newoffset&num=$num">$i</a> EOF } # for print << "EOF"; <p /> Results per page: <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=5">5</a> <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=10">10</a> <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=20">20</a> <a href="keywordsearch.pl?keyword=$keywords&offset=$offset&num=50">50</a> </CENTER> <br clear="all" /> <p> </p> EOF print endmenu(); print endpage(); } # else

1 0