fix parsing of link aliases in doclink[]
[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
4b9daeca 9our $VERSION = "1.015";
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
6abd8ce8 31 paypal_token paypal_tran_id freight_tracking stage ccPAN/;
f0722dd2
TC
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",
6abd8ce8 98 ccPAN => "",
14604ada
TC
99 );
100}
101
102sub address_columns {
103 return qw/
104 delivFirstName delivLastName delivStreet delivSuburb delivState
105 delivPostCode delivCountry
106 billFirstName billLastName billStreet billSuburb billState
107 billPostCode billCountry
108 telephone facsimile emailAddress
109 instructions billTelephone billFacsimile billEmail
110 delivMobile billMobile
111 delivOrganization billOrganization
112 delivStreet2 billStreet2/;
113}
114
115sub user_columns {
116 return qw/userId siteuser_id/;
117}
118
119sub payment_columns {
120 return qw/ccNumberHash ccName ccExpiryHash ccType
121 paidFor paymentReceipt paymentType
122 ccOnline ccSuccess ccReceipt ccStatus ccStatusText
123 ccStatus2 ccTranId/;
124}
125
c4f18087
TC
126=item billing_to_delivery_map
127
128Return a hashref where the key is a billing field and the value is the
129corresponding delivery field.
130
131=cut
132
133{
134 my %billing_to_delivery =
135 (
136 billEmail => "emailAddress",
137 billFirstName => "delivFirstName",
138 billLastName => "delivLastName",
139 billStreet => "delivStreet",
140 billStreet2 => "delivStreet2",
141 billSuburb => "delivSuburb",
142 billState => "delivState",
143 billPostCode => "delivPostCode",
144 billCountry => "delivCountry",
145 billTelephone => "telephone",
a964e89d 146 billMobile => "delivMobile",
c4f18087
TC
147 billFacsimile => "facsimile",
148 billOrganization => "delivOrganization",
149 );
150
151 sub billing_to_delivery_map {
152 return \%billing_to_delivery;
153 }
154}
155
0ec4ac8a
TC
156=item siteuser
157
158returns the SiteUser object of the user who made this order.
159
160=cut
161
162sub siteuser {
163 my ($self) = @_;
164
f0722dd2
TC
165 if ($self->siteuser_id) {
166 require SiteUsers;
167 my $user = SiteUsers->getByPkey($self->siteuser_id);
168 $user and return $user;
169 }
170
0ec4ac8a
TC
171 $self->{userId} or return;
172
173 require SiteUsers;
174
175 return ( SiteUsers->getBy(userId=>$self->{userId}) )[0];
176}
177
178sub items {
179 my ($self) = @_;
180
181 require BSE::TB::OrderItems;
182 return BSE::TB::OrderItems->getBy(orderId => $self->{id});
183}
184
ab2cd916
TC
185sub files {
186 my ($self) = @_;
187
7c6f563b
TC
188 require BSE::TB::ArticleFiles;
189 return BSE::TB::ArticleFiles->getSpecial(orderFiles=>$self->{id});
ab2cd916
TC
190}
191
eb9d306d
TC
192sub paid_files {
193 my ($self) = @_;
194
195 $self->paidFor
196 or return;
197
198 require BSE::TB::ArticleFiles;
199 return BSE::TB::ArticleFiles->getSpecial(orderPaidFor => $self->id);
200}
201
ab2cd916
TC
202sub products {
203 my ($self) = @_;
204
205 require Products;
206 Products->getSpecial(orderProducts=>$self->{id});
207}
208
41e7c841
TC
209sub valid_fields {
210 my ($class, $cfg) = @_;
211
212 my %fields =
213 (
b27af108 214 delivFirstName => { description=>'Delivery First Name',
37dd20ad 215 rules=>'dh_one_line' },
b27af108 216 delivLastName => { description => 'Delivery Last Name',
37dd20ad 217 rules=>'dh_one_line' },
b27af108 218 delivOrganization => { description => 'Delivery Organization',
37dd20ad 219 rules=>'dh_one_line' },
b27af108 220 delivStreet => { description => 'Delivery Street',
37dd20ad 221 rules=>'dh_one_line' },
b27af108 222 delivStreet2 => { description => 'Delivery Street 2',
37dd20ad 223 rules=>'dh_one_line' },
b27af108 224 delivState => { description => 'Delivery State',
37dd20ad 225 rules=>'dh_one_line' },
b27af108 226 delivSuburb => { description => 'Delivery Suburb',
37dd20ad 227 rules=>'dh_one_line' },
b27af108 228 delivPostCode => { description => 'Delivery Post Code',
9074efa2 229 rules=>'dh_one_line;dh_int_postcode' },
b27af108 230 delivCountry => { description => 'Delivery Country',
37dd20ad 231 rules=>'dh_one_line' },
b27af108 232 billFirstName => { description => 'Billing First Name',
37dd20ad 233 rules=>'dh_one_line' },
b27af108 234 billLastName => { description => 'Billing Last Name',
37dd20ad 235 rules=>'dh_one_line' },
b27af108 236 billOrganization => { description => 'Billing Organization',
37dd20ad 237 rules=>'dh_one_line' },
b27af108 238 billStreet => { description => 'Billing Street',
37dd20ad 239 rules=>'dh_one_line' },
b27af108 240 billStreet2 => { description => 'Billing Street 2',
37dd20ad 241 rules=>'dh_one_line' },
b27af108 242 billSuburb => { description => 'Billing Suburb',
37dd20ad 243 rules=>'dh_one_line' },
b27af108 244 billState => { description => 'Billing State',
37dd20ad 245 rules=>'dh_one_line' },
b27af108 246 billPostCode => { description => 'Billing Post Code',
9074efa2 247 rules=>'dh_one_line;dh_int_postcode' },
b27af108 248 billCountry => { description => 'Billing First Name',
37dd20ad 249 rules=>'dh_one_line' },
41e7c841
TC
250 telephone => { description => 'Telephone Number',
251 rules => "phone" },
252 facsimile => { description => 'Facsimile Number',
253 rules => 'phone' },
254 emailAddress => { description => 'Email Address',
c4f18087 255 rules=>'email' },
41e7c841 256 instructions => { description => 'Instructions' },
b27af108 257 billTelephone => { description => 'Billing Telephone Number',
41e7c841
TC
258 rules=>'phone' },
259 billFacsimile => { description => 'Billing Facsimile Number',
260 rules=>'phone' },
261 billEmail => { description => 'Billing Email Address',
c4f18087 262 rules => 'email;required' },
41e7c841
TC
263 delivMobile => { description => 'Delivery Mobile Number',
264 rules => 'phone' },
265 billMobile => { description => 'Billing Mobile Number',
266 rules=>'phone' },
267 instructions => { description => 'Instructions' },
74b21f6d 268 purchase_order => { description => 'Purchase Order No' },
d8674b8b
AMS
269 shipping_cost => { description => 'Shipping charges' },
270 shipping_method => { description => 'Shipping method' },
41e7c841
TC
271 );
272
273 for my $field (keys %fields) {
274 my $display = $cfg->entry('shop', "display_$field");
275 $display and $fields{$field}{description} = $display;
276 }
277
278 return %fields;
279}
280
281sub valid_rules {
282 my ($class, $cfg) = @_;
283
284 return;
285}
286
287sub valid_payment_fields {
288 my ($class, $cfg) = @_;
289
290 my %fields =
291 (
b27af108
TC
292 cardNumber =>
293 {
41e7c841
TC
294 description => "Credit Card Number",
295 rules=>"creditcardnumber",
296 },
b27af108 297 cardExpiry =>
41e7c841
TC
298 {
299 description => "Credit Card Expiry Date",
300 rules => 'creditcardexpirysingle',
301 },
6abd8ce8 302 ccName => { description => "Credit Card Holder" },
1546e1f0 303 ccType => { description => "Credit Card Type" },
b27af108
TC
304 cardVerify =>
305 {
41e7c841
TC
306 description => 'Card Verification Value',
307 rules => 'creditcardcvv',
308 },
309 );
310
311 for my $field (keys %fields) {
312 my $display = $cfg->entry('shop', "display_$field");
313 $display and $fields{$field}{description} = $display;
314 }
315
316 return %fields;
317}
318
319sub valid_payment_rules {
320 return;
321}
322
5d88571c
TC
323sub clear_items {
324 my ($self) = @_;
325
326 confess "Attempt to clear items on completed order $self->{id}"
327 if $self->{complete};
b27af108 328
5d88571c
TC
329 BSE::DB->run(deleteOrdersItems => $self->{id});
330}
331
14604ada
TC
332sub add_item {
333 my ($self, %opts) = @_;
334
335 my $prod = delete $opts{product}
336 or confess "Missing product option";
337 my $units = delete $opts{units} || 1;
338
339 my $options = '';
340 my @dboptions;
341 if ($opts{options}) {
342 if (ref $opts{options}) {
343 @dboptions = @{delete $opts{options}};
344 }
345 else {
346 $options = delete $opts{options};
347 }
348 }
b27af108 349
14604ada
TC
350 require BSE::TB::OrderItems;
351 my %item =
352 (
353 productId => $prod->id,
354 orderId => $self->id,
355 units => $units,
356 price => $prod->retailPrice,
357 options => $options,
358 max_lapsed => 0,
359 session_id => 0,
360 ( map { $_ => $prod->{$_} }
361 qw/wholesalePrice gst customInt1 customInt2 customInt3 customStr1 customStr2 customStr3 title description subscription_id subscription_period product_code/
362 ),
363 );
364
365 $self->set_total($self->total + $prod->retailPrice * $units);
366
367 return BSE::TB::OrderItems->make(%item);
368}
369
13a986ee
TC
370sub deliv_country_code {
371 my ($self) = @_;
372
373 my $use_codes = BSE::Cfg->single->entry("shop", "country_code", 0);
374 if ($use_codes) {
375 return $self->delivCountry;
376 }
377 else {
378 require BSE::Countries;
379 return BSE::Countries::bse_country_code($self->delivCountry);
380 }
381}
382
f0722dd2
TC
383=item stage
384
385Return the order stage.
386
387If the stage is empty, guess from the order flags.
388
389=cut
390
391sub stage {
392 my ($self) = @_;
393
394 if ($self->{stage} ne "") {
395 return $self->{stage};
396 }
397
398 if (!$self->complete) {
399 return "incomplete";
400 }
401 elsif ($self->filled) {
402 return "shipped";
403 }
404 else {
405 return "unprocessed";
406 }
407}
408
409sub stage_description {
410 my ($self, $lang) = @_;
411
412 return BSE::TB::Orders->stage_label($self->stage, $lang);
413}
414
f55be9df
TC
415sub stage_description_id {
416 my ($self) = @_;
417
418 return BSE::TB::Orders->stage_label_id($self->stage);
419}
420
c4f18087 421=item delivery_mail_recipient
f0722dd2 422
c4f18087
TC
423Return a value suitable for BSE::ComposeMail's to parameter for the
424shipping email address.
f0722dd2
TC
425
426=cut
427
c4f18087 428sub delivery_mail_recipient {
f0722dd2
TC
429 my ($self) = @_;
430
431 my $user = $self->siteuser;
c4f18087 432 my $email = $self->emailAddress || $self->billEmail;
f0722dd2 433
c4f18087 434 if ($user && $user->email eq $email) {
f0722dd2
TC
435 return $user;
436 }
437
c4f18087 438 return $email;
f0722dd2
TC
439}
440
768dccf0 441=item _tags
8d8895b4 442
768dccf0 443Internal method with the common code between tags() and mail_tags().
8d8895b4
TC
444
445=cut
446
768dccf0
TC
447sub _tags {
448 my ($self, $escape) = @_;
8d8895b4
TC
449
450 require BSE::Util::Tags;
8d8895b4 451 require BSE::TB::OrderItems;
768dccf0
TC
452 require BSE::Util::Iterate;
453 my $it;
454 my $art;
455 my $esc;
456 my $obj;
457 if ($escape) {
458 require BSE::Util::HTML;
459 $it = BSE::Util::Iterate::Objects->new;
460 $art = \&BSE::Util::Tags::tag_article;
461 $obj = \&BSE::Util::Tags::tag_object;
462 $esc = \&BSE::Util::HTML::escape_html;
463 }
464 else {
465 $it = BSE::Util::Iterate::Objects::Text->new;
466 $art = \&BSE::Util::Tags::tag_article_plain;
467 $obj = \&BSE::Util::Tags::tag_object_plain;
468 $esc = sub { return $_[0] };
469 }
470
471 my $cfg = BSE::Cfg->single;
472 my $must_be_paid = $cfg->entryBool('downloads', 'must_be_paid', 0);
473 my $must_be_filled = $cfg->entryBool('downloads', 'must_be_filled', 0);
474
8d8895b4
TC
475 my %item_cols = map { $_ => 1 } BSE::TB::OrderItem->columns;
476 my %products;
477 my $current_item;
768dccf0 478 my $current_file;
8d8895b4
TC
479 return
480 (
768dccf0 481 order => [ $obj, $self ],
8d8895b4
TC
482 $it->make
483 (
484 single => "item",
485 plural => "items",
486 code => [ items => $self ],
487 store => \$current_item,
488 ),
489 extended => sub {
490 my ($args) = @_;
491
492 $current_item
493 or return '* only usable in items iterator *';
494
495 $item_cols{$args}
496 or return "* unknown item column $args *";
497
498 return $current_item->$args() * $current_item->units;
499 },
500 $it->make
501 (
502 single => "option",
503 plural => "options",
504 code => sub {
505 $current_item
506 or return;
507 return $current_item->option_hashes
508 },
509 nocache => 1,
510 ),
511 options => sub {
512 $current_item
513 or return '* only in the items iterator *';
768dccf0 514 return $esc->($current_item->nice_options);
8d8895b4
TC
515 },
516 product => sub {
517 $current_item
518 or return '* only usable in items *';
519
520 require Products;
521 my $id = $current_item->productId;
522 $products{$id} ||= Products->getByPkey($id);
523
524 my $product = $products{$id}
525 or return '';
526
768dccf0
TC
527 return $art->($product, $cfg, $_[0]);
528 },
7c6f563b 529 $it->make
768dccf0
TC
530 (
531 single => 'orderfile',
532 plural => 'orderfiles',
533 code => [ files => $self ],
534 store => \$current_file,
535 ),
7c6f563b 536 $it->make
768dccf0
TC
537 (
538 single => "prodfile",
539 plural => "prodfiles",
540 code => sub {
541 $current_item
542 or return '* only usable in items *';
543
544 require Products;
545 my $id = $current_item->productId;
546 $products{$id} ||= Products->getByPkey($id);
547
548 my $product = $products{$id}
549 or return '';
550
551 return $product->files;
552 },
553 store => \$current_file,
554 ),
555 ifFileAvail => sub {
556 $current_file or return 0;
557 $current_file->{forSale} or return 1;
558
559 return 0 if $must_be_paid && !$self->{paidFor};
560 return 0 if $must_be_filled && !$self->{filled};
561
562 return 1;
8d8895b4
TC
563 },
564 );
565}
566
768dccf0
TC
567=item mail_tags
568
569=cut
570
571sub mail_tags {
572 my ($self) = @_;
573
574 return $self->_tags(0);
575}
576
577=item tags
578
579Return template tags suitable for an order (non-mail)
580
581=cut
582
583sub tags {
584 my ($self) = @_;
585
586 return $self->_tags(1);
587}
588
f0722dd2
TC
589sub send_shipped_email {
590 my ($self) = @_;
591
c4f18087 592 my $to = $self->delivery_mail_recipient;
f0722dd2
TC
593 require BSE::ComposeMail;
594 my $mailer = BSE::ComposeMail->new(cfg => BSE::Cfg->single);
595 require BSE::Util::Tags;
f0722dd2
TC
596 my %acts =
597 (
598 BSE::Util::Tags->mail_tags(),
8d8895b4 599 $self->mail_tags,
f0722dd2 600 );
c4f18087 601 my %opts =
f0722dd2
TC
602 (
603 to => $to,
604 subject => "Your order has shipped",
605 template => "email/ordershipped",
606 acts => \%acts,
607 log_msg => "Notify customer order has shipped",
608 log_object => $self,
609 log_component => "shopadmin:orders:saveorder",
610 );
c4f18087
TC
611 if ($self->emailAddress && $self->billEmail
612 && lc $self->emailAddress ne $self->billEmail) {
613 $opts{cc} = $self->billEmail;
614 }
615
616 $mailer->send(%opts);
f0722dd2
TC
617}
618
619sub new_stage {
620 my ($self, $who, $stage, $stage_note) = @_;
621
622 unless ($stage ne $self->stage
623 || defined $stage_note && $stage_note =~ /\S/) {
624 return;
625 }
626
627 my $old_stage = $self->stage;
628 my $msg = "Set to stage '$stage'";
629 if (defined $stage_note && $stage_note =~ /\S/) {
630 $msg .= ": $stage_note";
631 }
632 require BSE::TB::AuditLog;
633 BSE::TB::AuditLog->log
634 (
635 component => "shopadmin:orders:saveorder",
636 object => $self,
637 msg => $msg,
638 level => "info",
639 actor => $who || "U"
640 );
641
642 if ($stage ne $old_stage) {
643 $self->set_stage($stage);
644 if ($stage eq "shipped") {
4b9daeca
TC
645 if (!$self->filled) {
646 require BSE::Util::SQL;
647
648 $self->set_whoFilled($who ? $who->logon : "-unknown-");
649 $self->set_whenFilled(BSE::Util::SQL::now_datetime());
650 }
f0722dd2
TC
651 $self->send_shipped_email();
652 $self->set_filled(1);
653 }
654 else {
655 $self->set_filled(0);
656 }
657 }
658}
659
6abd8ce8
TC
660sub set_ccPANTruncate {
661 my ($self, $pan) = @_;
662
663 if (length $pan > 4) {
664 $pan = substr($pan, -4);
665 }
666
667 $self->set_ccPAN($pan);
668}
669
0ec4ac8a 6701;