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.016";
  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=>'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=>"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;