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