initialize address fields from the user when calculating shipping costs
[bse.git] / site / cgi-bin / modules / SiteUser.pm
CommitLineData
589b789c
TC
1package SiteUser;
2use strict;
3# represents a registered user
4use Squirrel::Row;
5use vars qw/@ISA/;
6@ISA = qw/Squirrel::Row/;
9063386f 7use Constants qw($SHOP_FROM);
a0edb02e 8use Carp qw(confess);
9d576c12 9use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date sql_add_date_days/;
9063386f 10
93be4a7b 11our $VERSION = "1.006";
cb7fd78d 12
9063386f
TC
13use constant MAX_UNACKED_CONF_MSGS => 3;
14use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
32696f84 15use constant OWNER_TYPE => "U";
589b789c
TC
16
17sub columns {
18 return qw/id userId password email keepAddress whenRegistered lastLogon
19 name1 name2 address city state postcode telephone facsimile
b19047a6
TC
20 country wantLetter confirmed confirmSecret waitingForConfirmation
21 textOnlyMail title organization referral otherReferral
9063386f
TC
22 prompt otherPrompt profession otherProfession previousLogon
23 billFirstName billLastName billStreet billSuburb billState
24 billPostCode billCountry instructions billTelephone billFacsimile
4175638b
TC
25 billEmail adminNotes disabled flags
26 customText1 customText2 customText3
dfdeb4fe 27 customStr1 customStr2 customStr3
37dd20ad
TC
28 affiliate_name delivMobile billMobile
29 delivStreet2 billStreet2
288ef5b8 30 billOrganization
93be4a7b
TC
31 customInt1 customInt2 password_type
32 lost_today lost_date lost_id/;
b19047a6
TC
33}
34
a0edb02e
TC
35sub table {
36 return "site_users";
37}
38
5899bc52
TC
39sub defaults {
40 require BSE::Util::SQL;
41 return
42 (
43 keepAddress => 1, # what am I for - appears unused
44 whenRegistered => BSE::Util::SQL::now_datetime(),
45 lastLogon => BSE::Util::SQL::now_datetime(),
46 name1 => "",
47 name2 => "",
48 address => "",
49 city => "",
50 state => "",
51 postcode => "",
52 telephone => "",
53 facsimile => "",
54 country => "",
55 wantLetter => 0, # also unused
56 confirmed => 0,
57 confirmSecret => "",
58 waitingForConfirmation => 0,
59 textOnlyMail => 0,
60 title => "",
61 organization => "",
62 referral => 0,
63 otherReferral => "",
64 prompt => 0,
65 otherPrompt => "",
66 profession => 0,
67 otherProfession => "",
68 previousLogon => BSE::Util::SQL::now_datetime(),
69 billFirstName => "",
70 billLastName => "",
71 billStreet => "",
72 billSuburb => "",
73 billState => "",
74 billPostCode => "",
75 billCountry => "",
76 instructions => "",
77 billTelephone => "",
78 billFacsimile => "",
79 billEmail => "",
80 adminNotes => "",
81 disabled => 0,
82 flags => "",
83 customText1 => undef,
84 customText2 => undef,
85 customText3 => undef,
86 customStr1 => undef,
87 customStr2 => undef,
88 customStr3 => undef,
89 affiliate_name => "",
90 delivMobile => "",
91 billMobile => "",
92 delivStreet2 => "",
93 billStreet2 => "",
94 billOrganization => "",
95 customInt1 => "",
96 customInt2 => "",
93be4a7b
TC
97 #password_type,
98 lost_today => 0,
99 lost_date => undef,
100 lost_id => undef,
5899bc52
TC
101 );
102}
103
829c9ed9
TC
104sub valid_fields {
105 my ($class, $cfg, $admin) = @_;
106
107 my %fields =
108 (
4c4d3c3f 109 email => { rules=>'email', description=>'Email Address',
829c9ed9
TC
110 maxlen => 255},
111 name1 => { description=>'First Name', rules=>"dh_one_line", maxlen=>127 },
112 name2 => { description=>'Surname', rules=>"dh_one_line", maxlen=>127 },
113 address => { description => 'Address', rules=>"dh_one_line", maxlen=>127 },
114 city => { description=>'City/Suburb', rules=>"dh_one_line", maxlen=>127 },
115 state => { description => 'State', rules=>"dh_one_line", maxlen=>40 },
116 postcode => { rules=>'postcode', description=>'Post Code', maxlen=>40 },
117 telephone => { rules=>'phone', description=>'Telephone', maxlen=>80 },
118 facsimile => { rules=>'phone', description=>'Facsimile', maxlen=>80 },
119 country => { description=>'Country', rules=>"dh_one_line", maxlen=>127 },
120 title => { description=>'Title', rules=>"dh_one_line", maxlen=>127 },
121 organization => { description=>'Organization', rules=>"dh_one_line",
122 maxlen=>127 },
e3d242f7
TC
123 delivMobile => { description => "Mobile", rules=>"phone",
124 maxlen => 80 },
37dd20ad
TC
125 delivStreet2 => { description => 'Address2', rules => "dh_one_line",
126 maxlen=> 127 },
829c9ed9
TC
127 textOnlyEmail => { description => "Text Only Email", type=>"boolean" },
128 referral => { description=>'Referral', rules=>"natural" },
129 otherReferral => { description=>'Other Referral', rules=>"dh_one_line",
130 maxlen=>127},
131 prompt => { description=>'Prompt', rules=>"natural" },
132 otherPrompt => { description => 'Other Prompt', rules=>"dh_one_line",
133 maxlen=>127 },
134 profession => { description => 'Profession', rules=>"natural" },
135 otherProfession => { description=>'Other Profession',
136 rules=>"dh_one_line", maxlen=>127 },
137 billFirstName => { description=>"Billing First Name",
138 rules=>"dh_one_line", maxlen=>127 },
139 billLastName => { descriptin=>"Billing Last Name", rules=>"dh_one_line" },
140 billStreet => { description => "Billing Street Address",
141 rules=>"dh_one_line", maxlen=>127 },
37dd20ad
TC
142 billStreet2 => { description => 'Billing Street Address 2',
143 rules => "dh_one_line", maxlen=> 127 },
829c9ed9
TC
144 billSuburb => { description => "Billing Suburb", rules=>"dh_one_line",
145 maxlen=>127 },
146 billState => { description => "Billing State", rules=>"dh_one_line",
147 maxlen=>40 },
148 billPostCode => { description => "Billing Post Code", rules=>"postcode",
149 maxlen=>40 },
150 billCountry => { description => "Billing Country", rules=>"dh_one_line",
151 maxlen=>127 },
152 instructions => { description => "Delivery Instructions" },
153 billTelephone => { description => "Billing Phone", rules=>"phone",
154 maxlen=>80 },
155 billFacsimile => { description => "Billing Facsimie", rules=>"phone",
156 maxlen=>80 },
157 billEmail => { description => "Billing Email", rules=>"email",
158 maxlen=>255 },
e3d242f7
TC
159 billMobile => { description => "Billing Mobile", rules=>"phone",
160 maxlen => 80 },
37dd20ad
TC
161 billOrganization => { description => "Billing Organization",
162 rules=>"dh_one_line", maxlen => 127 },
829c9ed9
TC
163 customText1 => { description => "Custom Text 1" },
164 customText2 => { description => "Custom Text 2" },
165 customText3 => { description => "Custom Text 3" },
166 customStr1 => { description => "Custom String 1", rules=>"dh_one_line",
167 maxlen=>255 },
168 customStr2 => { description => "Custom String 2", rules=>"dh_one_line",
169 maxlen=>255 },
170 customStr3 => { description => "Custom String 3", rules=>"dh_one_line",
171 maxlen=>255 },
172 );
173
174 if ($admin) {
175 $fields{adminNotes} =
176 { description => "Administrator Notes" };
177 $fields{disabled} =
178 { description => "User Disabled", type=>"boolean" };
179 }
180
829c9ed9
TC
181 return %fields;
182}
183
184sub valid_rules {
185 return;
186}
187
b19047a6
TC
188sub removeSubscriptions {
189 my ($self) = @_;
190
191 SiteUsers->doSpecial('removeSubscriptions', $self->{id});
589b789c
TC
192}
193
531fb3bc
TC
194sub removeSubscription {
195 my ($self, $subid) = @_;
196
197 SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
198}
199
9063386f
TC
200sub generic_email {
201 my ($class, $checkemail) = @_;
202
203 # Build a generic form for the email - since an attacker could
204 # include comments or extra spaces or a bunch of other stuff.
205 # this isn't strictly correct, but it's good enough
206 1 while $checkemail =~ s/\([^)]\)//g;
207 if ($checkemail =~ /<([^>]+)>/) {
208 $checkemail = $1;
209 }
210 $checkemail = lc $checkemail;
211 $checkemail =~ s/\s+//g;
212
213 $checkemail;
214}
215
216sub subscriptions {
217 my ($self) = @_;
218
219 require BSE::SubscriptionTypes;
220 return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
221}
222
223sub send_conf_request {
224 my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
6a8a6ac5
TC
225
226 if ($user->is_disabled) {
227 $$rmsg = "User is disabled";
228 return;
229 }
9063386f
TC
230
231 my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
232
233 # check for existing in-progress confirmations
234 my $checkemail = $user->generic_email($user->{email});
235
236 # check the blacklist
237 require BSE::EmailBlacklist;
238
239 # check that the from address has been configured
240 my $from = $cfg->entry('confirmations', 'from') ||
241 $cfg->entry('basic', 'emailfrom')|| $SHOP_FROM;
242 unless ($from) {
243 $$rcode = 'config';
244 $$rmsg = "Configuration Error: The confirmations from address has not been configured";
245 return;
246 }
247
248 my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
249
250 if ($blackentry) {
251 $$rcode = "blacklist";
252 $$rmsg = $blackentry->{why};
253 return;
254 }
255
256 unless ($user->{confirmSecret}) {
257 use BSE::Util::Secure qw/make_secret/;
258 # print STDERR "Generating secret\n";
259 $user->{confirmSecret} = make_secret($cfg);
260 $user->save;
261 }
262
263 # check for existing confirmations
220c179a 264 require BSE::EmailRequests;
9063386f
TC
265 my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
266 if ($confirm) {
267 if ($confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS) {
268 $$rcode = 'toomany';
269 $$rmsg = "Too many confirmations have been sent to this email address";
270 return;
271 }
272 use BSE::Util::SQL qw/sql_datetime_to_epoch/;
273 my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
274 if ($lastSentEpoch + MIN_UNACKED_CONF_GAP > time) {
275 $$rcode = 'toosoon';
276 $$rmsg = "The last confirmation was sent too recently, please wait before trying again";
277 return;
278 }
279 }
280 else {
281 my %confirm;
282 my @cols = BSE::EmailRequest->columns;
283 shift @cols;
284 $confirm{email} = $user->{email};
285 $confirm{genEmail} = $checkemail;
286 # prevents silliness on error
287 use BSE::Util::SQL qw(sql_datetime);
288 $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
289 $confirm{unackedConfMsgs} = 0;
290 $confirm = BSE::EmailRequests->add(@confirm{@cols});
291 }
292
293 # ok, now we can send the confirmation request
294 my %confacts;
295 %confacts =
296 (
297 BSE::Util::Tags->basic(\%confacts, $cgi, $cfg),
298 user => sub { $user->{$_[0]} },
299 confirm => sub { $confirm->{$_[0]} },
300 remote_addr => sub { $ENV{REMOTE_ADDR} },
301 );
302 my $email_template =
303 $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
304 my $body = BSE::Template->get_page($email_template, $cfg, \%confacts);
220c179a
TC
305
306 require BSE::Mail;
9063386f
TC
307 my $mail = BSE::Mail->new(cfg=>$cfg);
308 my $subject = $cfg->entry('confirmations', 'subject')
309 || 'Subscription Confirmation';
310 unless ($mail->send(from=>$from, to=>$user->{email}, subject=>$subject,
311 body=>$body)) {
312 # a problem sending the mail
313 $$rcode = "mail";
314 $$rmsg = $mail->errstr;
315 return;
316 }
317 ++$confirm->{unackedConfMsgs};
318 $confirm->{lastConfSent} = now_datetime;
319 $confirm->save;
320
321 return 1;
322}
323
6a8a205a
TC
324sub orders {
325 my ($self) = @_;
326
3c32512d 327 require BSE::TB::Orders;
6a8a205a 328
3c32512d 329 return BSE::TB::Orders->getBy(userId => $self->{userId});
6a8a205a
TC
330}
331
af74f0b4
TC
332sub _user_sub_entry {
333 my ($self, $sub) = @_;
334
335 my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id},
336 $sub->{subscription_id})
337 or return;
338
339 return $entry;
340}
341
0ec4ac8a
TC
342# check if the user is subscribed to the given subscription
343sub subscribed_to {
344 my ($self, $sub) = @_;
345
af74f0b4
TC
346 my $entry = $self->_user_sub_entry($sub)
347 or return;
348
349 my $today = now_sqldate;
829c9ed9 350 my $end_date = sql_normal_date($entry->{ends_at});
af74f0b4 351 return $today le $end_date;
0ec4ac8a
TC
352}
353
354# check if the user is subscribed to the given subscription, and allow
355# for the max_lapsed grace period
356sub subscribed_to_grace {
357 my ($self, $sub) = @_;
358
af74f0b4
TC
359 my $entry = $self->_user_sub_entry($sub)
360 or return;
361
362 my $today = now_sqldate;
9d576c12 363 my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed});
af74f0b4 364 return $today le $end_date;
0ec4ac8a
TC
365}
366
dfdeb4fe
TC
367my @image_cols =
368 qw(siteuser_id image_id filename width height bytes content_type alt);
369
370sub images_cfg {
371 my ($self, $cfg) = @_;
372
373 my @images;
374 my %ids = $cfg->entries('BSE Siteuser Images');
375 for my $id (keys %ids) {
376 my %image = ( id => $id );
377
378 my $sect = "BSE Siteuser Image $id";
379 for my $key (qw(description help minwidth minheight maxwidth maxheight
380 minratio maxratio properror
381 widthsmallerror heightsmallerror smallerror
382 widthlargeerror heightlargeerror largeerror
383 maxspace spaceerror)) {
384 my $value = $cfg->entry($sect, $key);
385 if (defined $value) {
386 $image{$key} = $value;
387 }
388 }
389 push @images, \%image;
390 }
391
392 @images;
393}
394
395sub images {
396 my ($self) = @_;
397
398 BSE::DB->query(getBSESiteuserImages => $self->{id});
399}
400
401sub get_image {
402 my ($self, $id) = @_;
403
404 my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id)
405 or return;
406
407 $image;
408}
409
410sub set_image {
411 my ($self, $cfg, $id, $image) = @_;
412
413 my %image = %$image;
414 $image{siteuser_id} = $self->{id};
415 my $old = $self->get_image($id);
416
417 if ($old) {
418 # replace it
419 BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols});
420
421 # lose the old file
422 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
423 unlink "$image_dir/$old->{filename}";
424 }
425 else {
426 # add it
427 # replace it
428 BSE::DB->run(addBSESiteuserImage => @image{@image_cols});
429 }
430}
431
432sub remove_image {
433 my ($self, $cfg, $id) = @_;
434
435 if (my $old = $self->get_image($id)) {
436 # remove the entry
437 BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id);
438
439 # lose the old file
440 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
441 unlink "$image_dir/$old->{filename}";
442 }
443}
444
af74f0b4
TC
445sub recalculate_subscriptions {
446 my ($self, $cfg) = @_;
447
448 require BSE::TB::Subscriptions;
449 my @subs = BSE::TB::Subscriptions->all;
450 for my $sub (@subs) {
451 $sub->update_user_expiry($self, $cfg);
452 }
453}
dfdeb4fe 454
9d576c12
TC
455sub subscribed_services {
456 my ($self) = @_;
457
458 BSE::DB->query(siteuserSubscriptions => $self->{id});
459}
460
6a8a6ac5
TC
461sub is_disabled {
462 my ($self) = @_;
463
464 return $self->{disabled};
465}
466
718a070d
TC
467sub seminar_sessions_booked {
468 my ($self, $seminar_id) = @_;
469
470 return map $_->{session_id},
471 BSE::DB->query(userSeminarSessionBookings => $seminar_id, $self->{id});
472}
473
efcc5a30
TC
474sub is_member_of {
475 my ($self, $group) = @_;
476
477 my $group_id = ref $group ? $group->{id} : $group;
478
479 my @result = BSE::DB->query(siteuserMemberOfGroup => $self->{id}, $group_id);
480
481 return scalar(@result);
482}
483
484sub group_ids {
485 my ($self) = @_;
486
487 map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id});
488}
489
7aa0262a
TC
490sub allow_html_email {
491 my ($self) = @_;
492
493 !$self->{textOnlyMail};
494}
495
2076966c
TC
496sub seminar_bookings_detail {
497 my ($self) = @_;
498
499 BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id});
500}
501
d49667a2
TC
502sub wishlist {
503 my $self = shift;
504 require Products;
505 return Products->getSpecial(userWishlist => $self->{id});
506}
507
508sub wishlist_order {
509 my $self = shift;
510 return BSE::DB->query(bse_userWishlistOrder => $self->{id});
511}
512
513sub product_in_wishlist {
514 my ($self, $product) = @_;
515
516 grep $_->{product_id} == $product->{id}, $self->wishlist_order;
517}
518
519sub add_to_wishlist {
520 my ($self, $product) = @_;
521
522 return
523 eval {
524 BSE::DB->run(bse_addToWishlist => $self->{id}, $product->{id}, time());
525 1;
526 };
527}
528
529sub remove_from_wishlist {
530 my ($self, $product) = @_;
531
532 BSE::DB->run(bse_removeFromWishlist => $self->{id}, $product->{id});
533}
534
535sub _set_wishlist_order {
536 my ($self, $product_id, $display_order) = @_;
537
538 print STDERR "_set_wishlist_order($product_id, $display_order)\n";
539
540 BSE::DB->run(bse_userWishlistReorder => $display_order, $self->{id}, $product_id);
541}
542
543sub _find_in_wishlist {
544 my ($self, $product_id) = @_;
545
546 my @order = $self->wishlist_order;
547
548 my ($index) = grep $order[$_]{product_id} == $product_id, 0 .. $#order
549 or return;
550
551 return \@order, $index;
552}
553
554sub move_to_wishlist_top {
555 my ($self, $product) = @_;
556
557 my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
558 or return;
559 $move_index > 0
560 or return; # nothing to do
561
562 my $top_order = $order->[0]{display_order};
563 for my $index (0 .. $move_index-1) {
564 $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index+1]{display_order});
565 }
566 $self->_set_wishlist_order($product->{id}, $top_order);
567}
568
569sub move_to_wishlist_bottom {
570 my ($self, $product) = @_;
571
572 my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
573 or return;
574 $move_index < $#$order
575 or return; # nothing to do
576
577 my $bottom_order = $order->[-1]{display_order};
578 for my $index (reverse($move_index+1 .. $#$order)) {
579 $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index-1]{display_order});
580 }
581 $self->_set_wishlist_order($product->{id}, $bottom_order);
582}
583
584sub move_down_wishlist {
585 my ($self, $product) = @_;
586
587 my ($order, $index) = $self->_find_in_wishlist($product->{id})
588 or return;
589 $index < $#$order
590 or return; # nothing to do
591
592 $self->_set_wishlist_order($product->{id}, $order->[$index+1]{display_order});
593 $self->_set_wishlist_order($order->[$index+1]{product_id}, $order->[$index]{display_order});
594}
595
596sub move_up_wishlist {
597 my ($self, $product) = @_;
598
599 my ($order, $index) = $self->_find_in_wishlist($product->{id})
600 or return;
601 $index > 0
602 or return; # nothing to do
603
604 $self->_set_wishlist_order($product->{id}, $order->[$index-1]{display_order});
605 $self->_set_wishlist_order($order->[$index-1]{product_id}, $order->[$index]{display_order});
606}
607
32696f84
TC
608# files owned specifically by this user
609sub files {
610 my ($self) = @_;
611
612 require BSE::TB::OwnedFiles;
613 return BSE::TB::OwnedFiles->getBy(owner_type => OWNER_TYPE,
614 owner_id => $self->id);
615}
616
617sub admin_group_files {
618 my ($self) = @_;
619
620 require BSE::TB::OwnedFiles;
621 return BSE::TB::OwnedFiles->getSpecial(userVisibleGroupFiles => $self->{id});
622}
623
624sub query_group_files {
625 my ($self, $cfg) = @_;
626
627 require BSE::TB::SiteUserGroups;
628 return
629 (
630 map $_->files, BSE::TB::SiteUserGroups->query_groups($cfg)
631 );
632}
633
634# files the user can see, both owned and owned by groups
635sub visible_files {
636 my ($self, $cfg) = @_;
637
638 return
639 (
640 $self->files,
641 $self->admin_group_files,
642 $self->query_group_files($cfg)
643 );
644}
645
646sub file_owner_type {
647 return OWNER_TYPE;
648}
649
650sub subscribed_file_categories {
651 my ($self) = @_;
652
653 return map $_->{category}, BSE::DB->query(siteuserSubscribedFileCategories => $self->{id});
654}
655
656sub set_subscribed_file_categories {
657 my ($self, $cfg, @new) = @_;
658
659 require BSE::TB::OwnedFiles;
660 my %current = map { $_ => 1 } $self->subscribed_file_categories;
661 my %new = map { $_ => 1 } @new;
662 my @all = BSE::TB::OwnedFiles->categories($cfg);
663 for my $cat (@all) {
664 if ($new{$cat->{id}} && !$current{$cat->{id}}) {
665 eval {
666 BSE::DB->run(siteuserAddFileCategory => $self->{id}, $cat->{id});
667 }; # a race condition might cause a duplicate key error here
668 }
669 elsif (!$new{$cat->{id}} && $current{$cat->{id}}) {
670 BSE::DB->run(siteuserRemoveFileCategory => $self->{id}, $cat->{id});
671 }
672 }
673}
674
a0edb02e
TC
675=item describe
676
677Returns a description of the user
678
679=cut
680
681sub describe {
682 my ($self) = @_;
683
684 return "Member: " . $self->userId;
685}
686
736c2142
TC
687=item paid_files
688
689Files that require payment that the user has paid for.
690
691=cut
692
693sub paid_files {
694 my ($self) = @_;
695
696 require BSE::TB::ArticleFiles;
697 return BSE::TB::ArticleFiles->getSpecial(userPaidFor => $self->id);
698}
699
a0edb02e
TC
700sub remove {
701 my ($self, $cfg) = @_;
702
703 $cfg or confess "Missing parameter cfg";
704
705 # remove any owned files
706 for my $file ($self->files) {
707 $file->remove($cfg);
708 }
709
710 # file subscriptions
711 BSE::DB->run(bseRemoveUserFileSubs => $self->id);
712
713 # file notifies
714 BSE::DB->run(bseRemoveUserFileNotifies => $self->id);
715
716 # download log
717 BSE::DB->run(bseMarkUserFileAccessesAnon => $self->id);
718
719 # mark any orders owned by the user as anonymous
720 BSE::DB->run(bseMarkOwnedOrdersAnon => $self->id);
721
722 # newsletter subscriptions
723 BSE::DB->run(bseRemoveUserSubs => $self->id);
724
725 # wishlist
726 BSE::DB->run(bseRemoveUserWishlist => $self->id);
727
728 # group memberships
729 BSE::DB->run(bseRemoveUserMemberships => $self->id);
730
731 # seminar bookings
732 BSE::DB->run(bseRemoveUserBookings => $self->id);
733
734 # paid subscriptions
735 BSE::DB->run(bseRemoveUserProdSubs => $self->id);
736
737 # images
738 for my $im ($self->images) {
739 $self->remove_image($cfg, $im->{image_id});
740 }
741
742 $self->SUPER::remove();
743}
744
95e517da
TC
745sub link {
746 my ($self) = @_;
747
748 return BSE::Cfg->single->admin_url(siteusers => { a_edit => 1, id => $self->id });
749}
750
f197f061
TC
751=item send_registration_notify(remote_addr => $ip_address)
752
753Send an email to the customer with registration information.
754
755Template: user/email_register
756
757Basic static tags and:
758
759=over
760
761=item *
762
763host - IP address of the machine that registered the user.
764
765=item *
766
767user - the user registered.
768
769=back
770
771=cut
772
773sub send_registration_notify {
774 my ($self, %opts) = @_;
775
776 defined $opts{remote_addr}
777 or confess "Missing remote_addr parameter";
778
779 require BSE::ComposeMail;
780 require BSE::Util::Tags;
781 BSE::ComposeMail->send_simple
782 (
783 id => 'notify_register_customer',
784 template => 'user/email_register',
785 subject => 'Thank you for registering',
786 to => $self,
787 extraacts =>
788 {
789 host => $opts{remote_addr},
790 user => [ \&BSE::Util::Tags::tag_hash_plain, $self ],
791 },
45408d74
TC
792 log_msg => "Registration email to " . $self->email,
793 log_component => "member:register:notifyuser",
f197f061
TC
794 );
795}
796
5899bc52 797sub changepw {
93be4a7b 798 my ($self, $password, $who, %log) = @_;
5899bc52
TC
799
800 require BSE::Passwords;
801
802 my ($hash, $type) = BSE::Passwords->new_password_hash($password);
803
804 $self->set_password($hash);
805 $self->set_password_type($type);
806
807 require BSE::TB::AuditLog;
808 BSE::TB::AuditLog->log
809 (
810 component => "siteusers::changepw",
811 object => $self,
812 actor => $who,
813 level => "info",
814 msg => "Change password",
93be4a7b 815 %log,
5899bc52
TC
816 );
817
818 1;
819}
820
821sub check_password {
822 my ($self, $password, $error) = @_;
823
824 require BSE::Passwords;
825 return BSE::Passwords->check_password_hash($self->password, $self->password_type, $password, $error);
826}
827
93be4a7b
TC
828=item lost_password
829
830Call to send a lost password email.
831
832=cut
833
834sub lost_password {
835 my ($self, $error) = @_;
836
837 my $cfg = BSE::Cfg->single;
838 require BSE::CfgInfo;
839 my $custom = BSE::CfgInfo::custom_class($cfg);
840 my $email_user = $self;
841 my $to = $self;
842 if ($custom->can('send_user_email_to')) {
843 eval {
844 $email_user = $custom->send_user_email_to($self, $cfg);
845 };
846 $to = $email_user->{email};
847 }
848 else {
849 require BSE::Util::SQL;
850 my $lost_limit = $cfg->entry("lost password", "daily_limit", 3);
851 my $today = BSE::Util::SQL::now_sqldate();
852 my $lost_today = 0;
853 if ($self->lost_date
854 && $self->lost_date eq $today) {
855 $lost_today = $self->lost_today;
856 }
857 if ($lost_today+1 > $lost_limit) {
858 $$error = "Too many password recovery attempts today, please try again tomorrow";
859 return;
860 }
861 $self->set_lost_date($today);
862 $self->set_lost_today($lost_today+1);
863 $self->set_lost_id(BSE::Util::Secure::make_secret($cfg));
864 }
865
866 require BSE::ComposeMail;
867 my $mail = BSE::ComposeMail->new(cfg => $cfg);
868
869 require BSE::Util::Tags;
870 my %mailacts;
871 %mailacts =
872 (
873 BSE::Util::Tags->mail_tags(),
874 user => [ \&BSE::Util::Tags::tag_object_plain, $self ],
875 host => $ENV{REMOTE_ADDR},
876 site => $cfg->entryErr('site', 'url'),
877 emailuser => [ \&BSE::Util::Tags::tag_hash_plain, $email_user ],
878 );
879 my $from = $cfg->entry('confirmations', 'from') ||
880 $cfg->entry('basic', 'emailfrom') || $SHOP_FROM;
881 my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
882 my $subject = $cfg->entry('basic', 'lostpasswordsubject')
883 || ($nopassword ? "Your options" : "Your password");
884 unless ($mail->send
885 (
886 template => 'user/lostpwdemail',
887 acts => \%mailacts,
888 from=>$from,
889 to => $to,
890 subject=>$subject,
891 log_msg => "Sending lost password recovery email",
892 log_component => "siteusers:lost:send",
893 log_object => $self,
894 )) {
895 $$error = $mail->errstr;
896 return;
897 }
898 $self->save;
899
900 return $email_user;
901}
902
903sub check_password_rules {
904 my ($class, $password, $error) = @_;
905
906 my $cfg = BSE::Cfg->single;
907 my $min_pass_length = $cfg->entry('basic', 'minpassword') || 4;
908 if (length $password < $min_pass_length) {
909 $$error = [ "passwordlen", $min_pass_length ];
910 return;
911 }
912
913 return 1;
914}
915
589b789c 9161;