moredetail.pl presents circulation information taken from the
authorfinlayt <finlayt>
Thu, 2 May 2002 00:08:53 +0000 (00:08 +0000)
committerfinlayt <finlayt>
Thu, 2 May 2002 00:08:53 +0000 (00:08 +0000)
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
C4/Search.pm
admin/branches.pl
bookcount.pl [new file with mode: 0755]
moredetail.pl
updater/updatedatabase

index 5b23990..13fc206 100755 (executable)
@@ -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 &currentissues &getiteminformation &findborrower &issuebook &returnbook
-&find_reserves &transferbook);
+@EXPORT = qw(&getbranches &getprinters &getpatroninformation &currentissues &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 = "<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 $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, "<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);
+    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);
 }
 
index a99ff36..9cb1c4a 100755 (executable)
@@ -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'";
index d8bee7e..b0b01cf 100755 (executable)
 #!/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 <<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;
+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";
        }
-       return true;
+       $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'}'>&nbsp;</td></tr>
+$catcheckbox
+<tr><td>Address</td><td><input type=text name=branchaddress1 value='$data->{'branchaddress1'}'></td></tr>
+<tr><td>&nbsp;</td><td><input type=text name=branchaddress2 value='$data->{'branchaddress2'}'></td></tr>
+<tr><td>&nbsp;</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>&nbsp;</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>&nbsp;</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>";
        }
-       /////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-       function isDate(f) {
-               var t = Date.parse(f.value);
-               if (isNaN(t)) {
-                       return false;
-               }
+       $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);
        }
-       /////////////////////////////////////////////////////////////////////////////////////////////////////////////////
-       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);
        }
-       </SCRIPT>
-printend
-;#/
-       if ($searchfield) {
-               print "<h1>Modify branch</h1>";
-       } else {
-               print "<h1>Add branch</h1>";
+    }
+    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 "<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>";
+    }
+    foreach my $ccat (@checkedcats){
+       unless (grep {/^$ccat$/} @$branchcats) {
+           push(@addcats, $ccat);
        }
-       print "<tr><td>Name</td><td><input type=text name=branchname size=40 maxlength=80 value='$data->{'branchname'}'>&nbsp;</td></tr>";
-       print "<tr><td>Adress</td><td><input type=text name=branchaddress1 value='$data->{'branchaddress1'}'></td></tr>";
-       print "<tr><td>&nbsp;</td><td><input type=text name=branchaddress2 value='$data->{'branchaddress2'}'></td></tr>";
-       print "<tr><td>&nbsp;</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>&nbsp;</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);
+    }  
+    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 "<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>&nbsp; name</td><td>$data->{'branchname'}</td></tr>";
-       print "<tr><td>&nbsp; adress</td><td>$data->{'branchaddress1'}</td></tr>";
-       print "<tr><td>&nbsp;</td><td>$data->{'branchaddress2'}</td></tr>";
-       print "<tr><td>&nbsp;</td><td>$data->{'branchaddress3'}</td></tr>";
-       print "<tr><td>&nbsp;phone</td><td>$data->{'branchphone'}</td></tr>";
-       print "<tr><td>&nbsp; fax</td><td>$data->{'branchfax'}</td></tr>";
-       print "<tr><td>&nbsp; e-mail</td><td>$data->{'branchemail'}</td></tr>";
-       print "<tr><td>&nbsp; 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);
+    }
+    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 "<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'),
-       '&nbsp;','&nbsp;','/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,'&lt;&lt; Prev');
-       }
-       print "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;";
-       if ($offset+$pagesize<$count) {
-               my $nextpage =$offset+$pagesize;
-               print mklink("$script_name?offset=".$nextpage,'Next &gt;&gt;');
-       }
-       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();
+    }
+    $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 (executable)
index 0000000..1057492
--- /dev/null
@@ -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";
+<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 789508b..06f221a 100755 (executable)
@@ -171,7 +171,7 @@ if ($items[$i]->{'wthdrawn'} eq '1'){
 }
 print <<printend
 <b>Cancelled: $items[$i]->{'wthdrawn'}<br>
-<b>Total Issues:</b> $items[$i]->{'issues'}<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>
 
index b0a493a..ebef170 100755 (executable)
@@ -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;