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