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