make the order variable available on the user order detail page
[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';
b62cae00 8use BSE::Shop::PaymentTypes;
0ec4ac8a 9
91a02f51 10our $VERSION = "1.019";
cb7fd78d 11
0ec4ac8a
TC
12sub columns {
13 return qw/id
14 delivFirstName delivLastName delivStreet delivSuburb delivState
15 delivPostCode delivCountry
16 billFirstName billLastName billStreet billSuburb billState
17 billPostCode billCountry
18 telephone facsimile emailAddress
19 total wholesaleTotal gst orderDate
20 ccNumberHash ccName ccExpiryHash ccType
21 filled whenFilled whoFilled paidFor paymentReceipt
22 randomId cancelled userId paymentType
23 customInt1 customInt2 customInt3 customInt4 customInt5
24 customStr1 customStr2 customStr3 customStr4 customStr5
25 instructions billTelephone billFacsimile billEmail
e3d242f7 26 siteuser_id affiliate_code shipping_cost
41e7c841
TC
27 delivMobile billMobile
28 ccOnline ccSuccess ccReceipt ccStatus ccStatusText
37dd20ad 29 ccStatus2 ccTranId complete delivOrganization billOrganization
d9803c26 30 delivStreet2 billStreet2 purchase_order shipping_method
13a986ee 31 shipping_name shipping_trace
b62cae00 32 paypal_token paypal_tran_id freight_tracking stage ccPAN
91a02f51 33 paid_manually coupon_code coupon_code_discount_pc/;
f0722dd2
TC
34}
35
36sub table {
37 return "orders";
0ec4ac8a
TC
38}
39
14604ada
TC
40sub defaults {
41 require BSE::Util::SQL;
42 require Digest::MD5;
43 return
44 (
f0722dd2
TC
45 billFirstName => "",
46 billLastName => "",
47 billStreet => "",
48 billSuburb => "",
49 billState => "",
50 billPostCode => "",
51 billCountry => "",
14604ada
TC
52 total => 0,
53 wholesaleTotal => 0,
54 gst => 0,
55 orderDate => BSE::Util::SQL::now_datetime(),
56 filled => 0,
57 whenFilled => undef,
58 whoFilled => '',
59 paidFor => 0,
60 paymentReceipt => '',
61 randomId => Digest::MD5::md5_hex(time().rand().{}.$$),
62 ccNumberHash => '',
63 ccName => '',
64 ccExpiryHash => '',
65 ccType => '',
66 randomId => '',
67 cancelled => 0,
68 userId => '',
69 paymentType => 0,
70 customInt1 => undef,
71 customInt2 => undef,
72 customInt3 => undef,
73 customInt4 => undef,
74 customInt5 => undef,
75 customStr1 => undef,
76 customStr2 => undef,
77 customStr3 => undef,
78 customStr4 => undef,
79 customStr5 => undef,
80 instructions => '',
81 siteuser_id => undef,
82 affiliate_code => '',
83 shipping_cost => 0,
84 ccOnline => 0,
85 ccSuccess => 0,
86 ccReceipt => '',
87 ccStatus => 0,
88 ccStatusText => '',
89 ccStatus2 => '',
90 ccTranId => '',
91 complete => 0,
92 purchase_order => '',
93 shipping_method => '',
94 shipping_name => '',
95 shipping_trace => undef,
f0722dd2
TC
96 paypal_token => "",
97 paypal_tran_id => "",
080fc207 98 freight_tracking => "",
f0722dd2 99 stage => "incomplete",
6abd8ce8 100 ccPAN => "",
b62cae00 101 paid_manually => 0,
14604ada
TC
102 );
103}
104
105sub address_columns {
106 return qw/
107 delivFirstName delivLastName delivStreet delivSuburb delivState
108 delivPostCode delivCountry
109 billFirstName billLastName billStreet billSuburb billState
110 billPostCode billCountry
111 telephone facsimile emailAddress
112 instructions billTelephone billFacsimile billEmail
113 delivMobile billMobile
114 delivOrganization billOrganization
115 delivStreet2 billStreet2/;
116}
117
118sub user_columns {
119 return qw/userId siteuser_id/;
120}
121
122sub payment_columns {
123 return qw/ccNumberHash ccName ccExpiryHash ccType
124 paidFor paymentReceipt paymentType
125 ccOnline ccSuccess ccReceipt ccStatus ccStatusText
b62cae00 126 ccStatus2 ccTranId ccPAN paid_manually/;
14604ada
TC
127}
128
c4f18087
TC
129=item billing_to_delivery_map
130
131Return a hashref where the key is a billing field and the value is the
132corresponding delivery field.
133
134=cut
135
136{
137 my %billing_to_delivery =
138 (
139 billEmail => "emailAddress",
140 billFirstName => "delivFirstName",
141 billLastName => "delivLastName",
142 billStreet => "delivStreet",
143 billStreet2 => "delivStreet2",
144 billSuburb => "delivSuburb",
145 billState => "delivState",
146 billPostCode => "delivPostCode",
147 billCountry => "delivCountry",
148 billTelephone => "telephone",
a964e89d 149 billMobile => "delivMobile",
c4f18087
TC
150 billFacsimile => "facsimile",
151 billOrganization => "delivOrganization",
152 );
153
154 sub billing_to_delivery_map {
155 return \%billing_to_delivery;
156 }
157}
158
0ec4ac8a
TC
159=item siteuser
160
161returns the SiteUser object of the user who made this order.
162
163=cut
164
165sub siteuser {
166 my ($self) = @_;
167
f0722dd2
TC
168 if ($self->siteuser_id) {
169 require SiteUsers;
170 my $user = SiteUsers->getByPkey($self->siteuser_id);
171 $user and return $user;
172 }
173
0ec4ac8a
TC
174 $self->{userId} or return;
175
176 require SiteUsers;
177
178 return ( SiteUsers->getBy(userId=>$self->{userId}) )[0];
179}
180
181sub items {
182 my ($self) = @_;
183
184 require BSE::TB::OrderItems;
185 return BSE::TB::OrderItems->getBy(orderId => $self->{id});
186}
187
ab2cd916
TC
188sub files {
189 my ($self) = @_;
190
7c6f563b
TC
191 require BSE::TB::ArticleFiles;
192 return BSE::TB::ArticleFiles->getSpecial(orderFiles=>$self->{id});
ab2cd916
TC
193}
194
eb9d306d
TC
195sub paid_files {
196 my ($self) = @_;
197
198 $self->paidFor
199 or return;
200
201 require BSE::TB::ArticleFiles;
202 return BSE::TB::ArticleFiles->getSpecial(orderPaidFor => $self->id);
203}
204
ab2cd916
TC
205sub products {
206 my ($self) = @_;
207
208 require Products;
209 Products->getSpecial(orderProducts=>$self->{id});
210}
211
41e7c841
TC
212sub valid_fields {
213 my ($class, $cfg) = @_;
214
215 my %fields =
216 (
b27af108 217 delivFirstName => { description=>'Delivery First Name',
37dd20ad 218 rules=>'dh_one_line' },
b27af108 219 delivLastName => { description => 'Delivery Last Name',
37dd20ad 220 rules=>'dh_one_line' },
b27af108 221 delivOrganization => { description => 'Delivery Organization',
37dd20ad 222 rules=>'dh_one_line' },
b27af108 223 delivStreet => { description => 'Delivery Street',
37dd20ad 224 rules=>'dh_one_line' },
b27af108 225 delivStreet2 => { description => 'Delivery Street 2',
37dd20ad 226 rules=>'dh_one_line' },
b27af108 227 delivState => { description => 'Delivery State',
37dd20ad 228 rules=>'dh_one_line' },
b27af108 229 delivSuburb => { description => 'Delivery Suburb',
37dd20ad 230 rules=>'dh_one_line' },
b27af108 231 delivPostCode => { description => 'Delivery Post Code',
9074efa2 232 rules=>'dh_one_line;dh_int_postcode' },
b27af108 233 delivCountry => { description => 'Delivery Country',
37dd20ad 234 rules=>'dh_one_line' },
b27af108 235 billFirstName => { description => 'Billing First Name',
37dd20ad 236 rules=>'dh_one_line' },
b27af108 237 billLastName => { description => 'Billing Last Name',
37dd20ad 238 rules=>'dh_one_line' },
b27af108 239 billOrganization => { description => 'Billing Organization',
37dd20ad 240 rules=>'dh_one_line' },
b27af108 241 billStreet => { description => 'Billing Street',
37dd20ad 242 rules=>'dh_one_line' },
b27af108 243 billStreet2 => { description => 'Billing Street 2',
37dd20ad 244 rules=>'dh_one_line' },
b27af108 245 billSuburb => { description => 'Billing Suburb',
37dd20ad 246 rules=>'dh_one_line' },
b27af108 247 billState => { description => 'Billing State',
37dd20ad 248 rules=>'dh_one_line' },
b27af108 249 billPostCode => { description => 'Billing Post Code',
9074efa2 250 rules=>'dh_one_line;dh_int_postcode' },
b27af108 251 billCountry => { description => 'Billing First Name',
37dd20ad 252 rules=>'dh_one_line' },
41e7c841
TC
253 telephone => { description => 'Telephone Number',
254 rules => "phone" },
255 facsimile => { description => 'Facsimile Number',
256 rules => 'phone' },
257 emailAddress => { description => 'Email Address',
c4f18087 258 rules=>'email' },
41e7c841 259 instructions => { description => 'Instructions' },
b27af108 260 billTelephone => { description => 'Billing Telephone Number',
41e7c841
TC
261 rules=>'phone' },
262 billFacsimile => { description => 'Billing Facsimile Number',
263 rules=>'phone' },
264 billEmail => { description => 'Billing Email Address',
c4f18087 265 rules => 'email;required' },
41e7c841
TC
266 delivMobile => { description => 'Delivery Mobile Number',
267 rules => 'phone' },
268 billMobile => { description => 'Billing Mobile Number',
269 rules=>'phone' },
270 instructions => { description => 'Instructions' },
74b21f6d 271 purchase_order => { description => 'Purchase Order No' },
d8674b8b
AMS
272 shipping_cost => { description => 'Shipping charges' },
273 shipping_method => { description => 'Shipping method' },
41e7c841
TC
274 );
275
276 for my $field (keys %fields) {
277 my $display = $cfg->entry('shop', "display_$field");
278 $display and $fields{$field}{description} = $display;
279 }
280
281 return %fields;
282}
283
284sub valid_rules {
285 my ($class, $cfg) = @_;
286
287 return;
288}
289
290sub valid_payment_fields {
291 my ($class, $cfg) = @_;
292
293 my %fields =
294 (
b27af108
TC
295 cardNumber =>
296 {
41e7c841
TC
297 description => "Credit Card Number",
298 rules=>"creditcardnumber",
299 },
b27af108 300 cardExpiry =>
41e7c841
TC
301 {
302 description => "Credit Card Expiry Date",
303 rules => 'creditcardexpirysingle',
304 },
6abd8ce8 305 ccName => { description => "Credit Card Holder" },
1546e1f0 306 ccType => { description => "Credit Card Type" },
b27af108
TC
307 cardVerify =>
308 {
41e7c841
TC
309 description => 'Card Verification Value',
310 rules => 'creditcardcvv',
311 },
312 );
313
314 for my $field (keys %fields) {
315 my $display = $cfg->entry('shop', "display_$field");
316 $display and $fields{$field}{description} = $display;
317 }
318
319 return %fields;
320}
321
322sub valid_payment_rules {
323 return;
324}
325
5d88571c
TC
326sub clear_items {
327 my ($self) = @_;
328
329 confess "Attempt to clear items on completed order $self->{id}"
330 if $self->{complete};
b27af108 331
5d88571c
TC
332 BSE::DB->run(deleteOrdersItems => $self->{id});
333}
334
14604ada
TC
335sub add_item {
336 my ($self, %opts) = @_;
337
338 my $prod = delete $opts{product}
339 or confess "Missing product option";
340 my $units = delete $opts{units} || 1;
341
342 my $options = '';
343 my @dboptions;
344 if ($opts{options}) {
345 if (ref $opts{options}) {
346 @dboptions = @{delete $opts{options}};
347 }
348 else {
349 $options = delete $opts{options};
350 }
351 }
b27af108 352
14604ada
TC
353 require BSE::TB::OrderItems;
354 my %item =
355 (
356 productId => $prod->id,
357 orderId => $self->id,
358 units => $units,
359 price => $prod->retailPrice,
360 options => $options,
361 max_lapsed => 0,
362 session_id => 0,
363 ( map { $_ => $prod->{$_} }
364 qw/wholesalePrice gst customInt1 customInt2 customInt3 customStr1 customStr2 customStr3 title description subscription_id subscription_period product_code/
365 ),
366 );
367
368 $self->set_total($self->total + $prod->retailPrice * $units);
369
370 return BSE::TB::OrderItems->make(%item);
371}
372
13a986ee
TC
373sub deliv_country_code {
374 my ($self) = @_;
375
376 my $use_codes = BSE::Cfg->single->entry("shop", "country_code", 0);
377 if ($use_codes) {
378 return $self->delivCountry;
379 }
380 else {
381 require BSE::Countries;
382 return BSE::Countries::bse_country_code($self->delivCountry);
383 }
384}
385
f0722dd2
TC
386=item stage
387
388Return the order stage.
389
390If the stage is empty, guess from the order flags.
391
392=cut
393
394sub stage {
395 my ($self) = @_;
396
397 if ($self->{stage} ne "") {
398 return $self->{stage};
399 }
400
401 if (!$self->complete) {
402 return "incomplete";
403 }
404 elsif ($self->filled) {
405 return "shipped";
406 }
407 else {
408 return "unprocessed";
409 }
410}
411
412sub stage_description {
413 my ($self, $lang) = @_;
414
415 return BSE::TB::Orders->stage_label($self->stage, $lang);
416}
417
f55be9df
TC
418sub stage_description_id {
419 my ($self) = @_;
420
421 return BSE::TB::Orders->stage_label_id($self->stage);
422}
423
c4f18087 424=item delivery_mail_recipient
f0722dd2 425
c4f18087
TC
426Return a value suitable for BSE::ComposeMail's to parameter for the
427shipping email address.
f0722dd2
TC
428
429=cut
430
c4f18087 431sub delivery_mail_recipient {
f0722dd2
TC
432 my ($self) = @_;
433
434 my $user = $self->siteuser;
c4f18087 435 my $email = $self->emailAddress || $self->billEmail;
f0722dd2 436
c4f18087 437 if ($user && $user->email eq $email) {
f0722dd2
TC
438 return $user;
439 }
440
c4f18087 441 return $email;
f0722dd2
TC
442}
443
768dccf0 444=item _tags
8d8895b4 445
768dccf0 446Internal method with the common code between tags() and mail_tags().
8d8895b4
TC
447
448=cut
449
768dccf0
TC
450sub _tags {
451 my ($self, $escape) = @_;
8d8895b4
TC
452
453 require BSE::Util::Tags;
8d8895b4 454 require BSE::TB::OrderItems;
768dccf0
TC
455 require BSE::Util::Iterate;
456 my $it;
457 my $art;
458 my $esc;
459 my $obj;
460 if ($escape) {
461 require BSE::Util::HTML;
462 $it = BSE::Util::Iterate::Objects->new;
463 $art = \&BSE::Util::Tags::tag_article;
464 $obj = \&BSE::Util::Tags::tag_object;
465 $esc = \&BSE::Util::HTML::escape_html;
466 }
467 else {
468 $it = BSE::Util::Iterate::Objects::Text->new;
469 $art = \&BSE::Util::Tags::tag_article_plain;
470 $obj = \&BSE::Util::Tags::tag_object_plain;
471 $esc = sub { return $_[0] };
472 }
473
474 my $cfg = BSE::Cfg->single;
475 my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
476 my $must_be_filled = $cfg->entryBool('downloads', 'must_be_filled', 0);
477
8d8895b4
TC
478 my %item_cols = map { $_ => 1 } BSE::TB::OrderItem->columns;
479 my %products;
480 my $current_item;
768dccf0 481 my $current_file;
8d8895b4
TC
482 return
483 (
768dccf0 484 order => [ $obj, $self ],
8d8895b4
TC
485 $it->make
486 (
487 single => "item",
488 plural => "items",
489 code => [ items => $self ],
490 store => \$current_item,
491 ),
492 extended => sub {
493 my ($args) = @_;
494
495 $current_item
496 or return '* only usable in items iterator *';
497
498 $item_cols{$args}
499 or return "* unknown item column $args *";
500
501 return $current_item->$args() * $current_item->units;
502 },
503 $it->make
504 (
505 single => "option",
506 plural => "options",
507 code => sub {
508 $current_item
509 or return;
510 return $current_item->option_hashes
511 },
512 nocache => 1,
513 ),
514 options => sub {
515 $current_item
516 or return '* only in the items iterator *';
768dccf0 517 return $esc->($current_item->nice_options);
8d8895b4
TC
518 },
519 product => sub {
520 $current_item
521 or return '* only usable in items *';
522
523 require Products;
524 my $id = $current_item->productId;
525 $products{$id} ||= Products->getByPkey($id);
526
527 my $product = $products{$id}
528 or return '';
529
768dccf0
TC
530 return $art->($product, $cfg, $_[0]);
531 },
7c6f563b 532 $it->make
768dccf0
TC
533 (
534 single => 'orderfile',
535 plural => 'orderfiles',
536 code => [ files => $self ],
537 store => \$current_file,
538 ),
7c6f563b 539 $it->make
768dccf0
TC
540 (
541 single => "prodfile",
542 plural => "prodfiles",
543 code => sub {
544 $current_item
545 or return '* only usable in items *';
546
547 require Products;
548 my $id = $current_item->productId;
549 $products{$id} ||= Products->getByPkey($id);
550
551 my $product = $products{$id}
552 or return '';
553
554 return $product->files;
555 },
556 store => \$current_file,
557 ),
558 ifFileAvail => sub {
559 $current_file or return 0;
560 $current_file->{forSale} or return 1;
561
562 return 0 if $must_be_paid && !$self->{paidFor};
563 return 0 if $must_be_filled && !$self->{filled};
564
565 return 1;
8d8895b4
TC
566 },
567 );
568}
569
768dccf0
TC
570=item mail_tags
571
572=cut
573
574sub mail_tags {
575 my ($self) = @_;
576
577 return $self->_tags(0);
578}
579
580=item tags
581
582Return template tags suitable for an order (non-mail)
583
584=cut
585
586sub tags {
587 my ($self) = @_;
588
589 return $self->_tags(1);
590}
591
f0722dd2
TC
592sub send_shipped_email {
593 my ($self) = @_;
594
c4f18087 595 my $to = $self->delivery_mail_recipient;
f0722dd2
TC
596 require BSE::ComposeMail;
597 my $mailer = BSE::ComposeMail->new(cfg => BSE::Cfg->single);
598 require BSE::Util::Tags;
f0722dd2
TC
599 my %acts =
600 (
601 BSE::Util::Tags->mail_tags(),
8d8895b4 602 $self->mail_tags,
f0722dd2 603 );
c4f18087 604 my %opts =
f0722dd2
TC
605 (
606 to => $to,
607 subject => "Your order has shipped",
608 template => "email/ordershipped",
609 acts => \%acts,
68d44fe0 610 log_msg => "Notify customer that Order No. " . $self->id . " has shipped",
f0722dd2
TC
611 log_object => $self,
612 log_component => "shopadmin:orders:saveorder",
613 );
c4f18087
TC
614 if ($self->emailAddress && $self->billEmail
615 && lc $self->emailAddress ne $self->billEmail) {
616 $opts{cc} = $self->billEmail;
617 }
618
619 $mailer->send(%opts);
f0722dd2
TC
620}
621
622sub new_stage {
623 my ($self, $who, $stage, $stage_note) = @_;
624
625 unless ($stage ne $self->stage
626 || defined $stage_note && $stage_note =~ /\S/) {
627 return;
628 }
629
630 my $old_stage = $self->stage;
68d44fe0 631 my $msg = "Set Order No. ". $self->id . " stage to '$stage'";
f0722dd2
TC
632 if (defined $stage_note && $stage_note =~ /\S/) {
633 $msg .= ": $stage_note";
634 }
635 require BSE::TB::AuditLog;
636 BSE::TB::AuditLog->log
637 (
638 component => "shopadmin:orders:saveorder",
639 object => $self,
640 msg => $msg,
d9c45dcc 641 level => "notice",
f0722dd2
TC
642 actor => $who || "U"
643 );
644
645 if ($stage ne $old_stage) {
646 $self->set_stage($stage);
647 if ($stage eq "shipped") {
4b9daeca
TC
648 if (!$self->filled) {
649 require BSE::Util::SQL;
650
651 $self->set_whoFilled($who ? $who->logon : "-unknown-");
652 $self->set_whenFilled(BSE::Util::SQL::now_datetime());
653 }
f0722dd2
TC
654 $self->send_shipped_email();
655 $self->set_filled(1);
656 }
657 else {
658 $self->set_filled(0);
659 }
660 }
661}
662
6abd8ce8
TC
663sub set_ccPANTruncate {
664 my ($self, $pan) = @_;
665
666 if (length $pan > 4) {
667 $pan = substr($pan, -4);
668 }
669
670 $self->set_ccPAN($pan);
671}
672
b62cae00
TC
673=item is_manually_paid
674
675Returns true if the order is marked as manually paid, either through
676the older PAYMENT_MANUAL paymentType value or via the newer flag.
677
678=cut
679
680sub is_manually_paid {
681 my ($self) = @_;
682
683 return $self->paidFor &&
684 ($self->paid_manually || $self->paymentType == PAYMENT_MANUAL);
685}
686
91a02f51
TC
687=item coupon_valid
688
689For compatibility with cart objects, returns true if the currently
690stored coupon is valid.
691
692Since only an active coupon is stored, if we have a coupon code, then
693it's valid.
694
695=cut
696
697sub coupon_valid {
698 my ($self) = @_;
699
700 return $self->coupon_code ne "";
701}
702
703=item coupon_active
704
705For compatibility with cart objects, returns true if the currently
706stored coupon is active.
707
708Since only an active coupon is stored, if we have a coupon code, then
709it's valid.
710
711=cut
712
713*coupon_active = \&coupon_valid;
714
715=item total_cost
716
717Return the total cost of products without the coupon discount applied.
718
719=cut
720
721sub total_cost {
722 my ($self) = @_;
723
724 my $total = 0;
725 for my $item ($self->items) {
726 $total += $item->extended("price");
727 }
728
729 return $total;
730}
731
732=item discounted_product_cost
733
734Return the total cost of products less the discount from the coupon
735code.
736
737=cut
738
739sub discounted_product_cost {
740 my ($self) = @_;
741
742 my $cost = $self->total_cost;
743
744 $cost -= $cost * $self->coupon_code_discount_pc / 100;
745
746 return int($cost);
747}
748
749=item product_cost_discount
750
751Return any amount taken off the product cost.
752
753=cut
754
755sub product_cost_discount {
756 my ($self) = @_;
757
758 return $self->total_cost - $self->discounted_product_cost;
759}
760
0ec4ac8a 7611;