[Koha-cvs] koha admin/branches.pl C4/Auth.pm C4/Koha.pm C4... [rel_3_0]
Antoine Farnault
antoine at koha-fr.org
Tue Nov 28 15:07:38 CET 2006
CVSROOT: /sources/koha
Module name: koha
Branch: rel_3_0
Changes by: Antoine Farnault <toins> 06/11/28 14:07:38
Modified files:
admin : branches.pl
C4 : Auth.pm Koha.pm Output.pm
C4/Circulation : Fines.pm
circ : branchtransfers.pl circulation.pl returns.pl
selectbranchprinter.pl
members : pay.pl
Log message:
- now 2 cookies are used : sessionid & userenv.
- code cleaning :
* renaming getbranch getprinter getprinters to GetBranch GetPrinter GetPrinters.
* some POD added where it was missed.
* reindent with perltidy.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/admin/branches.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.34.2.1&r2=1.34.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Auth.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.54.2.13&r2=1.54.2.14
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Koha.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.40.2.23&r2=1.40.2.24
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Output.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.56.2.3&r2=1.56.2.4
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Fines.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.14.2.6&r2=1.14.2.7
http://cvs.savannah.gnu.org/viewcvs/koha/circ/branchtransfers.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.24.2.4&r2=1.24.2.5
http://cvs.savannah.gnu.org/viewcvs/koha/circ/circulation.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.97.2.10&r2=1.97.2.11
http://cvs.savannah.gnu.org/viewcvs/koha/circ/returns.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.43.2.7&r2=1.43.2.8
http://cvs.savannah.gnu.org/viewcvs/koha/circ/selectbranchprinter.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.16.2.1&r2=1.16.2.2
http://cvs.savannah.gnu.org/viewcvs/koha/members/pay.pl?cvsroot=koha&only_with_tag=rel_3_0&r1=1.4.2.4&r2=1.4.2.5
Patches:
Index: admin/branches.pl
===================================================================
RCS file: /sources/koha/koha/admin/branches.pl,v
retrieving revision 1.34.2.1
retrieving revision 1.34.2.2
diff -u -b -r1.34.2.1 -r1.34.2.2
--- admin/branches.pl 15 Nov 2006 15:56:17 -0000 1.34.2.1
+++ admin/branches.pl 28 Nov 2006 14:07:37 -0000 1.34.2.2
@@ -1,31 +1,4 @@
#!/usr/bin/perl
-# NOTE: Use standard 8-space tabs for this file (indents are 4 spaces)
-
-#require '/u/acli/lib/cvs.pl';#DEBUG
-#open(DEBUG,'>/tmp/koha.debug');
-
-# FIXME: individual fields in branch address need to be exported to templates,
-# in order to fix bug 180; need to notify translators
-# FIXME: looped html (e.g., list of checkboxes) need to be properly
-# TMPL_LOOP'ized; doing this properly will fix bug 130; need to
-# notify translators
-# FIXME: need to implement the branch categories stuff
-# FIXME: there are too many TMPL_IF's; the proper way to do it is to have
-# separate templates for each individual action; need to notify
-# translators
-# FIXME: there are lots of error messages exported to the template; a lot
-# of these should be converted into exported booleans / counters etc
-# so that the error messages can be localized; need to notify translators
-#
-# NOTE: heading() should now be called like this:
-# 1. Use heading() as before
-# 2. $template->param('heading-LISPISHIZED-HEADING-p' => 1);
-# 3. $template->param('use-heading-flags-p' => 1);
-# This ensures that both converted and unconverted templates work
-
-# Finlay working on this file from 26-03-2002
-# Reorganising this branches admin page.....
-
# Copyright 2000-2002 Katipo Communications
#
@@ -44,6 +17,32 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+=head1 branches.pl
+
+ FIXME: individual fields in branch address need to be exported to templates,
+ in order to fix bug 180; need to notify translators
+FIXME: looped html (e.g., list of checkboxes) need to be properly
+ TMPL_LOOP'ized; doing this properly will fix bug 130; need to
+ notify translators
+ FIXME: need to implement the branch categories stuff
+ FIXME: there are too many TMPL_IF's; the proper way to do it is to have
+ separate templates for each individual action; need to notify
+ translators
+ FIXME: there are lots of error messages exported to the template; a lot
+ of these should be converted into exported booleans / counters etc
+ so that the error messages can be localized; need to notify translators
+
+ NOTE: heading() should now be called like this:
+ 1. Use heading() as before
+ 2. $template->param('heading-LISPISHIZED-HEADING-p' => 1);
+ 3. $template->param('use-heading-flags-p' => 1);
+ This ensures that both converted and unconverted templates work
+
+ Finlay working on this file from 26-03-2002
+ Reorganising this branches admin page.....
+
+=cut
+
use strict;
use CGI;
use C4::Auth;
@@ -54,141 +53,166 @@
use C4::Koha;
# 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;
-
+my $script_name = "/cgi-bin/koha/admin/branches.pl";
+my $pagesize = 20;
-#######################################################################################
+################################################################################
# Main loop....
my $input = new CGI;
-my $branchcode=$input->param('branchcode');
-my $branchname=$input->param('branchname');
+my $branchcode = $input->param('branchcode');
+my $branchname = $input->param('branchname');
my $categorycode = $input->param('categorycode');
my $op = $input->param('op');
-my ($template, $borrowernumber, $cookie)
- = get_template_and_user({template_name => "admin/branches.tmpl",
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "admin/branches.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {parameters => 1, management => 1},
+ flagsrequired => { parameters => 1, management => 1 },
debug => 1,
- });
+ }
+);
if ($op) {
- $template->param(script_name => $script_name,
- $op => 1); # we show only the TMPL_VAR names $op
-} else {
- $template->param(script_name => $script_name,
- else => 1); # we show only the TMPL_VAR names $op
+ $template->param(
+ script_name => $script_name,
+ $op => 1
+ ); # we show only the TMPL_VAR names $op
+}
+else {
+ $template->param(
+ script_name => $script_name,
+ else => 1
+ ); # we show only the TMPL_VAR names $op
}
-$template->param(action => $script_name);
-if ($op eq 'add') {
+$template->param( action => $script_name );
+if ( $op eq 'add' ) {
+
# If the user has pressed the "add new branch" button.
heading("Branches: Add Branch");
- $template->param('heading-branches-add-branch-p' => 1);
+ $template->param( 'heading-branches-add-branch-p' => 1 );
editbranchform();
-} elsif ($op eq 'edit') {
+}
+elsif ( $op eq 'edit' ) {
+
# if the user has pressed the "edit branch settings" button.
heading("Branches: Edit Branch");
- $template->param('heading-branches-edit-branch-p' => 1);
- $template->param(add => 1);
+ $template->param( 'heading-branches-edit-branch-p' => 1 );
+ $template->param( add => 1 );
editbranchform($branchcode);
-} elsif ($op eq 'add_validate') {
+}
+elsif ( $op eq 'add_validate' ) {
+
# confirm settings change...
my $params = $input->Vars;
- unless ($params->{'branchcode'} && $params->{'branchname'}) {
- $template->param(else => 1);
- default ("MESSAGE1");
- } else {
+ unless ( $params->{'branchcode'} && $params->{'branchname'} ) {
+ $template->param( else => 1 );
+ default("MESSAGE1");
+ }
+ else {
setbranchinfo($params);
- $template->param(else => 1);
- default ("MESSAGE2");
+ $template->param( else => 1 );
+ default("MESSAGE2");
}
-} elsif ($op eq 'delete') {
+}
+elsif ( $op eq 'delete' ) {
+
# if the user has pressed the "delete branch" button.
my $message = checkdatabasefor($branchcode);
if ($message) {
- $template->param(else => 1);
+ $template->param( else => 1 );
default($message);
- } else {
- $template->param(branchname => $branchname);
- $template->param(delete_confirm => 1);
- $template->param(branchcode => $branchcode);
}
-} elsif ($op eq 'delete_confirmed') {
+ else {
+ $template->param( branchname => $branchname );
+ $template->param( delete_confirm => 1 );
+ $template->param( branchcode => $branchcode );
+ }
+}
+elsif ( $op eq 'delete_confirmed' ) {
+
# actually delete branch and return to the main screen....
deletebranch($branchcode);
- $template->param(else => 1);
+ $template->param( else => 1 );
default("MESSAGE3");
-} elsif ($op eq 'editcategory') {
+}
+elsif ( $op eq 'editcategory' ) {
+
# If the user has pressed the "add new category" or "modify" buttons.
- $template->param('heading-branches-edit-category-p' => 1);
+ $template->param( 'heading-branches-edit-category-p' => 1 );
editcatform($categorycode);
-} elsif ($op eq 'addcategory_validate') {
+}
+elsif ( $op eq 'addcategory_validate' ) {
+
# confirm settings change...
my $params = $input->Vars;
- unless ($params->{'categorycode'} && $params->{'categoryname'}) {
- $template->param(else => 1);
- default ("MESSAGE4");
- } else {
+ unless ( $params->{'categorycode'} && $params->{'categoryname'} ) {
+ $template->param( else => 1 );
+ default("MESSAGE4");
+ }
+ else {
setcategoryinfo($params);
- $template->param(else => 1);
- default ("MESSAGE5");
+ $template->param( else => 1 );
+ default("MESSAGE5");
}
-} elsif ($op eq 'delete_category') {
+}
+elsif ( $op eq 'delete_category' ) {
+
# if the user has pressed the "delete branch" button.
my $message = checkcategorycode($categorycode);
if ($message) {
- $template->param(else => 1);
+ $template->param( else => 1 );
default($message);
- } else {
- $template->param(delete_category => 1);
- $template->param(categorycode => $categorycode);
}
-} elsif ($op eq 'categorydelete_confirmed') {
+ else {
+ $template->param( delete_category => 1 );
+ $template->param( categorycode => $categorycode );
+ }
+}
+elsif ( $op eq 'categorydelete_confirmed' ) {
+
# actually delete branch and return to the main screen....
deletecategory($categorycode);
- $template->param(else => 1);
+ $template->param( else => 1 );
default("MESSAGE6");
-} else {
+}
+else {
+
# if no operation has been set...
default();
}
-
-
-######################################################################################################
+################################################################################
#
# html output functions....
sub default {
my ($message) = @_;
heading("Branches");
- $template->param('heading-branches-p' => 1);
- $template->param("$message" => 1);
- $template->param(action => $script_name);
+ $template->param( 'heading-branches-p' => 1 );
+ $template->param( "$message" => 1 );
+ $template->param( action => $script_name );
branchinfotable();
}
# FIXME: this function should not exist; otherwise headings are untranslatable
sub heading {
my ($head) = @_;
- $template->param(head => $head);
+ $template->param( head => $head );
}
sub editbranchform {
+
# prepares the edit form...
-# initiate the scrolling-list to select the printers
+ # initiate the scrolling-list to select the printers
my %env;
- my $printers=getprinters(\%env);
+ my $printers = GetPrinters( \%env );
my @printerloop;
- my $printercount=0;
+ my $printercount = 0;
my $oldprinter;
my $CGIprinter;
my ($branchcode) = @_;
@@ -197,37 +221,42 @@
if ($branchcode) {
$data = getbranchinfo($branchcode);
$data = $data->[0];
+
# get the old printer of the branch
$oldprinter = $data->{'branchprinter'};
-# printer loop
- foreach my $thisprinter (keys %$printers) {
- my $selected = 1 if $oldprinter eq $printers->{$thisprinter}->{'printqueue'};
- my %row =(value => $thisprinter,
+
+ # printer loop
+ foreach my $thisprinter ( keys %$printers ) {
+ my $selected = 1
+ if $oldprinter eq $printers->{$thisprinter}->{'printqueue'};
+ my %row = (
+ value => $thisprinter,
selected => $selected,
branchprinter => $printers->{$thisprinter}->{'printqueue'},
);
push @printerloop, \%row;
}
- $template->param(printerloop => \@printerloop );
- $template->param(branchcode => $data->{'branchcode'});
- $template->param(branch_name => $data->{'branchname'});
- $template->param(branchaddress1 => $data->{'branchaddress1'});
- $template->param(branchaddress2 => $data->{'branchaddress2'});
- $template->param(branchaddress3 => $data->{'branchaddress3'});
- $template->param(branchphone => $data->{'branchphone'});
- $template->param(branchfax => $data->{'branchfax'});
- $template->param(branchemail => $data->{'branchemail'});
- $template->param(branchip => $data->{'branchip'});
+ $template->param( printerloop => \@printerloop );
+ $template->param( branchcode => $data->{'branchcode'} );
+ $template->param( branch_name => $data->{'branchname'} );
+ $template->param( branchaddress1 => $data->{'branchaddress1'} );
+ $template->param( branchaddress2 => $data->{'branchaddress2'} );
+ $template->param( branchaddress3 => $data->{'branchaddress3'} );
+ $template->param( branchphone => $data->{'branchphone'} );
+ $template->param( branchfax => $data->{'branchfax'} );
+ $template->param( branchemail => $data->{'branchemail'} );
+ $template->param( branchip => $data->{'branchip'} );
}
else { #case of an add branch select printer
- foreach my $thisprinter (keys %$printers) {
- my %row =(value => $thisprinter,
+ foreach my $thisprinter ( keys %$printers ) {
+ my %row = (
+ value => $thisprinter,
branchprinter => $printers->{$thisprinter}->{'printqueue'},
);
push @printerloop, \%row;
}
- $template->param(printerloop => \@printerloop );
+ $template->param( printerloop => \@printerloop );
}
# make the checkboxs.....
@@ -239,31 +268,36 @@
#
my $catinfo = getcategoryinfo();
my $catcheckbox;
-# print DEBUG "catinfo=".cvs($catinfo)."\n";
+
+ # print DEBUG "catinfo=".cvs($catinfo)."\n";
my @categoryloop = ();
foreach my $cat (@$catinfo) {
my $checked = "";
- my $tmp = quotemeta($cat->{'categorycode'});
- if (grep {/^$tmp$/} @{$data->{'categories'}}) {
+ my $tmp = quotemeta( $cat->{'categorycode'} );
+ if ( grep { /^$tmp$/ } @{ $data->{'categories'} } ) {
$checked = "checked=\"checked\"";
}
- push @categoryloop, {
+ push @categoryloop,
+ {
categoryname => $cat->{'categoryname'},
categorycode => $cat->{'categorycode'},
codedescription => $cat->{'codedescription'},
checked => $checked,
};
}
- $template->param(categoryloop => \@categoryloop);
+ $template->param( categoryloop => \@categoryloop );
# {{{ Leave this here until bug 130 is completely resolved in the templates
- for my $obsolete ('categoryname', 'categorycode', 'codedescription') {
- $template->param($obsolete => 'Your template is out of date (bug 130)');
+ for my $obsolete ( 'categoryname', 'categorycode', 'codedescription' ) {
+ $template->param(
+ $obsolete => 'Your template is out of date (bug 130)' );
}
+
# }}}
}
sub editcatform {
+
# prepares the edit form...
my ($categorycode) = @_;
warn "cat : $categorycode";
@@ -271,33 +305,36 @@
if ($categorycode) {
$data = getcategoryinfo($categorycode);
$data = $data->[0];
- $template->param(categorycode => $data->{'categorycode'});
- $template->param(categoryname => $data->{'categoryname'});
- $template->param(codedescription => $data->{'codedescription'});
+ $template->param( categorycode => $data->{'categorycode'} );
+ $template->param( categoryname => $data->{'categoryname'} );
+ $template->param( codedescription => $data->{'codedescription'} );
}
}
sub deleteconfirm {
-# message to print if the
+
+ # message to print if the
my ($branchcode) = @_;
}
-
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 {
+ }
+ else {
$branchinfo = getbranchinfo();
}
my $toggle;
my $i;
- my @loop_data =();
+ my @loop_data = ();
foreach my $branch (@$branchinfo) {
- ($i % 2) ? ($toggle = 1) : ($toggle = 0);
+ ( $i % 2 ) ? ( $toggle = 1 ) : ( $toggle = 0 );
+
#
# We export the following fields to the template. These are not
# pre-composed as a single "address" field because the template
@@ -324,28 +361,37 @@
# Handle address fields separately
my $address_empty_p = 1;
- for my $field ('branchaddress1', 'branchaddress2', 'branchaddress3',
- 'branchphone', 'branchfax', 'branchemail', 'branchip', 'branchprinter') {
+ for my $field (
+ 'branchaddress1', 'branchaddress2',
+ 'branchaddress3', 'branchphone',
+ 'branchfax', 'branchemail',
+ 'branchip', 'branchprinter'
+ )
+ {
$row{$field} = $branch->{$field};
if ( $branch->{$field} ) {
$address_empty_p = 0;
}
}
$row{'address-empty-p'} = $address_empty_p;
+
# {{{ Leave this here until bug 180 is completely resolved in templates
$row{'address'} = 'Your template is out of date (see bug 180)';
+
# }}}
# Handle categories
my $no_categories_p = 1;
my @categories = '';
- foreach my $cat (@{$branch->{'categories'}}) {
- my ($catinfo) = @{getcategoryinfo($cat)};
- push @categories, {'categoryname' => $catinfo->{'categoryname'}};
+ foreach my $cat ( @{ $branch->{'categories'} } ) {
+ my ($catinfo) = @{ getcategoryinfo($cat) };
+ push @categories, { 'categoryname' => $catinfo->{'categoryname'} };
$no_categories_p = 0;
}
+
# {{{ Leave this here until bug 180 is completely resolved in templates
$row{'categories'} = 'Your template is out of date (see bug 180)';
+
# }}}
$row{'category_list'} = \@categories;
$row{'no-categories-p'} = $no_categories_p;
@@ -357,16 +403,16 @@
$row{'value'} = $branch->{'branchcode'};
$row{'action'} = '/cgi-bin/koha/admin/branches.pl';
- push @loop_data, { %row };
+ push @loop_data, {%row};
$i++;
}
- my @branchcategories =();
+ my @branchcategories = ();
my $catinfo = getcategoryinfo();
- my $toggle;
- my $i = 0;
+ $i = 0;
foreach my $cat (@$catinfo) {
- ($i % 2) ? ($toggle = 1) : ($toggle = 0);
- push @branchcategories, {
+ ( $i % 2 ) ? ( $toggle = 1 ) : ( $toggle = 0 );
+ push @branchcategories,
+ {
toggle => $toggle,
categoryname => $cat->{'categoryname'},
categorycode => $cat->{'categorycode'},
@@ -375,54 +421,61 @@
$i++;
}
- $template->param(branches => \@loop_data,
- branchcategories => \@branchcategories);
+ $template->param(
+ branches => \@loop_data,
+ branchcategories => \@branchcategories
+ );
}
# FIXME logic seems wrong
sub branchcategoriestable {
-#Needs to be implemented...
+
+ #Needs to be implemented...
my $categoryinfo = getcategoryinfo();
my $color;
foreach my $cat (@$categoryinfo) {
- ($color eq $linecolor1) ? ($color=$linecolor2) : ($color=$linecolor1);
- $template->param(color => $color);
- $template->param(categoryname => $cat->{'categoryname'});
- $template->param(categorycode => $cat->{'categorycode'});
- $template->param(codedescription => $cat->{'codedescription'});
+ $template->param( categoryname => $cat->{'categoryname'} );
+ $template->param( categorycode => $cat->{'categorycode'} );
+ $template->param( codedescription => $cat->{'codedescription'} );
}
}
-######################################################################################################
+################################################################################
#
# Database functions....
sub getbranchinfo {
-# returns a reference to an array of hashes containing branches,
+
+ # returns a reference to an array of hashes containing branches,
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
my $sth;
if ($branchcode) {
- $sth = $dbh->prepare("Select * from branches where branchcode = ? order by branchcode");
+ $sth =
+ $dbh->prepare(
+ "Select * from branches where branchcode = ? order by branchcode");
$sth->execute($branchcode);
- } else {
+ }
+ else {
$sth = $dbh->prepare("Select * from branches order by branchcode");
$sth->execute();
}
my @results;
- while (my $data = $sth->fetchrow_hashref) {
- my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
- $nsth->execute($data->{'branchcode'});;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ my $nsth =
+ $dbh->prepare(
+ "select categorycode from branchrelations where branchcode = ?");
+ $nsth->execute( $data->{'branchcode'} );
my @cats = ();
- while (my ($cat) = $nsth->fetchrow_array) {
- push(@cats, $cat);
+ while ( my ($cat) = $nsth->fetchrow_array ) {
+ push( @cats, $cat );
}
$nsth->finish;
$data->{'categories'} = \@cats;
- push(@results, $data);
+ push( @results, $data );
}
$sth->finish;
return \@results;
@@ -430,113 +483,151 @@
# FIXME This doesn't belong here; it should be moved into a module
sub getcategoryinfo {
-# returns a reference to an array of hashes containing branches,
+
+ # returns a reference to an array of hashes containing branches,
my ($catcode) = @_;
my $dbh = C4::Context->dbh;
my $sth;
+
# print DEBUG "getcategoryinfo: entry: catcode=".cvs($catcode)."\n";
if ($catcode) {
- $sth = $dbh->prepare("select * from branchcategories where categorycode = ?");
+ $sth =
+ $dbh->prepare(
+ "select * from branchcategories where categorycode = ?");
$sth->execute($catcode);
- } else {
+ }
+ else {
$sth = $dbh->prepare("Select * from branchcategories");
$sth->execute();
}
my @results;
- while (my $data = $sth->fetchrow_hashref) {
- push(@results, $data);
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @results, $data );
}
$sth->finish;
+
# print DEBUG "getcategoryinfo: exit: returning ".cvs(\@results)."\n";
return \@results;
}
# FIXME This doesn't belong here; it should be moved into a module
sub setbranchinfo {
-# sets the data from the editbranch form, and writes to the database...
+
+ # sets the data from the editbranch form, and writes to the database...
my ($data) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("replace branches (branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,branchip,branchprinter) values (?,?,?,?,?,?,?,?,?,?)");
- $sth->execute(uc($data->{'branchcode'}), $data->{'branchname'},
+ my $sth =
+ $dbh->prepare(
+"replace branches (branchcode,branchname,branchaddress1,branchaddress2,branchaddress3,branchphone,branchfax,branchemail,branchip,branchprinter) values (?,?,?,?,?,?,?,?,?,?)"
+ );
+ $sth->execute(
+ uc( $data->{'branchcode'} ), $data->{'branchname'},
$data->{'branchaddress1'}, $data->{'branchaddress2'},
$data->{'branchaddress3'}, $data->{'branchphone'},
- $data->{'branchfax'}, $data->{'branchemail'}, $data->{'branchip'},$data->{'branchprinter'});
+ $data->{'branchfax'}, $data->{'branchemail'},
+ $data->{'branchip'}, $data->{'branchprinter'}
+ );
$sth->finish;
+
# sort out the categories....
my @checkedcats;
my $cats = getcategoryinfo();
foreach my $cat (@$cats) {
my $code = $cat->{'categorycode'};
- if ($data->{$code}) {
- push(@checkedcats, $code);
+ if ( $data->{$code} ) {
+ push( @checkedcats, $code );
}
}
- my $branchcode =uc($data->{'branchcode'});
+ my $branchcode = uc( $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);
+
+ unless ( grep { /^$bcat$/ } @checkedcats ) {
+ push( @removecats, $bcat );
}
}
- foreach my $ccat (@checkedcats){
- unless (grep {/^$ccat$/} @$branchcats) {
- push(@addcats, $ccat);
+ foreach my $ccat (@checkedcats) {
+ unless ( grep { /^$ccat$/ } @$branchcats ) {
+ push( @addcats, $ccat );
}
}
foreach my $cat (@addcats) {
- my $sth = $dbh->prepare("insert into branchrelations (branchcode, categorycode) values(?, ?)");
- $sth->execute($branchcode, $cat);
+ my $sth =
+ $dbh->prepare(
+"insert into branchrelations (branchcode, categorycode) values(?, ?)"
+ );
+ $sth->execute( $branchcode, $cat );
$sth->finish;
}
foreach my $cat (@removecats) {
- my $sth = $dbh->prepare("delete from branchrelations where branchcode=? and categorycode=?");
- $sth->execute($branchcode, $cat);
+ my $sth =
+ $dbh->prepare(
+ "delete from branchrelations where branchcode=? and categorycode=?"
+ );
+ $sth->execute( $branchcode, $cat );
$sth->finish;
}
}
sub deletebranch {
-# delete branch...
+
+ # delete branch...
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("delete from branches where branchcode = ?");
+ my $sth = $dbh->prepare("delete from branches where branchcode = ?");
$sth->execute($branchcode);
$sth->finish;
}
sub setcategoryinfo {
-# sets the data from the editbranch form, and writes to the database...
+
+ # sets the data from the editbranch form, and writes to the database...
my ($data) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("replace branchcategories (categorycode,categoryname,codedescription) values (?,?,?)");
- $sth->execute(uc($data->{'categorycode'}), $data->{'categoryname'},$data->{'codedescription'});
+ my $sth =
+ $dbh->prepare(
+"replace branchcategories (categorycode,categoryname,codedescription) values (?,?,?)"
+ );
+ $sth->execute(
+ uc( $data->{'categorycode'} ),
+ $data->{'categoryname'},
+ $data->{'codedescription'}
+ );
$sth->finish;
}
+
sub deletecategory {
-# delete branch...
+
+ # delete branch...
my ($categorycode) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("delete from branchcategories where categorycode = ?");
+ my $sth =
+ $dbh->prepare("delete from branchcategories where categorycode = ?");
$sth->execute($categorycode);
$sth->finish;
}
sub checkdatabasefor {
-# check to see if the branchcode is being used in the database somewhere....
+
+ # check to see if the branchcode is being used in the database somewhere....
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select count(*) from items where holdingbranch=? or homebranch=?");
- $sth->execute($branchcode, $branchcode);
+ my $sth =
+ $dbh->prepare(
+ "select count(*) from items where holdingbranch=? or homebranch=?");
+ $sth->execute( $branchcode, $branchcode );
my ($total) = $sth->fetchrow_array;
$sth->finish;
my $message;
+
if ($total) {
+
# FIXME: need to be replaced by an exported boolean parameter
$message = "MESSAGE7";
}
@@ -544,24 +635,31 @@
}
sub checkcategorycode {
-# check to see if the branchcode is being used in the database somewhere....
+
+ # check to see if the branchcode is being used in the database somewhere....
my ($categorycode) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select count(*) from branchrelations where categorycode=?");
+ my $sth =
+ $dbh->prepare(
+ "select count(*) from branchrelations where categorycode=?");
$sth->execute($categorycode);
my ($total) = $sth->fetchrow_array;
$sth->finish;
my $message;
+
if ($total) {
+
# FIXME: need to be replaced by an exported boolean parameter
$message = "MESSAGE8";
}
return $message;
}
-$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+$template->param(
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
IntranetNav => C4::Context->preference("IntranetNav"),
- );
+);
output_html_with_http_headers $input, $cookie, $template->output;
# Local Variables:
Index: C4/Auth.pm
===================================================================
RCS file: /sources/koha/koha/C4/Auth.pm,v
retrieving revision 1.54.2.13
retrieving revision 1.54.2.14
diff -u -b -r1.54.2.13 -r1.54.2.14
--- C4/Auth.pm 24 Nov 2006 11:07:08 -0000 1.54.2.13
+++ C4/Auth.pm 28 Nov 2006 14:07:38 -0000 1.54.2.14
@@ -36,7 +36,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.54.2.13 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.54.2.14 $' =~ /\d+/g;
shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
};
@@ -543,7 +543,6 @@
$branchname = $branches->{$br}->{'branchname'};
}
}
-
my $hash = C4::Context::set_userenv(
$borrowernumber, $userid, $cardnumber,
$firstname, $surname, $branchcode,
Index: C4/Koha.pm
===================================================================
RCS file: /sources/koha/koha/C4/Koha.pm,v
retrieving revision 1.40.2.23
retrieving revision 1.40.2.24
diff -u -b -r1.40.2.23 -r1.40.2.24
--- C4/Koha.pm 21 Nov 2006 10:19:09 -0000 1.40.2.23
+++ C4/Koha.pm 28 Nov 2006 14:07:38 -0000 1.40.2.24
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Koha.pm,v 1.40.2.23 2006/11/21 10:19:09 toins Exp $
+# $Id: Koha.pm,v 1.40.2.24 2006/11/28 14:07:38 toins Exp $
use strict;
require Exporter;
@@ -25,7 +25,7 @@
use C4::Output;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = do { my @v = '$Revision: 1.40.2.23 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.40.2.24 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -50,8 +50,8 @@
@EXPORT = qw(&slashifyDate
&borrowercategories
&subfield_is_koha_internal_p
- &GetBranches &getbranch &getbranchdetail
- &getprinters &getprinter
+ &GetBranches &GetBranch &getbranchdetail
+ &GetPrinters &GetPrinter
&GetItemTypes &getitemtypeinfo
&GetCcodes
&GetAuthItemlost
@@ -509,9 +509,9 @@
. '/itemtypeimg';
}
-=head2 getprinters
+=head2 GetPrinters
- $printers = &getprinters($env);
+ $printers = &GetPrinters($env);
@queues = keys %$printers;
Returns information about existing printer queues.
@@ -524,7 +524,7 @@
=cut
-sub getprinters {
+sub GetPrinters {
my ($env) = @_;
my %printers;
my $dbh = C4::Context->dbh;
@@ -536,11 +536,19 @@
return ( \%printers );
}
-sub getbranch ($$) {
+=head2 GetBranch
+
+$branch = GetBranch( $query, $branches );
+
+=cut
+
+sub GetBranch ($$) {
my ( $query, $branches ) = @_; # get branch for this query from branches
my $branch = $query->param('branch');
- ($branch) || ( $branch = $query->cookie('branch') );
+ my %cookie = $query->cookie('userenv');
+ ($branch) || ($branch = $cookie{'branchname'});
( $branches->{$branch} ) || ( $branch = ( keys %$branches )[0] );
+ warn "branch=".$branch;
return $branch;
}
@@ -563,10 +571,17 @@
return $branchname;
}
-sub getprinter ($$) {
+=head2 GetPrinter
+
+$printer = GetPrinter( $query, $printers );
+
+=cut
+
+sub GetPrinter ($$) {
my ( $query, $printers ) = @_; # get printer for this query from printers
my $printer = $query->param('printer');
- ($printer) || ( $printer = $query->cookie('printer') ) || ( $printer = '' );
+ my %cookie = $query->cookie('userenv');
+ ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
return $printer;
}
Index: C4/Output.pm
===================================================================
RCS file: /sources/koha/koha/C4/Output.pm,v
retrieving revision 1.56.2.3
retrieving revision 1.56.2.4
diff -u -b -r1.56.2.3 -r1.56.2.4
--- C4/Output.pm 20 Nov 2006 10:26:10 -0000 1.56.2.3
+++ C4/Output.pm 28 Nov 2006 14:07:38 -0000 1.56.2.4
@@ -1,7 +1,5 @@
package C4::Output;
-# $Id: Output.pm,v 1.56.2.3 2006/11/20 10:26:10 toins Exp $
-
#package to deal with marking up output
#You will need to edit parts of this pm
#set the value of path to be where your html lives
@@ -23,6 +21,8 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id: Output.pm,v 1.56.2.4 2006/11/28 14:07:38 toins Exp $
+
# NOTE: I'm pretty sure this module is deprecated in favor of
# templates.
@@ -36,7 +36,7 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision: 1.56.2.4 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
Index: C4/Circulation/Fines.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Fines.pm,v
retrieving revision 1.14.2.6
retrieving revision 1.14.2.7
diff -u -b -r1.14.2.6 -r1.14.2.7
--- C4/Circulation/Fines.pm 17 Nov 2006 14:57:21 -0000 1.14.2.6
+++ C4/Circulation/Fines.pm 28 Nov 2006 14:07:38 -0000 1.14.2.7
@@ -1,6 +1,6 @@
package C4::Circulation::Fines;
-# $Id: Fines.pm,v 1.14.2.6 2006/11/17 14:57:21 tipaul Exp $
+# $Id: Fines.pm,v 1.14.2.7 2006/11/28 14:07:38 toins Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -29,7 +29,7 @@
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.14.2.6 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.14.2.7 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -298,7 +298,7 @@
|;
my $sth = $dbh->prepare($query);
# print $query;
-my @result;
+
$sth->execute($iteminfo->{'branchcode'});
while ( my $weekday=$sth->fetchrow_hashref){
push (@result,$weekday);
Index: circ/branchtransfers.pl
===================================================================
RCS file: /sources/koha/koha/circ/branchtransfers.pl,v
retrieving revision 1.24.2.4
retrieving revision 1.24.2.5
diff -u -b -r1.24.2.4 -r1.24.2.5
--- circ/branchtransfers.pl 20 Nov 2006 11:01:03 -0000 1.24.2.4
+++ circ/branchtransfers.pl 28 Nov 2006 14:07:38 -0000 1.24.2.5
@@ -39,15 +39,15 @@
my $linecolor2 = 1;
my $branches = GetBranches();
-my $printers = getprinters( \%env );
+my $printers = GetPrinters( \%env );
###############################################
# Getting state
my $query = new CGI;
-my $branch = getbranch( $query, $branches );
-my $printer = getprinter( $query, $printers );
+my $branch = GetBranch( $query, $branches );
+my $printer = GetPrinter( $query, $printers );
my $genbrname = $branches->{$branch}->{'branchname'};
my $genprname = $printers->{$printer}->{'printername'};
Index: circ/circulation.pl
===================================================================
RCS file: /sources/koha/koha/circ/circulation.pl,v
retrieving revision 1.97.2.10
retrieving revision 1.97.2.11
diff -u -b -r1.97.2.10 -r1.97.2.11
--- circ/circulation.pl 27 Nov 2006 09:43:12 -0000 1.97.2.10
+++ circ/circulation.pl 28 Nov 2006 14:07:38 -0000 1.97.2.11
@@ -60,8 +60,8 @@
);
my $branches = GetBranches();
-# my $printers = getprinters();
-# my $printer = getprinter($query, $printers);
+my $printers = GetPrinters();
+my $printer = GetPrinter($query, $printers);
my $findborrower = $query->param('findborrower');
$findborrower =~ s|,| |g;
Index: circ/returns.pl
===================================================================
RCS file: /sources/koha/koha/circ/returns.pl,v
retrieving revision 1.43.2.7
retrieving revision 1.43.2.8
diff -u -b -r1.43.2.7 -r1.43.2.8
--- circ/returns.pl 21 Nov 2006 10:45:54 -0000 1.43.2.7
+++ circ/returns.pl 28 Nov 2006 14:07:38 -0000 1.43.2.8
@@ -1,7 +1,5 @@
#!/usr/bin/perl
-#written 11/3/2002 by Finlay
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
@@ -23,6 +21,8 @@
script to execute returns of books
+written 11/3/2002 by Finlay
+
=cut
use strict;
@@ -55,12 +55,9 @@
#####################
#Global vars
my %env;
-my $headerbackgroundcolor = '#99cc33';
-my $linecolor1 = '#ffffcc';
-my $linecolor2 = 'white';
my $branches = GetBranches();
-my $printers = getprinters( \%env );
+my $printers = GetPrinters( \%env );
my $branch = C4::Context->userenv->{'branch'};
my $printer = C4::Context->userenv->{'branchprinter'};
@@ -549,7 +546,3 @@
return $barcode;
}
}
-
-# Local Variables:
-# tab-width: 4
-# End:
Index: circ/selectbranchprinter.pl
===================================================================
RCS file: /sources/koha/koha/circ/selectbranchprinter.pl,v
retrieving revision 1.16.2.1
retrieving revision 1.16.2.2
diff -u -b -r1.16.2.1 -r1.16.2.2
--- circ/selectbranchprinter.pl 20 Nov 2006 11:01:03 -0000 1.16.2.1
+++ circ/selectbranchprinter.pl 28 Nov 2006 14:07:38 -0000 1.16.2.2
@@ -1,5 +1,4 @@
#!/usr/bin/perl
-# WARNING: This file uses 4-character tabs!
# Copyright 2000-2002 Katipo Communications
#
@@ -39,12 +38,13 @@
my %env;
my $query = new CGI;
my $branches = GetBranches();
-my $printers = getprinters( \%env );
+my $printers = GetPrinters( \%env );
my $branch = $query->param('branch');
my $printer = $query->param('printer');
-($branch) || ( $branch = $query->cookie('branch') );
-($printer) || ( $printer = $query->cookie('printer') );
+my %cookie = $query->cookie('userenv');
+($branch) || ( $branch = $cookie{'branch'} );
+($printer) || ( $printer = $cookie{'printer'} );
( $branches->{$branch} ) || ( $branch = ( keys %$branches )[0] );
( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
@@ -53,9 +53,6 @@
my $oldbranch = $branch;
my $oldprinter = $printer;
-#$branch='';
-#$printer='';
-
$env{'branchcode'} = $branch;
$env{'printer'} = $printer;
$env{'queue'} = $printer;
@@ -65,9 +62,8 @@
my $printercount = 0;
my @branchloop;
foreach my $br ( keys %$branches ) {
- next unless $br =~ /\S/;
+ next unless $br =~ /\S/; # next unless $br is not blank.
- #(next) unless ($branches->{$_}->{'IS'}); # FIXME disabled to fix bug 202
$branchcount++;
my %branch;
$branch{selected} = ( $br eq $oldbranch );
@@ -77,7 +73,7 @@
}
my @printerloop;
foreach ( keys %$printers ) {
- (next) unless ($_);
+ (next) unless ($_); # next unless if this printer is blank.
$printercount++;
my %printer;
$printer{selected} = ( $_ eq $oldprinter );
@@ -101,7 +97,7 @@
$branchname = $branches->{$tmpbranch}->{branchname};
}
-#############################################################################################
+################################################################################
# Start writing page....
# set header with cookie....
@@ -127,14 +123,4 @@
IntranetNav => C4::Context->preference("IntranetNav"),
);
-my $branchcookie =
- $query->cookie( -name => 'branch', -value => "$branch", -expires => '+1y' );
-my $printercookie =
- $query->cookie( -name => 'printer', -value => "$printer", -expires => '+1y' );
-
-my $cookies = [ $cookie, $branchcookie, $printercookie ];
-output_html_with_http_headers $query, $cookies, $template->output;
-
-# Local Variables:
-# tab-width: 4
-# End:
+output_html_with_http_headers $query, $cookie, $template->output;
Index: members/pay.pl
===================================================================
RCS file: /sources/koha/koha/members/pay.pl,v
retrieving revision 1.4.2.4
retrieving revision 1.4.2.5
diff -u -b -r1.4.2.4 -r1.4.2.5
--- members/pay.pl 24 Nov 2006 16:10:38 -0000 1.4.2.4
+++ members/pay.pl 28 Nov 2006 14:07:38 -0000 1.4.2.5
@@ -1,11 +1,5 @@
#!/usr/bin/perl
-# $Id: pay.pl,v 1.4.2.4 2006/11/24 16:10:38 btoumi Exp $
-
-# written 11/1/2000 by chris at katipo.oc.nz
-# part of the koha library system, script to facilitate paying off fines
-
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
@@ -23,6 +17,15 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id: pay.pl,v 1.4.2.5 2006/11/28 14:07:38 toins Exp $
+
+=head1 pay.pl
+
+ written 11/1/2000 by chris at katipo.oc.nz
+ part of the koha library system, script to facilitate paying off fines
+
+=cut
+
use strict;
use C4::Context;
use C4::Auth;
@@ -35,87 +38,85 @@
use C4::Circulation::Fines;
use HTML::Template;
-my $input=new CGI;
+my $input = new CGI;
-#print $input->header;
-my $borrowernumber=$input->param('borrowernumber');
-if ($borrowernumber eq ''){
- $borrowernumber=$input->param('borrowernumber0');
+my $borrowernumber = $input->param('borrowernumber');
+if ( $borrowernumber eq '' ) {
+ $borrowernumber = $input->param('borrowernumber0');
}
+
# get borrower details
-my $data=borrdata('',$borrowernumber);
-my $user=$input->remote_user;
+my $data = borrdata( '', $borrowernumber );
+my $user = $input->remote_user;
# get account details
my %bor;
-$bor{'borrowernumber'}=$borrowernumber;
+$bor{'borrowernumber'} = $borrowernumber;
my $branches = GetBranches();
-my $printers = getprinters();
-my $branch = getbranch($input, $branches);
+my $printers = GetPrinters();
+my $branch = GetBranch( $input, $branches );
-my @names=$input->param;
+my @names = $input->param;
my %inp;
-my $check=0;
-for (my $i=0;$i<@names;$i++){
- my $temp=$input->param($names[$i]);
- if ($temp eq 'wo'){
- $inp{$names[$i]}=$temp;
- $check=1;
- }
- if ($temp eq 'yes'){
- # For HLT
- $user=~ s/Levin/L/i;
- $user=~ s/Foxton/F/i;
- $user=~ s/Shannon/S/i;
- # FIXME : using array +4, +5, +6 is dirty. Should use arrays for each accountline
- my $amount=$input->param($names[$i+4]);
- my $borrowernumber=$input->param($names[$i+5]);
- my $accountno=$input->param($names[$i+6]);
- makepayment($borrowernumber,$accountno,$amount,$user,$branch);
- $check=2;
+my $check = 0;
+for ( my $i = 0 ; $i < @names ; $i++ ) {
+ my $temp = $input->param( $names[$i] );
+ if ( $temp eq 'wo' ) {
+ $inp{ $names[$i] } = $temp;
+ $check = 1;
+ }
+ if ( $temp eq 'yes' ) {
+
+# FIXME : using array +4, +5, +6 is dirty. Should use arrays for each accountline
+ my $amount = $input->param( $names[ $i + 4 ] );
+ my $borrowernumber = $input->param( $names[ $i + 5 ] );
+ my $accountno = $input->param( $names[ $i + 6 ] );
+ makepayment( $borrowernumber, $accountno, $amount, $user, $branch );
+ $check = 2;
}
}
my %env;
- $user=~ s/Levin/L/i;
- $user=~ s/Foxton/F/i;
- $user=~ s/Shannon/S/i;
-
-$env{'branchcode'}=$branch;
-my $total=$input->param('total');
-if ($check ==0){
- my($template, $loggedinuser, $cookie)
- = get_template_and_user ({ template_name => "members/pay.tmpl",
+
+$env{'branchcode'} = $branch;
+my $total = $input->param('total');
+if ( $check == 0 ) {
+ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "members/pay.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {borrowers => 1},
+ flagsrequired => { borrowers => 1 },
debug => 1,
- });
-if ($total ne ''){
- recordpayment(\%env,$borrowernumber,$total);
-}
+ }
+ );
+ if ( $total ne '' ) {
+ recordpayment( \%env, $borrowernumber, $total );
+ }
-my ($numaccts,$accts,$total)=getboracctrecord('',\%bor);
+ my ( $numaccts, $accts, $total ) = getboracctrecord( '', \%bor );
# creation d'une fonction qui va nous retourner le notify_id dans un tableau
-my @allfile;
-my @notify=NumberNotifyId($borrowernumber);
+ my @allfile;
+ my @notify = NumberNotifyId($borrowernumber);
-my $numberofnotify=scalar(@notify);
-for (my $j=0;$j<scalar(@notify);$j++){
-my @loop_pay;
-my ($numaccts,$accts,$total)=GetBorNotifyAcctRecord('',\%bor,$notify[$j]);
- for (my $i=0;$i<$numaccts;$i++){
+ my $numberofnotify = scalar(@notify);
+ for ( my $j = 0 ; $j < scalar(@notify) ; $j++ ) {
+ my @loop_pay;
+ my ( $numaccts, $accts, $total ) =
+ GetBorNotifyAcctRecord( '', \%bor, $notify[$j] );
+ for ( my $i = 0 ; $i < $numaccts ; $i++ ) {
my %line;
- if ($accts->[$i]{'amountoutstanding'} > 0){
- $accts->[$i]{'amount'}+=0.00;
- $accts->[$i]{'amountoutstanding'}+=0.00;
- $line{i}=$j."".$i;
+ if ( $accts->[$i]{'amountoutstanding'} > 0 ) {
+ $accts->[$i]{'amount'} += 0.00;
+ $accts->[$i]{'amountoutstanding'} += 0.00;
+ $line{i} = $j . "" . $i;
$line{itemnumber} = $accts->[$i]{'itemnumber'};
$line{accounttype} = $accts->[$i]{'accounttype'};
- $line{amount} = sprintf("%.2f",$accts->[$i]{'amount'});
- $line{amountoutstanding} = sprintf("%.2f",$accts->[$i]{'amountoutstanding'});
+ $line{amount} = sprintf( "%.2f", $accts->[$i]{'amount'} );
+ $line{amountoutstanding} =
+ sprintf( "%.2f", $accts->[$i]{'amountoutstanding'} );
$line{borrowernumber} = $borrowernumber;
$line{accountno} = $accts->[$i]{'accountno'};
$line{description} = $accts->[$i]{'description'};
@@ -124,73 +125,79 @@
$line{notify_level} = $accts->[$i]{'notify_level'};
}
- push(@loop_pay ,\%line);
+ push( @loop_pay, \%line );
}
- my $totalnotify=AmountNotify($notify[$j]);
- ($totalnotify = '0')if ($totalnotify =~/^0.00/ );
- push @allfile,{'loop_pay'=>\@loop_pay,'notify'=>$notify[$j],'total'=>$totalnotify};
-}
+ my $totalnotify = AmountNotify( $notify[$j] );
+ ( $totalnotify = '0' ) if ( $totalnotify =~ /^0.00/ );
+ push @allfile,
+ {
+ 'loop_pay' => \@loop_pay,
+ 'notify' => $notify[$j],
+ 'total' => $totalnotify
+ };
+ }
$template->param(
allfile => \@allfile,
firstname => $data->{'firstname'},
surname => $data->{'surname'},
borrowernumber => $borrowernumber,
- total => sprintf("%.2f",$total));
+ total => sprintf( "%.2f", $total )
+ );
print "Content-Type: text/html\n\n", $template->output;
-} else {
-# my $quety=$input->query_string;
-# print $input->redirect("/cgi-bin/koha/sec/writeoff.pl?$quety");
- my%inp;
- my @name=$input->param;
- for (my $i=0;$i<@name;$i++){
- my $test=$input->param($name[$i]);
- if ($test eq 'wo'){
- my $temp=$name[$i];
- $temp=~ s/payfine//;
- $inp{$name[$i]}=$temp;
+}
+else {
+
+ my %inp;
+ my @name = $input->param;
+ for ( my $i = 0 ; $i < @name ; $i++ ) {
+ my $test = $input->param( $name[$i] );
+ if ( $test eq 'wo' ) {
+ my $temp = $name[$i];
+ $temp =~ s/payfine//;
+ $inp{ $name[$i] } = $temp;
}
}
my $borrowernumber;
- while ( my ($key, $value) = each %inp){
- # print $key,$value;
- my $accounttype=$input->param("accounttype$value");
- $borrowernumber=$input->param("borrowernumber$value");
- my $itemno=$input->param("itemnumber$value");
- my $amount=$input->param("amount$value");
- my $accountno=$input->param("accountno$value");
- writeoff($borrowernumber,$accountno,$itemno,$accounttype,$amount);
- }
- $borrowernumber=$input->param('borrowernumber');
- print $input->redirect("/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
-}
+ while ( my ( $key, $value ) = each %inp ) {
-
-sub writeoff{
- my ($borrowernumber,$accountnum,$itemnum,$accounttype,$amount)=@_;
- my $user=$input->remote_user;
+ my $accounttype = $input->param("accounttype$value");
+ $borrowernumber = $input->param("borrowernumber$value");
+ my $itemno = $input->param("itemnumber$value");
+ my $amount = $input->param("amount$value");
+ my $accountno = $input->param("accountno$value");
+ writeoff( $borrowernumber, $accountno, $itemno, $accounttype, $amount );
+ }
+ $borrowernumber = $input->param('borrowernumber');
+ print $input->redirect(
+ "/cgi-bin/koha/members/moremember.pl?borrowernumber=$borrowernumber");
+}
+
+sub writeoff {
+ my ( $borrowernumber, $accountnum, $itemnum, $accounttype, $amount ) = @_;
+ my $user = $input->remote_user;
my $dbh = C4::Context->dbh;
my $env;
- my $sth=$dbh->prepare("Update accountlines set amountoutstanding=0 where (accounttype='Res' OR accounttype='FU' OR accounttype ='IP' OR accounttype='CH' OR accounttype='N' OR accounttype='F' OR accounttype='A' OR accounttype='M' OR accounttype='L' OR accounttype='RE' OR accounttype='RL') and accountno=? and borrowernumber=?");
- $sth->execute($accountnum,$borrowernumber);
+ my $sth =
+ $dbh->prepare(
+"Update accountlines set amountoutstanding=0 where (accounttype='Res' OR accounttype='FU' OR accounttype ='IP' OR accounttype='CH' OR accounttype='N' OR accounttype='F' OR accounttype='A' OR accounttype='M' OR accounttype='L' OR accounttype='RE' OR accounttype='RL') and accountno=? and borrowernumber=?"
+ );
+ $sth->execute( $accountnum, $borrowernumber );
$sth->finish;
- $sth=$dbh->prepare("select max(accountno) from accountlines");
+ $sth = $dbh->prepare("select max(accountno) from accountlines");
$sth->execute;
- my $account=$sth->fetchrow_hashref;
+ my $account = $sth->fetchrow_hashref;
$sth->finish;
$account->{'max(accountno)'}++;
- $sth=$dbh->prepare("insert into accountlines (borrowernumber,accountno,itemnumber,date,amount,description,accounttype)
- values (?,?,?,now(),?,'Writeoff','W')");
- $sth->execute($borrowernumber,$account->{'max(accountno)'},$itemnum,$amount);
+ $sth = $dbh->prepare(
+"insert into accountlines (borrowernumber,accountno,itemnumber,date,amount,description,accounttype)
+ values (?,?,?,now(),?,'Writeoff','W')"
+ );
+ $sth->execute( $borrowernumber, $account->{'max(accountno)'},
+ $itemnum, $amount );
$sth->finish;
- UpdateStats($env,$branch,'writeoff',$amount,'','','',$borrowernumber);
+ UpdateStats( $env, $branch, 'writeoff', $amount, '', '', '',
+ $borrowernumber );
}
-
-
-
-
-# Local Variables:
-# tab-width: 4
-# End:
More information about the Koha-cvs
mailing list