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