remove sensitive information from data_only for siteuser objects
[bse.git] / site / cgi-bin / modules / BSE / TB / SiteUser.pm
CommitLineData
b7cadc84 1package BSE::TB::SiteUser;
589b789c
TC
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
74b3689a
TC
11=head1 NAME
12
13SiteUser - represent a site user (or member)
14
15=head1 METHODS
16
17=over
18
19=cut
20
edfb4d94 21our $VERSION = "1.018";
cb7fd78d 22
9063386f
TC
23use constant MAX_UNACKED_CONF_MSGS => 3;
24use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
32696f84 25use constant OWNER_TYPE => "U";
589b789c
TC
26
27sub columns {
b27af108
TC
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
4175638b 40 customText1 customText2 customText3
dfdeb4fe 41 customStr1 customStr2 customStr3
b27af108 42 customInt1 customInt2 customWhen1
74b3689a 43 lockout_end
b27af108 44 /;
b19047a6
TC
45}
46
a0edb02e 47sub table {
b27af108 48 return "bse_siteusers";
a0edb02e
TC
49}
50
5899bc52
TC
51sub defaults {
52 require BSE::Util::SQL;
53 return
54 (
b27af108
TC
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
5899bc52
TC
60 whenRegistered => BSE::Util::SQL::now_datetime(),
61 lastLogon => BSE::Util::SQL::now_datetime(),
b27af108 62 title => "",
5899bc52
TC
63 name1 => "",
64 name2 => "",
b27af108
TC
65 street => "",
66 street2 => "",
67 suburb => "",
5899bc52
TC
68 state => "",
69 postcode => "",
b27af108 70 country => "",
5899bc52
TC
71 telephone => "",
72 facsimile => "",
b27af108
TC
73 mobile => "",
74 organization => "",
5899bc52
TC
75 confirmed => 0,
76 confirmSecret => "",
77 waitingForConfirmation => 0,
78 textOnlyMail => 0,
5899bc52 79 previousLogon => BSE::Util::SQL::now_datetime(),
b27af108
TC
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 => "",
5899bc52 94 instructions => "",
5899bc52
TC
95 adminNotes => "",
96 disabled => 0,
97 flags => "",
b27af108
TC
98 affiliate_name => "",
99 lost_today => 0,
100 lost_date => undef,
101 lost_id => undef,
5899bc52
TC
102 customText1 => undef,
103 customText2 => undef,
104 customText3 => undef,
105 customStr1 => undef,
106 customStr2 => undef,
107 customStr3 => undef,
5899bc52
TC
108 customInt1 => "",
109 customInt2 => "",
b27af108 110 customWhen1 => "",
74b3689a 111 lockout_end => undef,
5899bc52
TC
112 );
113}
114
b27af108
TC
115sub default_idUUID {
116 require Data::UUID;
117 my $ug = Data::UUID->new;
118 return $ug->create_str;
119}
120
829c9ed9
TC
121sub valid_fields {
122 my ($class, $cfg, $admin) = @_;
123
124 my %fields =
125 (
4c4d3c3f 126 email => { rules=>'email', description=>'Email Address',
829c9ed9 127 maxlen => 255},
b27af108 128 title => { description => 'Title', rules => 'dh_one_line', maxlen => 127 },
829c9ed9 129 name1 => { description=>'First Name', rules=>"dh_one_line", maxlen=>127 },
b27af108
TC
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 },
829c9ed9 134 state => { description => 'State', rules=>"dh_one_line", maxlen=>40 },
028e4ee3 135 postcode => { rules=>'dh_one_line;dh_int_postcode', description=>'Post Code', maxlen=>40 },
b27af108 136 country => { description=>'Country', rules=>"dh_one_line", maxlen=>127 },
829c9ed9
TC
137 telephone => { rules=>'phone', description=>'Telephone', maxlen=>80 },
138 facsimile => { rules=>'phone', description=>'Facsimile', maxlen=>80 },
b27af108 139 mobile => { description => "Mobile", rules=>"phone", maxlen => 80 },
829c9ed9
TC
140 organization => { description=>'Organization', rules=>"dh_one_line",
141 maxlen=>127 },
142 textOnlyEmail => { description => "Text Only Email", type=>"boolean" },
b27af108
TC
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",
829c9ed9 148 rules=>"dh_one_line", maxlen=>127 },
b27af108
TC
149 delivLastName => { descriptin=>"Delivery Last Name", rules=>"dh_one_line" },
150 delivStreet => { description => "Delivery Street Address",
829c9ed9 151 rules=>"dh_one_line", maxlen=>127 },
b27af108 152 delivStreet2 => { description => 'Delivery Street Address 2',
37dd20ad 153 rules => "dh_one_line", maxlen=> 127 },
b27af108 154 delivSuburb => { description => "Delivery Suburb", rules=>"dh_one_line",
829c9ed9 155 maxlen=>127 },
b27af108 156 delivState => { description => "Delivery State", rules=>"dh_one_line",
829c9ed9 157 maxlen=>40 },
028e4ee3 158 delivPostCode => { description => "Delivery Post Code", rules=>"dh_one_line;dh_int_postcode",
829c9ed9 159 maxlen=>40 },
b27af108 160 delivCountry => { description => "Delivery Country", rules=>"dh_one_line",
829c9ed9 161 maxlen=>127 },
b27af108 162 delivTelephone => { description => "Delivery Phone", rules=>"phone",
829c9ed9 163 maxlen=>80 },
b27af108 164 delivFacsimile => { description => "Delivery Facsimie", rules=>"phone",
829c9ed9 165 maxlen=>80 },
b27af108 166 delivMobile => { description => "Delivery Mobile", rules=>"phone",
e3d242f7 167 maxlen => 80 },
b27af108 168 delivOrganization => { description => "Delivery Organization",
37dd20ad 169 rules=>"dh_one_line", maxlen => 127 },
b27af108 170 instructions => { description => "Delivery Instructions" },
829c9ed9
TC
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
829c9ed9
TC
189 return %fields;
190}
191
192sub valid_rules {
193 return;
194}
195
b19047a6
TC
196sub removeSubscriptions {
197 my ($self) = @_;
198
b7cadc84 199 BSE::TB::SiteUsers->doSpecial('removeSubscriptions', $self->{id});
589b789c
TC
200}
201
531fb3bc
TC
202sub removeSubscription {
203 my ($self, $subid) = @_;
204
b7cadc84 205 BSE::TB::SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
531fb3bc
TC
206}
207
9063386f
TC
208sub 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
74b3689a
TC
224=item subscriptions
225
226The subscriptions the user is subscribed to.
227
228=cut
229
9063386f
TC
230sub subscriptions {
231 my ($self) = @_;
232
233 require BSE::SubscriptionTypes;
234 return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
235}
236
237sub send_conf_request {
238 my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
6a8a6ac5
TC
239
240 if ($user->is_disabled) {
241 $$rmsg = "User is disabled";
242 return;
243 }
9063386f
TC
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') ||
efdaaafc 255 $cfg->entry('shop', 'from')|| $SHOP_FROM;
9063386f
TC
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
220c179a 278 require BSE::EmailRequests;
9063386f
TC
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';
220c179a 318
fc23e9c7
AO
319 require BSE::ComposeMail;
320 my $mail = BSE::ComposeMail->new(cfg => $cfg);
321
9063386f
TC
322 my $subject = $cfg->entry('confirmations', 'subject')
323 || 'Subscription Confirmation';
fc23e9c7
AO
324 unless ($mail->send(template => $email_template,
325 acts => \%confacts,
326 from=>$from,
327 to=>$user,
328 subject=>$subject)) {
9063386f
TC
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
74b3689a
TC
341=item orders
342
343The shop orders made by the user.
344
345=cut
346
6a8a205a
TC
347sub orders {
348 my ($self) = @_;
349
3c32512d 350 require BSE::TB::Orders;
6a8a205a 351
3c32512d 352 return BSE::TB::Orders->getBy(userId => $self->{userId});
6a8a205a
TC
353}
354
af74f0b4
TC
355sub _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
74b3689a
TC
365=item subscribed_to
366
367return true if the user is subcribed to the given subscription.
368
369=cut
370
0ec4ac8a
TC
371# check if the user is subscribed to the given subscription
372sub subscribed_to {
373 my ($self, $sub) = @_;
374
af74f0b4
TC
375 my $entry = $self->_user_sub_entry($sub)
376 or return;
377
378 my $today = now_sqldate;
829c9ed9 379 my $end_date = sql_normal_date($entry->{ends_at});
af74f0b4 380 return $today le $end_date;
0ec4ac8a
TC
381}
382
383# check if the user is subscribed to the given subscription, and allow
384# for the max_lapsed grace period
385sub subscribed_to_grace {
386 my ($self, $sub) = @_;
387
af74f0b4
TC
388 my $entry = $self->_user_sub_entry($sub)
389 or return;
390
391 my $today = now_sqldate;
9d576c12 392 my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed});
af74f0b4 393 return $today le $end_date;
0ec4ac8a
TC
394}
395
dfdeb4fe
TC
396my @image_cols =
397 qw(siteuser_id image_id filename width height bytes content_type alt);
398
399sub 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
74b3689a
TC
424=item images
425
426Return images associated with the user.
427
428=cut
429
dfdeb4fe
TC
430sub images {
431 my ($self) = @_;
432
433 BSE::DB->query(getBSESiteuserImages => $self->{id});
434}
435
436sub 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
445sub 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
467sub 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
af74f0b4
TC
480sub 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}
dfdeb4fe 489
9d576c12
TC
490sub subscribed_services {
491 my ($self) = @_;
492
493 BSE::DB->query(siteuserSubscriptions => $self->{id});
494}
495
74b3689a
TC
496=item is_disabled
497
498Return true if the user is disabled.
499
500=cut
501
6a8a6ac5
TC
502sub is_disabled {
503 my ($self) = @_;
504
505 return $self->{disabled};
506}
507
718a070d
TC
508sub 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
efcc5a30
TC
515sub 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
525sub group_ids {
526 my ($self) = @_;
527
528 map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id});
529}
530
7aa0262a
TC
531sub allow_html_email {
532 my ($self) = @_;
533
534 !$self->{textOnlyMail};
535}
536
2076966c
TC
537sub seminar_bookings_detail {
538 my ($self) = @_;
539
540 BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id});
541}
542
74b3689a
TC
543=item wishlist
544
545return the user's wishlist products.
546
547=cut
548
d49667a2
TC
549sub wishlist {
550 my $self = shift;
10dd37f9
AO
551 require BSE::TB::Products;
552 return BSE::TB::Products->getSpecial(userWishlist => $self->{id});
d49667a2
TC
553}
554
555sub wishlist_order {
556 my $self = shift;
557 return BSE::DB->query(bse_userWishlistOrder => $self->{id});
558}
559
560sub product_in_wishlist {
561 my ($self, $product) = @_;
562
563 grep $_->{product_id} == $product->{id}, $self->wishlist_order;
564}
565
566sub 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
576sub remove_from_wishlist {
577 my ($self, $product) = @_;
578
579 BSE::DB->run(bse_removeFromWishlist => $self->{id}, $product->{id});
580}
581
582sub _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
590sub _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
601sub 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
616sub 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
631sub 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
643sub 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
32696f84
TC
655# files owned specifically by this user
656sub 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
664sub admin_group_files {
665 my ($self) = @_;
666
667 require BSE::TB::OwnedFiles;
668 return BSE::TB::OwnedFiles->getSpecial(userVisibleGroupFiles => $self->{id});
669}
670
671sub 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
74b3689a
TC
681=item visible_files
682
683files the user can see, both owned and owned by groups
684
685=cut
686
32696f84
TC
687sub 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
698sub file_owner_type {
699 return OWNER_TYPE;
700}
701
702sub subscribed_file_categories {
703 my ($self) = @_;
704
705 return map $_->{category}, BSE::DB->query(siteuserSubscribedFileCategories => $self->{id});
706}
707
708sub 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
a0edb02e
TC
727=item describe
728
729Returns a description of the user
730
731=cut
732
733sub describe {
734 my ($self) = @_;
735
736 return "Member: " . $self->userId;
737}
738
736c2142
TC
739=item paid_files
740
741Files that require payment that the user has paid for.
742
743=cut
744
745sub paid_files {
746 my ($self) = @_;
747
748 require BSE::TB::ArticleFiles;
749 return BSE::TB::ArticleFiles->getSpecial(userPaidFor => $self->id);
750}
751
a0edb02e
TC
752sub 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
95e517da
TC
797sub link {
798 my ($self) = @_;
799
800 return BSE::Cfg->single->admin_url(siteusers => { a_edit => 1, id => $self->id });
801}
802
f197f061
TC
803=item send_registration_notify(remote_addr => $ip_address)
804
805Send an email to the customer with registration information.
806
807Template: user/email_register
808
809Basic static tags and:
810
811=over
812
813=item *
814
815host - IP address of the machine that registered the user.
816
817=item *
818
819user - the user registered.
820
821=back
822
823=cut
824
825sub 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 },
68d44fe0 844 log_msg => "Send registration email to Site User (" . $self->email .")",
45408d74 845 log_component => "member:register:notifyuser",
f197f061
TC
846 );
847}
848
5899bc52 849sub changepw {
93be4a7b 850 my ($self, $password, $who, %log) = @_;
5899bc52
TC
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,
87a74ac9 865 level => "notice",
68d44fe0 866 msg => "Site User '" . $self->userId . "' changed their password",
93be4a7b 867 %log,
5899bc52
TC
868 );
869
870 1;
871}
872
873sub 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
93be4a7b
TC
880=item lost_password
881
882Call to send a lost password email.
883
884=cut
885
886sub 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') ||
efdaaafc 932 $cfg->entry('shop', 'from') || $SHOP_FROM;
93be4a7b
TC
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,
68d44fe0 943 log_msg => "Send password recovery email to Site User (" . $self->email . ")",
93be4a7b
TC
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
955sub check_password_rules {
77f53961 956 my ($class, %opts) = @_;
93be4a7b 957
77f53961 958 require BSE::Util::PasswordValidate;
93be4a7b 959
77f53961
TC
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
969sub password_check_fields {
970 return qw(name1 name2);
93be4a7b
TC
971}
972
74b3689a
TC
973=item locked_out
974
975Return true if logons are disabled due to too many authentication
976failures.
977
978=cut
979
980sub locked_out {
981 my ($self) = @_;
982
983 return $self->lockout_end && $self->lockout_end gt now_datetime();
984}
985
986sub 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
1000sub 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
1013sub 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
1026sub lockout_type {
1027 "S";
1028}
1029
1f3d3c27
TC
1030
1031# for duck-type compatibility with BSE::TB::AdminUser
1032sub logon {
1033 my ($self) = @_;
1034
1035 return $self->userId;
1036}
1037
edfb4d94
TC
1038sub data_only {
1039 my ($self) = @_;
1040
1041 my $data = $self->SUPER::data_only();
1042 delete @$data{qw/confirmSecret password password_type/};
1043
1044 return $data;
1045}
1046
74b3689a
TC
1047=back
1048
1049=cut
1050
589b789c 10511;