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