site/cgi-bin/modules/SiteUser.pm

   1 package 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 our $VERSION = "1.008";
  12
  13 use constant MAX_UNACKED_CONF_MSGS => 3;
  14 use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
  15 use constant OWNER_TYPE => "U";
  16
  17 sub columns {
  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
  30             customText1 customText2 customText3
  31             customStr1 customStr2 customStr3
  32             customInt1 customInt2 customWhen1
  33             /;
  34 }
  35
  36 sub table {
  37   return "bse_siteusers";
  38 }
  39
  40 sub defaults {
  41   require BSE::Util::SQL;
  42   return
  43     (
  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
  49      whenRegistered => BSE::Util::SQL::now_datetime(),
  50      lastLogon => BSE::Util::SQL::now_datetime(),
  51      title => "",
  52      name1 => "",
  53      name2 => "",
  54      street => "",
  55      street2 => "",
  56      suburb => "",
  57      state => "",
  58      postcode => "",
  59      country => "",
  60      telephone => "",
  61      facsimile => "",
  62      mobile => "",
  63      organization => "",
  64      confirmed => 0,
  65      confirmSecret => "",
  66      waitingForConfirmation => 0,
  67      textOnlyMail => 0,
  68      previousLogon => BSE::Util::SQL::now_datetime(),
  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 => "",
  83      instructions => "",
  84      adminNotes => "",
  85      disabled => 0,
  86      flags => "",
  87      affiliate_name => "",
  88      lost_today => 0,
  89      lost_date => undef,
  90      lost_id => undef,
  91      customText1 => undef,
  92      customText2 => undef,
  93      customText3 => undef,
  94      customStr1 => undef,
  95      customStr2 => undef,
  96      customStr3 => undef,
  97      customInt1 => "",
  98      customInt2 => "",
  99      customWhen1 => "",
 100     );
 101 }
 102
 103 sub default_idUUID {
 104   require Data::UUID;
 105   my $ug = Data::UUID->new;
 106   return $ug->create_str;
 107 }
 108
 109 sub valid_fields {
 110   my ($class, $cfg, $admin) = @_;
 111
 112   my %fields =
 113     (
 114      email => { rules=>'email', description=>'Email Address',
 115                 maxlen => 255},
 116      title => { description => 'Title', rules => 'dh_one_line', maxlen => 127 },
 117      name1 => { description=>'First Name', rules=>"dh_one_line", maxlen=>127 },
 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 },
 122      state => { description => 'State', rules=>"dh_one_line", maxlen=>40 },
 123      postcode => { rules=>'postcode', description=>'Post Code', maxlen=>40 },
 124      country => { description=>'Country', rules=>"dh_one_line", maxlen=>127 },
 125      telephone => { rules=>'phone', description=>'Telephone', maxlen=>80 },
 126      facsimile => { rules=>'phone', description=>'Facsimile', maxlen=>80 },
 127      mobile => { description => "Mobile", rules=>"phone", maxlen => 80 },
 128      organization => { description=>'Organization', rules=>"dh_one_line",
 129                        maxlen=>127  },
 130      textOnlyEmail => { description => "Text Only Email", type=>"boolean" },
 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",
 136                         rules=>"dh_one_line", maxlen=>127 },
 137      delivLastName => { descriptin=>"Delivery Last Name", rules=>"dh_one_line" },
 138      delivStreet => { description => "Delivery Street Address",
 139                      rules=>"dh_one_line", maxlen=>127 },
 140      delivStreet2 => { description => 'Delivery Street Address 2',
 141                       rules => "dh_one_line", maxlen=> 127 },
 142      delivSuburb => { description => "Delivery Suburb", rules=>"dh_one_line",
 143                      maxlen=>127 },
 144      delivState => { description => "Delivery State", rules=>"dh_one_line",
 145                     maxlen=>40 },
 146      delivPostCode => { description => "Delivery Post Code", rules=>"postcode",
 147                        maxlen=>40 },
 148      delivCountry => { description => "Delivery Country", rules=>"dh_one_line",
 149                       maxlen=>127 },
 150      delivTelephone => { description => "Delivery Phone", rules=>"phone",
 151                         maxlen=>80 },
 152      delivFacsimile => { description => "Delivery Facsimie", rules=>"phone",
 153                         maxlen=>80 },
 154      delivMobile => { description => "Delivery Mobile", rules=>"phone",
 155                      maxlen => 80 },
 156      delivOrganization => { description => "Delivery Organization",
 157                            rules=>"dh_one_line", maxlen => 127 },
 158      instructions => { description => "Delivery Instructions" },
 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
 177   return %fields;
 178 }
 179
 180 sub valid_rules {
 181   return;
 182 }
 183
 184 sub removeSubscriptions {
 185   my ($self) = @_;
 186
 187   SiteUsers->doSpecial('removeSubscriptions', $self->{id});
 188 }
 189
 190 sub removeSubscription {
 191   my ($self, $subid) = @_;
 192
 193   SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
 194 }
 195
 196 sub 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
 212 sub subscriptions {
 213   my ($self) = @_;
 214
 215   require BSE::SubscriptionTypes;
 216   return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
 217 }
 218
 219 sub send_conf_request {
 220   my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
 221
 222   if ($user->is_disabled) {
 223     $$rmsg = "User is disabled";
 224     return;
 225   }
 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
 260   require BSE::EmailRequests;
 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);
 301
 302   require BSE::Mail;
 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
 320 sub orders {
 321   my ($self) = @_;
 322
 323   require BSE::TB::Orders;
 324
 325   return BSE::TB::Orders->getBy(userId => $self->{userId});
 326 }
 327
 328 sub _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
 338 # check if the user is subscribed to the given subscription
 339 sub subscribed_to {
 340   my ($self, $sub) = @_;
 341
 342   my $entry = $self->_user_sub_entry($sub)
 343     or return;
 344
 345   my $today = now_sqldate;
 346   my $end_date = sql_normal_date($entry->{ends_at});
 347   return $today le $end_date;
 348 }
 349
 350 # check if the user is subscribed to the given subscription, and allow
 351 # for the max_lapsed grace period
 352 sub subscribed_to_grace {
 353   my ($self, $sub) = @_;
 354
 355   my $entry = $self->_user_sub_entry($sub)
 356     or return;
 357
 358   my $today = now_sqldate;
 359   my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed});
 360   return $today le $end_date;
 361 }
 362
 363 my @image_cols =
 364   qw(siteuser_id image_id filename width height bytes content_type alt);
 365
 366 sub 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
 391 sub images {
 392   my ($self) = @_;
 393
 394   BSE::DB->query(getBSESiteuserImages => $self->{id});
 395 }
 396
 397 sub 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
 406 sub 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
 428 sub 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
 441 sub 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 }
 450
 451 sub subscribed_services {
 452   my ($self) = @_;
 453
 454   BSE::DB->query(siteuserSubscriptions => $self->{id});
 455 }
 456
 457 sub is_disabled {
 458   my ($self) = @_;
 459
 460   return $self->{disabled};
 461 }
 462
 463 sub 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
 470 sub 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
 480 sub group_ids {
 481   my ($self) = @_;
 482
 483   map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id});
 484 }
 485
 486 sub allow_html_email {
 487   my ($self) = @_;
 488
 489   !$self->{textOnlyMail};
 490 }
 491
 492 sub seminar_bookings_detail {
 493   my ($self) = @_;
 494
 495   BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id});
 496 }
 497
 498 sub wishlist {
 499   my $self = shift;
 500   require Products;
 501   return Products->getSpecial(userWishlist => $self->{id});
 502 }
 503
 504 sub wishlist_order {
 505   my $self = shift;
 506   return BSE::DB->query(bse_userWishlistOrder => $self->{id});
 507 }
 508
 509 sub product_in_wishlist {
 510   my ($self, $product) = @_;
 511
 512   grep $_->{product_id} == $product->{id}, $self->wishlist_order;
 513 }
 514
 515 sub 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
 525 sub remove_from_wishlist {
 526   my ($self, $product) = @_;
 527
 528   BSE::DB->run(bse_removeFromWishlist => $self->{id}, $product->{id});
 529 }
 530
 531 sub _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
 539 sub _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
 550 sub 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
 565 sub 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
 580 sub 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
 592 sub 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
 604 # files owned specifically by this user
 605 sub 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
 613 sub admin_group_files {
 614   my ($self) = @_;
 615
 616   require BSE::TB::OwnedFiles;
 617   return BSE::TB::OwnedFiles->getSpecial(userVisibleGroupFiles => $self->{id});
 618 }
 619
 620 sub 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
 631 sub 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
 642 sub file_owner_type {
 643   return OWNER_TYPE;
 644 }
 645
 646 sub subscribed_file_categories {
 647   my ($self) = @_;
 648
 649   return map $_->{category}, BSE::DB->query(siteuserSubscribedFileCategories => $self->{id});
 650 }
 651
 652 sub 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
 671 =item describe
 672
 673 Returns a description of the user
 674
 675 =cut
 676
 677 sub describe {
 678   my ($self) = @_;
 679
 680   return "Member: " . $self->userId;
 681 }
 682
 683 =item paid_files
 684
 685 Files that require payment that the user has paid for.
 686
 687 =cut
 688
 689 sub paid_files {
 690   my ($self) = @_;
 691
 692   require BSE::TB::ArticleFiles;
 693   return BSE::TB::ArticleFiles->getSpecial(userPaidFor => $self->id);
 694 }
 695
 696 sub 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
 741 sub link {
 742   my ($self) = @_;
 743
 744   return BSE::Cfg->single->admin_url(siteusers => { a_edit => 1, id => $self->id });
 745 }
 746
 747 =item send_registration_notify(remote_addr => $ip_address)
 748
 749 Send an email to the customer with registration information.
 750
 751 Template: user/email_register
 752
 753 Basic static tags and:
 754
 755 =over
 756
 757 =item *
 758
 759 host - IP address of the machine that registered the user.
 760
 761 =item *
 762
 763 user - the user registered.
 764
 765 =back
 766
 767 =cut
 768
 769 sub 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        },
 788        log_msg => "Registration email to " . $self->email,
 789        log_component => "member:register:notifyuser",
 790       );
 791 }
 792
 793 sub changepw {
 794   my ($self, $password, $who, %log) = @_;
 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",
 811        %log,
 812       );
 813
 814   1;
 815 }
 816
 817 sub 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
 824 =item lost_password
 825
 826 Call to send a lost password email.
 827
 828 =cut
 829
 830 sub 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
 899 sub check_password_rules {
 900   my ($class, %opts) = @_;
 901
 902   require BSE::Util::PasswordValidate;
 903
 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
 913 sub password_check_fields {
 914   return qw(name1 name2);
 915 }
 916
 917 1;