Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 217 lines (188 sloc) 7.493 kb
a0b06fb @ctfliblime Prepare for perlbrew usage by changing all script magic to "#!/usr/bi…
ctfliblime authored
1 #!/usr/bin/env perl
d0374d0 Initial revision
rangi authored
2
3 #script to show display basket of orders
4 #written by chris@katipo.co.nz 24/2/2000
5
1e67687 Added copyright statement to all .pl and .pm files
tonnesen authored
6 # Copyright 2000-2002 Katipo Communications
7 #
8 # This file is part of Koha.
9 #
10 # Koha is free software; you can redistribute it and/or modify it under the
11 # terms of the GNU General Public License as published by the Free Software
12 # Foundation; either version 2 of the License, or (at your option) any later
13 # version.
14 #
15 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
16 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
17 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License along with
20 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
21 # Suite 330, Boston, MA 02111-1307 USA
22
f29ce59 Acquisition & Suggestion :
tipaul authored
23 use strict;
d532cf3 Road to 1.9.1
tipaul authored
24 use C4::Auth;
f29ce59 Acquisition & Suggestion :
tipaul authored
25 use C4::Koha;
2ffd5b7 rel_3_0 moved to HEAD
tipaul authored
26 use C4::Output;
d0374d0 Initial revision
rangi authored
27 use CGI;
f29ce59 Acquisition & Suggestion :
tipaul authored
28 use C4::Acquisition;
7fdf61b Call to Bookfund.pm & Bokkseller.pm added. POD added.
toins authored
29 use C4::Bookfund;
30 use C4::Bookseller;
d7ec5d8 cleanup of acqui/ for Dates, missing format_date
Joshua Ferraro authored
31 use C4::Dates qw/format_date/;
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
32 use C4::Debug;
ca4ba92 basket.pl - conditionalized w/ $debug 3 warnings that would otherwise…
Joe Atzberger authored
33
7fdf61b Call to Bookfund.pm & Bokkseller.pm added. POD added.
toins authored
34 =head1 NAME
35
36 basket.pl
37
38 =head1 DESCRIPTION
39
40 This script display all informations about basket for the supplier given
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
41 on input arg. Moreover, it allows us to add a new order for this supplier from
42 an existing record, a suggestion or a new record.
7fdf61b Call to Bookfund.pm & Bokkseller.pm added. POD added.
toins authored
43
44 =head1 CGI PARAMETERS
45
46 =over 4
47
48 =item $basketno
49
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
50 The basket number.
7fdf61b Call to Bookfund.pm & Bokkseller.pm added. POD added.
toins authored
51
52 =item supplierid
53
54 the supplier this script have to display the basket.
55
56 =item order
57
58 =back
59
60 =cut
61
14fa887 perltidy before commit.
sushi authored
62 my $query = new CGI;
7fdf61b Call to Bookfund.pm & Bokkseller.pm added. POD added.
toins authored
63 my $basketno = $query->param('basketno');
cfa9223 * updates to make acquisition compatible with suggestions & serials
tipaul authored
64 my $booksellerid = $query->param('supplierid');
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
65 my $sort = $query->param('order');
66
67 my @sort_loop;
68 if (defined $sort) {
69 foreach (split /\,/, $sort) {
70 my %sorthash = (
71 string => $_,
72 );
73 # other possibly valid tables for later: aqbookfund biblio biblioitems
74 if (
75 (/^\s*(aqorderbreakdown)\.(\w+)\s*$/ and $2 eq 'bookfundid' ) or
76 (/^\s*(biblioitems)\.(\w+)\s*$/ and $2 eq 'publishercode')
77 ) {
78 $sorthash{table} = $1;
79 $sorthash{field} = $2;
80 } else {
81 $sorthash{error} = 1;
82 }
83 push @sort_loop, \%sorthash;
84 }
85 }
86
14fa887 perltidy before commit.
sushi authored
87 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
88 {
89 template_name => "acqui/basket.tmpl",
90 query => $query,
91 type => "intranet",
92 authnotrequired => 0,
93 flagsrequired => { acquisition => 1 },
94 debug => 1,
95 }
96 );
5d22c28 Implementing Independancy Branches management :
hdl authored
97
7fdf61b Call to Bookfund.pm & Bokkseller.pm added. POD added.
toins authored
98 my $basket = GetBasket($basketno);
2ffd5b7 rel_3_0 moved to HEAD
tipaul authored
99
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
100 # FIXME : what about the "discount" percentage?
cfa9223 * updates to make acquisition compatible with suggestions & serials
tipaul authored
101 # FIXME : the query->param('supplierid') below is probably useless. The bookseller is always known from the basket
102 # if no booksellerid in parameter, get it from basket
2ffd5b7 rel_3_0 moved to HEAD
tipaul authored
103 # warn "=>".$basket->{booksellerid};
cfa9223 * updates to make acquisition compatible with suggestions & serials
tipaul authored
104 $booksellerid = $basket->{booksellerid} unless $booksellerid;
18b8a1c Fix for bug 1791
Chris Cormack authored
105 my ($bookseller) = GetBookSellerFromId($booksellerid);
cfa9223 * updates to make acquisition compatible with suggestions & serials
tipaul authored
106
590551e Tidying up formatting
Chris Cormack authored
107 if ( !$bookseller ) {
108 $template->param( NO_BOOKSELLER => 1 );
18b8a1c Fix for bug 1791
Chris Cormack authored
109 }
110 else {
590551e Tidying up formatting
Chris Cormack authored
111
112 # get librarian branch...
113 if ( C4::Context->preference("IndependantBranches") ) {
114 my $userenv = C4::Context->userenv;
115 unless ( $userenv->{flags} == 1 ) {
116 my $validtest = ( $basket->{creationdate} eq '' )
117 || ( $userenv->{branch} eq $basket->{branch} )
118 || ( $userenv->{branch} eq '' )
119 || ( $basket->{branch} eq '' );
120 unless ($validtest) {
121 print $query->redirect("../mainpage.pl");
6c4800c @hgq LLK #18149087 a few places were still exiting 1 under Plack
hgq authored
122 exit;
590551e Tidying up formatting
Chris Cormack authored
123 }
14fa887 perltidy before commit.
sushi authored
124 }
125 }
5e44e79 synch'ing 2.2 and head
tipaul authored
126
590551e Tidying up formatting
Chris Cormack authored
127 # if new basket, pre-fill infos
128 $basket->{creationdate} = "" unless ( $basket->{creationdate} );
129 $basket->{authorisedby} = $loggedinuser unless ( $basket->{authorisedby} );
130 $debug
131 and warn sprintf
132 "loggedinuser: $loggedinuser; creationdate: %s; authorisedby: %s",
133 $basket->{creationdate}, $basket->{authorisedby};
134
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
135 my @results = GetOrders( $basketno, $sort );
590551e Tidying up formatting
Chris Cormack authored
136 my $count = scalar @results;
137
138 my $sub_total; # total of line totals
139 my $grand_total; # $subttotal + $gist
140
141 # my $line_total_est; # total of each line
142 my $sub_total_est; # total of line totals
143 my $sub_total_rrp; # total of line totals
144 my $grand_total_est; # $subttotal + $gist
145
146 my $qty_total;
147 my @books_loop;
148 for ( my $i = 0 ; $i < $count ; $i++ ) {
149 my $rrp = $results[$i]->{'listprice'};
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
150 my $qty = $results[$i]->{'quantity'};
590551e Tidying up formatting
Chris Cormack authored
151 $rrp = ConvertCurrency( $results[$i]->{'currency'}, $rrp );
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
152 $sub_total_rrp += $qty * $results[$i]->{'rrp'};
153 my $line_total = $qty * $results[$i]->{'ecost'};
154 # FIXME: what about the "actual cost" field?
590551e Tidying up formatting
Chris Cormack authored
155 $sub_total += $line_total;
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
156 $qty_total += $qty;
157 my %line = %{ $results[$i] };
158 ($i%2) and $line{toggle} = 1;
159 $line{order_received}= ( $qty eq $results[$i]->{'quantityreceived'} );
590551e Tidying up formatting
Chris Cormack authored
160 $line{basketno} = $basketno;
161 $line{i} = $i;
162 $line{rrp} = sprintf( "%.2f", $line{'rrp'} );
163 $line{ecost} = sprintf( "%.2f", $line{'ecost'} );
164 $line{line_total} = sprintf( "%.2f", $line_total );
165 $line{odd} = $i % 2;
166 push @books_loop, \%line;
ad249c8 Merging Katipo changes.
sushi authored
167 }
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
168 my $prefgist = C4::Context->preference("gist") || 0;
169 my $gist = $sub_total * $prefgist;
170 my $gist_rrp = $sub_total_rrp * $prefgist;
171 $grand_total = $sub_total_est = $sub_total;
172 $grand_total_est = $sub_total_est; # FIXME: Too many things that are ALL the SAME
173 my $temp;
174 if ($temp = $bookseller->{'listincgst'}) {
175 $template->param(listincgst => $temp);
176 $gist = 0;
177 } else {
590551e Tidying up formatting
Chris Cormack authored
178 $grand_total += $gist;
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
179 $grand_total_est += $sub_total_est * $prefgist; # same thing as += gist
ad249c8 Merging Katipo changes.
sushi authored
180 }
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
181 if ($temp = $bookseller->{'discount'}) {
182 $template->param(discount => sprintf( "%.2f", $temp ));
183 }
590551e Tidying up formatting
Chris Cormack authored
184 $template->param(
185 basketno => $basketno,
186 creationdate => format_date( $basket->{creationdate} ),
187 authorisedby => $basket->{authorisedby},
188 authorisedbyname => $basket->{authorisedbyname},
d147d3e @pjones9 DE265: incomplete support for marcxml
pjones9 authored
189 closedate => ($basket->{closedate}) ? format_date( $basket->{closedate} ) : '',
590551e Tidying up formatting
Chris Cormack authored
190 active => $bookseller->{'active'},
191 booksellerid => $bookseller->{'id'},
192 name => $bookseller->{'name'},
193 address1 => $bookseller->{'address1'},
194 address2 => $bookseller->{'address2'},
195 address3 => $bookseller->{'address3'},
196 address4 => $bookseller->{'address4'},
197 entrydate => format_date( $results[0]->{'entrydate'} ),
198 books_loop => \@books_loop,
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
199 sort_loop => \@sort_loop,
590551e Tidying up formatting
Chris Cormack authored
200 count => $count,
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
201 gist => $gist ? sprintf( "%.2f", $gist ) : 0,
202 gist_rate => sprintf( "%.2f", $prefgist * 100) . '%',
203 gist_est => sprintf( "%.2f", $sub_total_est * $prefgist ),
204 gist_rrp => sprintf( "%.2f", $gist_rrp),
205 sub_total => sprintf( "%.2f", $sub_total ),
590551e Tidying up formatting
Chris Cormack authored
206 grand_total => sprintf( "%.2f", $grand_total ),
79c37dc basket.pl and template - Many fixes including SQL injection security …
Joe Atzberger authored
207 sub_total_est => sprintf( "%.2f", $sub_total_est),
208 grand_total_est => sprintf( "%.2f", $grand_total_est),
209 sub_total_rrp => sprintf( "%.2f", $sub_total_rrp),
210 grand_total_rrp => sprintf( "%.2f", $sub_total_rrp + $gist_rrp),
590551e Tidying up formatting
Chris Cormack authored
211 currency => $bookseller->{'listprice'},
212 qty_total => $qty_total,
213 GST => $prefgist,
214 );
aa5a4b9 basket.pl - bugfix 1714, GST pre-inclusion checked. FIXME's added.
Joe Atzberger authored
215 }
d532cf3 Road to 1.9.1
tipaul authored
216 output_html_with_http_headers $query, $cookie, $template->output;
Something went wrong with that request. Please try again.