allow wrap parameters without quotes
[bse.git] / site / cgi-bin / modules / BSE / TB / Order.pm
CommitLineData
0ec4ac8a
TC
1package BSE::TB::Order;
2use strict;
3# represents an order from the database
4use Squirrel::Row;
5use vars qw/@ISA/;
6@ISA = qw/Squirrel::Row/;
5d88571c 7use Carp 'confess';
0ec4ac8a 8
8d8895b4 9our $VERSION = "1.005";
cb7fd78d 10
0ec4ac8a
TC
11sub columns {
12 return qw/id
13 delivFirstName delivLastName delivStreet delivSuburb delivState
14 delivPostCode delivCountry
15 billFirstName billLastName billStreet billSuburb billState
16 billPostCode billCountry
17 telephone facsimile emailAddress
18 total wholesaleTotal gst orderDate
19 ccNumberHash ccName ccExpiryHash ccType
20 filled whenFilled whoFilled paidFor paymentReceipt
21 randomId cancelled userId paymentType
22 customInt1 customInt2 customInt3 customInt4 customInt5
23 customStr1 customStr2 customStr3 customStr4 customStr5
24 instructions billTelephone billFacsimile billEmail
e3d242f7 25 siteuser_id affiliate_code shipping_cost
41e7c841
TC
26 delivMobile billMobile
27 ccOnline ccSuccess ccReceipt ccStatus ccStatusText
37dd20ad 28 ccStatus2 ccTranId complete delivOrganization billOrganization
d9803c26 29 delivStreet2 billStreet2 purchase_order shipping_method
13a986ee 30 shipping_name shipping_trace
f0722dd2
TC
31 paypal_token paypal_tran_id freight_tracking stage/;
32}
33
34sub table {
35 return "orders";
0ec4ac8a
TC
36}
37
14604ada
TC
38sub defaults {
39 require BSE::Util::SQL;
40 require Digest::MD5;
41 return
42 (
f0722dd2
TC
43 billFirstName => "",
44 billLastName => "",
45 billStreet => "",
46 billSuburb => "",
47 billState => "",
48 billPostCode => "",
49 billCountry => "",
14604ada
TC
50 total => 0,
51 wholesaleTotal => 0,
52 gst => 0,
53 orderDate => BSE::Util::SQL::now_datetime(),
54 filled => 0,
55 whenFilled => undef,
56 whoFilled => '',
57 paidFor => 0,
58 paymentReceipt => '',
59 randomId => Digest::MD5::md5_hex(time().rand().{}.$$),
60 ccNumberHash => '',
61 ccName => '',
62 ccExpiryHash => '',
63 ccType => '',
64 randomId => '',
65 cancelled => 0,
66 userId => '',
67 paymentType => 0,
68 customInt1 => undef,
69 customInt2 => undef,
70 customInt3 => undef,
71 customInt4 => undef,
72 customInt5 => undef,
73 customStr1 => undef,
74 customStr2 => undef,
75 customStr3 => undef,
76 customStr4 => undef,
77 customStr5 => undef,
78 instructions => '',
79 siteuser_id => undef,
80 affiliate_code => '',
81 shipping_cost => 0,
82 ccOnline => 0,
83 ccSuccess => 0,
84 ccReceipt => '',
85 ccStatus => 0,
86 ccStatusText => '',
87 ccStatus2 => '',
88 ccTranId => '',
89 complete => 0,
90 purchase_order => '',
91 shipping_method => '',
92 shipping_name => '',
93 shipping_trace => undef,
f0722dd2
TC
94 paypal_token => "",
95 paypal_tran_id => "",
080fc207 96 freight_tracking => "",
f0722dd2 97 stage => "incomplete",
14604ada
TC
98 );
99}
100
13a986ee
TC
101sub table { "orders" }
102
14604ada
TC
103sub address_columns {
104 return qw/
105 delivFirstName delivLastName delivStreet delivSuburb delivState
106 delivPostCode delivCountry
107 billFirstName billLastName billStreet billSuburb billState
108 billPostCode billCountry
109 telephone facsimile emailAddress
110 instructions billTelephone billFacsimile billEmail
111 delivMobile billMobile
112 delivOrganization billOrganization
113 delivStreet2 billStreet2/;
114}
115
116sub user_columns {
117 return qw/userId siteuser_id/;
118}
119
120sub payment_columns {
121 return qw/ccNumberHash ccName ccExpiryHash ccType
122 paidFor paymentReceipt paymentType
123 ccOnline ccSuccess ccReceipt ccStatus ccStatusText
124 ccStatus2 ccTranId/;
125}
126
0ec4ac8a
TC
127=item siteuser
128
129returns the SiteUser object of the user who made this order.
130
131=cut
132
133sub siteuser {
134 my ($self) = @_;
135
f0722dd2
TC
136 if ($self->siteuser_id) {
137 require SiteUsers;
138 my $user = SiteUsers->getByPkey($self->siteuser_id);
139 $user and return $user;
140 }
141
0ec4ac8a
TC
142 $self->{userId} or return;
143
144 require SiteUsers;
145
146 return ( SiteUsers->getBy(userId=>$self->{userId}) )[0];
147}
148
149sub items {
150 my ($self) = @_;
151
152 require BSE::TB::OrderItems;
153 return BSE::TB::OrderItems->getBy(orderId => $self->{id});
154}
155
ab2cd916
TC
156sub files {
157 my ($self) = @_;
158
159 BSE::DB->query(orderFiles=>$self->{id});
160}
161
eb9d306d
TC
162sub paid_files {
163 my ($self) = @_;
164
165 $self->paidFor
166 or return;
167
168 require BSE::TB::ArticleFiles;
169 return BSE::TB::ArticleFiles->getSpecial(orderPaidFor => $self->id);
170}
171
ab2cd916
TC
172sub products {
173 my ($self) = @_;
174
175 require Products;
176 Products->getSpecial(orderProducts=>$self->{id});
177}
178
41e7c841
TC
179sub valid_fields {
180 my ($class, $cfg) = @_;
181
182 my %fields =
183 (
37dd20ad
TC
184 delivFirstName => { description=>'Delivery First Name',
185 rules=>'dh_one_line' },
186 delivLastName => { description => 'Delivery Last Name',
187 rules=>'dh_one_line' },
188 delivOrganization => { description => 'Delivery Organization',
189 rules=>'dh_one_line' },
190 delivStreet => { description => 'Delivery Street',
191 rules=>'dh_one_line' },
192 delivStreet2 => { description => 'Delivery Street 2',
193 rules=>'dh_one_line' },
194 delivState => { description => 'Delivery State',
195 rules=>'dh_one_line' },
196 delivSuburb => { description => 'Delivery Suburb',
197 rules=>'dh_one_line' },
198 delivPostCode => { description => 'Delivery Post Code',
9074efa2 199 rules=>'dh_one_line;dh_int_postcode' },
37dd20ad
TC
200 delivCountry => { description => 'Delivery Country',
201 rules=>'dh_one_line' },
202 billFirstName => { description => 'Billing First Name',
203 rules=>'dh_one_line' },
204 billLastName => { description => 'Billing Last Name',
205 rules=>'dh_one_line' },
206 billOrganization => { description => 'Billing Organization',
207 rules=>'dh_one_line' },
208 billStreet => { description => 'Billing Street',
209 rules=>'dh_one_line' },
210 billStreet2 => { description => 'Billing Street 2',
211 rules=>'dh_one_line' },
212 billSuburb => { description => 'Billing Suburb',
213 rules=>'dh_one_line' },
214 billState => { description => 'Billing State',
215 rules=>'dh_one_line' },
216 billPostCode => { description => 'Billing Post Code',
9074efa2 217 rules=>'dh_one_line;dh_int_postcode' },
37dd20ad
TC
218 billCountry => { description => 'Billing First Name',
219 rules=>'dh_one_line' },
41e7c841
TC
220 telephone => { description => 'Telephone Number',
221 rules => "phone" },
222 facsimile => { description => 'Facsimile Number',
223 rules => 'phone' },
224 emailAddress => { description => 'Email Address',
225 rules=>'email;required' },
226 instructions => { description => 'Instructions' },
227 billTelephone => { description => 'Billing Telephone Number',
228 rules=>'phone' },
229 billFacsimile => { description => 'Billing Facsimile Number',
230 rules=>'phone' },
231 billEmail => { description => 'Billing Email Address',
232 rules => 'email' },
233 delivMobile => { description => 'Delivery Mobile Number',
234 rules => 'phone' },
235 billMobile => { description => 'Billing Mobile Number',
236 rules=>'phone' },
237 instructions => { description => 'Instructions' },
74b21f6d 238 purchase_order => { description => 'Purchase Order No' },
d8674b8b
AMS
239 shipping_cost => { description => 'Shipping charges' },
240 shipping_method => { description => 'Shipping method' },
41e7c841
TC
241 );
242
243 for my $field (keys %fields) {
244 my $display = $cfg->entry('shop', "display_$field");
245 $display and $fields{$field}{description} = $display;
246 }
247
248 return %fields;
249}
250
251sub valid_rules {
252 my ($class, $cfg) = @_;
253
254 return;
255}
256
257sub valid_payment_fields {
258 my ($class, $cfg) = @_;
259
260 my %fields =
261 (
262 cardNumber =>
263 {
264 description => "Credit Card Number",
265 rules=>"creditcardnumber",
266 },
267 cardExpiry =>
268 {
269 description => "Credit Card Expiry Date",
270 rules => 'creditcardexpirysingle',
271 },
272 cardHolder => { description => "Credit Card Holder" },
273 cardType => { description => "Credit Card Type" },
274 cardVerify =>
275 {
276 description => 'Card Verification Value',
277 rules => 'creditcardcvv',
278 },
279 );
280
281 for my $field (keys %fields) {
282 my $display = $cfg->entry('shop', "display_$field");
283 $display and $fields{$field}{description} = $display;
284 }
285
286 return %fields;
287}
288
289sub valid_payment_rules {
290 return;
291}
292
5d88571c
TC
293sub clear_items {
294 my ($self) = @_;
295
296 confess "Attempt to clear items on completed order $self->{id}"
297 if $self->{complete};
298
299 BSE::DB->run(deleteOrdersItems => $self->{id});
300}
301
14604ada
TC
302sub add_item {
303 my ($self, %opts) = @_;
304
305 my $prod = delete $opts{product}
306 or confess "Missing product option";
307 my $units = delete $opts{units} || 1;
308
309 my $options = '';
310 my @dboptions;
311 if ($opts{options}) {
312 if (ref $opts{options}) {
313 @dboptions = @{delete $opts{options}};
314 }
315 else {
316 $options = delete $opts{options};
317 }
318 }
319
320 require BSE::TB::OrderItems;
321 my %item =
322 (
323 productId => $prod->id,
324 orderId => $self->id,
325 units => $units,
326 price => $prod->retailPrice,
327 options => $options,
328 max_lapsed => 0,
329 session_id => 0,
330 ( map { $_ => $prod->{$_} }
331 qw/wholesalePrice gst customInt1 customInt2 customInt3 customStr1 customStr2 customStr3 title description subscription_id subscription_period product_code/
332 ),
333 );
334
335 $self->set_total($self->total + $prod->retailPrice * $units);
336
337 return BSE::TB::OrderItems->make(%item);
338}
339
13a986ee
TC
340sub deliv_country_code {
341 my ($self) = @_;
342
343 my $use_codes = BSE::Cfg->single->entry("shop", "country_code", 0);
344 if ($use_codes) {
345 return $self->delivCountry;
346 }
347 else {
348 require BSE::Countries;
349 return BSE::Countries::bse_country_code($self->delivCountry);
350 }
351}
352
f0722dd2
TC
353=item stage
354
355Return the order stage.
356
357If the stage is empty, guess from the order flags.
358
359=cut
360
361sub stage {
362 my ($self) = @_;
363
364 if ($self->{stage} ne "") {
365 return $self->{stage};
366 }
367
368 if (!$self->complete) {
369 return "incomplete";
370 }
371 elsif ($self->filled) {
372 return "shipped";
373 }
374 else {
375 return "unprocessed";
376 }
377}
378
379sub stage_description {
380 my ($self, $lang) = @_;
381
382 return BSE::TB::Orders->stage_label($self->stage, $lang);
383}
384
385=item mail_recipient
386
387Return a value suitable for BSE::ComposeMail's to parameter.
388
389=cut
390
391sub mail_recipient {
392 my ($self) = @_;
393
394 my $user = $self->siteuser;
395
396 if ($user && $user->email eq $self->emailAddress) {
397 return $user;
398 }
399
400 return $self->emailAddress;
401}
402
8d8895b4
TC
403=item mail_tags
404
405Return mail template tags suitable for an order
406
407=cut
408
409sub mail_tags {
410 my ($self) = @_;
411
412 require BSE::Util::Tags;
413 require BSE::Util::Iterate;
414 require BSE::TB::OrderItems;
415 my $it = BSE::Util::Iterate::Objects::Text->new;
416 my %item_cols = map { $_ => 1 } BSE::TB::OrderItem->columns;
417 my %products;
418 my $current_item;
419 return
420 (
421 order => [ \&BSE::Util::Tags::tag_object_plain, $self ],
422 $it->make
423 (
424 single => "item",
425 plural => "items",
426 code => [ items => $self ],
427 store => \$current_item,
428 ),
429 extended => sub {
430 my ($args) = @_;
431
432 $current_item
433 or return '* only usable in items iterator *';
434
435 $item_cols{$args}
436 or return "* unknown item column $args *";
437
438 return $current_item->$args() * $current_item->units;
439 },
440 $it->make
441 (
442 single => "option",
443 plural => "options",
444 code => sub {
445 $current_item
446 or return;
447 return $current_item->option_hashes
448 },
449 nocache => 1,
450 ),
451 options => sub {
452 $current_item
453 or return '* only in the items iterator *';
454 return $current_item->nice_options;
455 },
456 product => sub {
457 $current_item
458 or return '* only usable in items *';
459
460 require Products;
461 my $id = $current_item->productId;
462 $products{$id} ||= Products->getByPkey($id);
463
464 my $product = $products{$id}
465 or return '';
466
467 return BSE::Util::Tags::tag_article_plain($product, BSE::Cfg->single, $_[0]);
468 },
469 );
470}
471
f0722dd2
TC
472sub send_shipped_email {
473 my ($self) = @_;
474
475 my $to = $self->mail_recipient;
476 require BSE::ComposeMail;
477 my $mailer = BSE::ComposeMail->new(cfg => BSE::Cfg->single);
478 require BSE::Util::Tags;
479 require BSE::Util::Iterate;
480 my $it = BSE::Util::Iterate::Objects->new;
481 my %acts =
482 (
483 BSE::Util::Tags->mail_tags(),
8d8895b4 484 $self->mail_tags,
f0722dd2
TC
485 );
486
487 $mailer->send
488 (
489 to => $to,
490 subject => "Your order has shipped",
491 template => "email/ordershipped",
492 acts => \%acts,
493 log_msg => "Notify customer order has shipped",
494 log_object => $self,
495 log_component => "shopadmin:orders:saveorder",
496 );
497}
498
499sub new_stage {
500 my ($self, $who, $stage, $stage_note) = @_;
501
502 unless ($stage ne $self->stage
503 || defined $stage_note && $stage_note =~ /\S/) {
504 return;
505 }
506
507 my $old_stage = $self->stage;
508 my $msg = "Set to stage '$stage'";
509 if (defined $stage_note && $stage_note =~ /\S/) {
510 $msg .= ": $stage_note";
511 }
512 require BSE::TB::AuditLog;
513 BSE::TB::AuditLog->log
514 (
515 component => "shopadmin:orders:saveorder",
516 object => $self,
517 msg => $msg,
518 level => "info",
519 actor => $who || "U"
520 );
521
522 if ($stage ne $old_stage) {
523 $self->set_stage($stage);
524 if ($stage eq "shipped") {
525 $self->send_shipped_email();
526 $self->set_filled(1);
527 }
528 else {
529 $self->set_filled(0);
530 }
531 }
532}
533
0ec4ac8a 5341;