]>
Commit | Line | Data |
---|---|---|
589b789c TC |
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/; | |
9063386f | 7 | use Constants qw($SHOP_FROM); |
a0edb02e | 8 | use Carp qw(confess); |
9d576c12 | 9 | use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date sql_add_date_days/; |
9063386f | 10 | |
74b3689a TC |
11 | =head1 NAME |
12 | ||
13 | SiteUser - represent a site user (or member) | |
14 | ||
15 | =head1 METHODS | |
16 | ||
17 | =over | |
18 | ||
19 | =cut | |
20 | ||
68d44fe0 | 21 | our $VERSION = "1.011"; |
cb7fd78d | 22 | |
9063386f TC |
23 | use constant MAX_UNACKED_CONF_MSGS => 3; |
24 | use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60; | |
32696f84 | 25 | use constant OWNER_TYPE => "U"; |
589b789c TC |
26 | |
27 | sub 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 | 47 | sub table { |
b27af108 | 48 | return "bse_siteusers"; |
a0edb02e TC |
49 | } |
50 | ||
5899bc52 TC |
51 | sub 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 |
115 | sub default_idUUID { |
116 | require Data::UUID; | |
117 | my $ug = Data::UUID->new; | |
118 | return $ug->create_str; | |
119 | } | |
120 | ||
829c9ed9 TC |
121 | sub 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 TC |
134 | state => { description => 'State', rules=>"dh_one_line", maxlen=>40 }, |
135 | postcode => { rules=>'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 }, |
b27af108 | 158 | delivPostCode => { description => "Delivery Post Code", rules=>"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 | ||
192 | sub valid_rules { | |
193 | return; | |
194 | } | |
195 | ||
b19047a6 TC |
196 | sub removeSubscriptions { |
197 | my ($self) = @_; | |
198 | ||
199 | SiteUsers->doSpecial('removeSubscriptions', $self->{id}); | |
589b789c TC |
200 | } |
201 | ||
531fb3bc TC |
202 | sub removeSubscription { |
203 | my ($self, $subid) = @_; | |
204 | ||
205 | SiteUsers->doSpecial('removeSub', $self->{id}, $subid); | |
206 | } | |
207 | ||
9063386f TC |
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 | ||
74b3689a TC |
224 | =item subscriptions |
225 | ||
226 | The subscriptions the user is subscribed to. | |
227 | ||
228 | =cut | |
229 | ||
9063386f TC |
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) = @_; | |
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') || | |
255 | $cfg->entry('basic', 'emailfrom')|| $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 | |
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'; | |
318 | my $body = BSE::Template->get_page($email_template, $cfg, \%confacts); | |
220c179a TC |
319 | |
320 | require BSE::Mail; | |
9063386f TC |
321 | my $mail = BSE::Mail->new(cfg=>$cfg); |
322 | my $subject = $cfg->entry('confirmations', 'subject') | |
323 | || 'Subscription Confirmation'; | |
324 | unless ($mail->send(from=>$from, to=>$user->{email}, subject=>$subject, | |
325 | body=>$body)) { | |
326 | # a problem sending the mail | |
327 | $$rcode = "mail"; | |
328 | $$rmsg = $mail->errstr; | |
329 | return; | |
330 | } | |
331 | ++$confirm->{unackedConfMsgs}; | |
332 | $confirm->{lastConfSent} = now_datetime; | |
333 | $confirm->save; | |
334 | ||
335 | return 1; | |
336 | } | |
337 | ||
74b3689a TC |
338 | =item orders |
339 | ||
340 | The shop orders made by the user. | |
341 | ||
342 | =cut | |
343 | ||
6a8a205a TC |
344 | sub orders { |
345 | my ($self) = @_; | |
346 | ||
3c32512d | 347 | require BSE::TB::Orders; |
6a8a205a | 348 | |
3c32512d | 349 | return BSE::TB::Orders->getBy(userId => $self->{userId}); |
6a8a205a TC |
350 | } |
351 | ||
af74f0b4 TC |
352 | sub _user_sub_entry { |
353 | my ($self, $sub) = @_; | |
354 | ||
355 | my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id}, | |
356 | $sub->{subscription_id}) | |
357 | or return; | |
358 | ||
359 | return $entry; | |
360 | } | |
361 | ||
74b3689a TC |
362 | =item subscribed_to |
363 | ||
364 | return true if the user is subcribed to the given subscription. | |
365 | ||
366 | =cut | |
367 | ||
0ec4ac8a TC |
368 | # check if the user is subscribed to the given subscription |
369 | sub subscribed_to { | |
370 | my ($self, $sub) = @_; | |
371 | ||
af74f0b4 TC |
372 | my $entry = $self->_user_sub_entry($sub) |
373 | or return; | |
374 | ||
375 | my $today = now_sqldate; | |
829c9ed9 | 376 | my $end_date = sql_normal_date($entry->{ends_at}); |
af74f0b4 | 377 | return $today le $end_date; |
0ec4ac8a TC |
378 | } |
379 | ||
380 | # check if the user is subscribed to the given subscription, and allow | |
381 | # for the max_lapsed grace period | |
382 | sub subscribed_to_grace { | |
383 | my ($self, $sub) = @_; | |
384 | ||
af74f0b4 TC |
385 | my $entry = $self->_user_sub_entry($sub) |
386 | or return; | |
387 | ||
388 | my $today = now_sqldate; | |
9d576c12 | 389 | my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed}); |
af74f0b4 | 390 | return $today le $end_date; |
0ec4ac8a TC |
391 | } |
392 | ||
dfdeb4fe TC |
393 | my @image_cols = |
394 | qw(siteuser_id image_id filename width height bytes content_type alt); | |
395 | ||
396 | sub images_cfg { | |
397 | my ($self, $cfg) = @_; | |
398 | ||
399 | my @images; | |
400 | my %ids = $cfg->entries('BSE Siteuser Images'); | |
401 | for my $id (keys %ids) { | |
402 | my %image = ( id => $id ); | |
403 | ||
404 | my $sect = "BSE Siteuser Image $id"; | |
405 | for my $key (qw(description help minwidth minheight maxwidth maxheight | |
406 | minratio maxratio properror | |
407 | widthsmallerror heightsmallerror smallerror | |
408 | widthlargeerror heightlargeerror largeerror | |
409 | maxspace spaceerror)) { | |
410 | my $value = $cfg->entry($sect, $key); | |
411 | if (defined $value) { | |
412 | $image{$key} = $value; | |
413 | } | |
414 | } | |
415 | push @images, \%image; | |
416 | } | |
417 | ||
418 | @images; | |
419 | } | |
420 | ||
74b3689a TC |
421 | =item images |
422 | ||
423 | Return images associated with the user. | |
424 | ||
425 | =cut | |
426 | ||
dfdeb4fe TC |
427 | sub images { |
428 | my ($self) = @_; | |
429 | ||
430 | BSE::DB->query(getBSESiteuserImages => $self->{id}); | |
431 | } | |
432 | ||
433 | sub get_image { | |
434 | my ($self, $id) = @_; | |
435 | ||
436 | my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id) | |
437 | or return; | |
438 | ||
439 | $image; | |
440 | } | |
441 | ||
442 | sub set_image { | |
443 | my ($self, $cfg, $id, $image) = @_; | |
444 | ||
445 | my %image = %$image; | |
446 | $image{siteuser_id} = $self->{id}; | |
447 | my $old = $self->get_image($id); | |
448 | ||
449 | if ($old) { | |
450 | # replace it | |
451 | BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols}); | |
452 | ||
453 | # lose the old file | |
454 | my $image_dir = $cfg->entryVar('paths', 'siteuser_images'); | |
455 | unlink "$image_dir/$old->{filename}"; | |
456 | } | |
457 | else { | |
458 | # add it | |
459 | # replace it | |
460 | BSE::DB->run(addBSESiteuserImage => @image{@image_cols}); | |
461 | } | |
462 | } | |
463 | ||
464 | sub remove_image { | |
465 | my ($self, $cfg, $id) = @_; | |
466 | ||
467 | if (my $old = $self->get_image($id)) { | |
468 | # remove the entry | |
469 | BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id); | |
470 | ||
471 | # lose the old file | |
472 | my $image_dir = $cfg->entryVar('paths', 'siteuser_images'); | |
473 | unlink "$image_dir/$old->{filename}"; | |
474 | } | |
475 | } | |
476 | ||
af74f0b4 TC |
477 | sub recalculate_subscriptions { |
478 | my ($self, $cfg) = @_; | |
479 | ||
480 | require BSE::TB::Subscriptions; | |
481 | my @subs = BSE::TB::Subscriptions->all; | |
482 | for my $sub (@subs) { | |
483 | $sub->update_user_expiry($self, $cfg); | |
484 | } | |
485 | } | |
dfdeb4fe | 486 | |
9d576c12 TC |
487 | sub subscribed_services { |
488 | my ($self) = @_; | |
489 | ||
490 | BSE::DB->query(siteuserSubscriptions => $self->{id}); | |
491 | } | |
492 | ||
74b3689a TC |
493 | =item is_disabled |
494 | ||
495 | Return true if the user is disabled. | |
496 | ||
497 | =cut | |
498 | ||
6a8a6ac5 TC |
499 | sub is_disabled { |
500 | my ($self) = @_; | |
501 | ||
502 | return $self->{disabled}; | |
503 | } | |
504 | ||
718a070d TC |
505 | sub seminar_sessions_booked { |
506 | my ($self, $seminar_id) = @_; | |
507 | ||
508 | return map $_->{session_id}, | |
509 | BSE::DB->query(userSeminarSessionBookings => $seminar_id, $self->{id}); | |
510 | } | |
511 | ||
efcc5a30 TC |
512 | sub is_member_of { |
513 | my ($self, $group) = @_; | |
514 | ||
515 | my $group_id = ref $group ? $group->{id} : $group; | |
516 | ||
517 | my @result = BSE::DB->query(siteuserMemberOfGroup => $self->{id}, $group_id); | |
518 | ||
519 | return scalar(@result); | |
520 | } | |
521 | ||
522 | sub group_ids { | |
523 | my ($self) = @_; | |
524 | ||
525 | map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id}); | |
526 | } | |
527 | ||
7aa0262a TC |
528 | sub allow_html_email { |
529 | my ($self) = @_; | |
530 | ||
531 | !$self->{textOnlyMail}; | |
532 | } | |
533 | ||
2076966c TC |
534 | sub seminar_bookings_detail { |
535 | my ($self) = @_; | |
536 | ||
537 | BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id}); | |
538 | } | |
539 | ||
74b3689a TC |
540 | =item wishlist |
541 | ||
542 | return the user's wishlist products. | |
543 | ||
544 | =cut | |
545 | ||
d49667a2 TC |
546 | sub wishlist { |
547 | my $self = shift; | |
548 | require Products; | |
549 | return Products->getSpecial(userWishlist => $self->{id}); | |
550 | } | |
551 | ||
552 | sub wishlist_order { | |
553 | my $self = shift; | |
554 | return BSE::DB->query(bse_userWishlistOrder => $self->{id}); | |
555 | } | |
556 | ||
557 | sub product_in_wishlist { | |
558 | my ($self, $product) = @_; | |
559 | ||
560 | grep $_->{product_id} == $product->{id}, $self->wishlist_order; | |
561 | } | |
562 | ||
563 | sub add_to_wishlist { | |
564 | my ($self, $product) = @_; | |
565 | ||
566 | return | |
567 | eval { | |
568 | BSE::DB->run(bse_addToWishlist => $self->{id}, $product->{id}, time()); | |
569 | 1; | |
570 | }; | |
571 | } | |
572 | ||
573 | sub remove_from_wishlist { | |
574 | my ($self, $product) = @_; | |
575 | ||
576 | BSE::DB->run(bse_removeFromWishlist => $self->{id}, $product->{id}); | |
577 | } | |
578 | ||
579 | sub _set_wishlist_order { | |
580 | my ($self, $product_id, $display_order) = @_; | |
581 | ||
582 | print STDERR "_set_wishlist_order($product_id, $display_order)\n"; | |
583 | ||
584 | BSE::DB->run(bse_userWishlistReorder => $display_order, $self->{id}, $product_id); | |
585 | } | |
586 | ||
587 | sub _find_in_wishlist { | |
588 | my ($self, $product_id) = @_; | |
589 | ||
590 | my @order = $self->wishlist_order; | |
591 | ||
592 | my ($index) = grep $order[$_]{product_id} == $product_id, 0 .. $#order | |
593 | or return; | |
594 | ||
595 | return \@order, $index; | |
596 | } | |
597 | ||
598 | sub move_to_wishlist_top { | |
599 | my ($self, $product) = @_; | |
600 | ||
601 | my ($order, $move_index) = $self->_find_in_wishlist($product->{id}) | |
602 | or return; | |
603 | $move_index > 0 | |
604 | or return; # nothing to do | |
605 | ||
606 | my $top_order = $order->[0]{display_order}; | |
607 | for my $index (0 .. $move_index-1) { | |
608 | $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index+1]{display_order}); | |
609 | } | |
610 | $self->_set_wishlist_order($product->{id}, $top_order); | |
611 | } | |
612 | ||
613 | sub move_to_wishlist_bottom { | |
614 | my ($self, $product) = @_; | |
615 | ||
616 | my ($order, $move_index) = $self->_find_in_wishlist($product->{id}) | |
617 | or return; | |
618 | $move_index < $#$order | |
619 | or return; # nothing to do | |
620 | ||
621 | my $bottom_order = $order->[-1]{display_order}; | |
622 | for my $index (reverse($move_index+1 .. $#$order)) { | |
623 | $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index-1]{display_order}); | |
624 | } | |
625 | $self->_set_wishlist_order($product->{id}, $bottom_order); | |
626 | } | |
627 | ||
628 | sub move_down_wishlist { | |
629 | my ($self, $product) = @_; | |
630 | ||
631 | my ($order, $index) = $self->_find_in_wishlist($product->{id}) | |
632 | or return; | |
633 | $index < $#$order | |
634 | or return; # nothing to do | |
635 | ||
636 | $self->_set_wishlist_order($product->{id}, $order->[$index+1]{display_order}); | |
637 | $self->_set_wishlist_order($order->[$index+1]{product_id}, $order->[$index]{display_order}); | |
638 | } | |
639 | ||
640 | sub move_up_wishlist { | |
641 | my ($self, $product) = @_; | |
642 | ||
643 | my ($order, $index) = $self->_find_in_wishlist($product->{id}) | |
644 | or return; | |
645 | $index > 0 | |
646 | or return; # nothing to do | |
647 | ||
648 | $self->_set_wishlist_order($product->{id}, $order->[$index-1]{display_order}); | |
649 | $self->_set_wishlist_order($order->[$index-1]{product_id}, $order->[$index]{display_order}); | |
650 | } | |
651 | ||
32696f84 TC |
652 | # files owned specifically by this user |
653 | sub files { | |
654 | my ($self) = @_; | |
655 | ||
656 | require BSE::TB::OwnedFiles; | |
657 | return BSE::TB::OwnedFiles->getBy(owner_type => OWNER_TYPE, | |
658 | owner_id => $self->id); | |
659 | } | |
660 | ||
661 | sub admin_group_files { | |
662 | my ($self) = @_; | |
663 | ||
664 | require BSE::TB::OwnedFiles; | |
665 | return BSE::TB::OwnedFiles->getSpecial(userVisibleGroupFiles => $self->{id}); | |
666 | } | |
667 | ||
668 | sub query_group_files { | |
669 | my ($self, $cfg) = @_; | |
670 | ||
671 | require BSE::TB::SiteUserGroups; | |
672 | return | |
673 | ( | |
674 | map $_->files, BSE::TB::SiteUserGroups->query_groups($cfg) | |
675 | ); | |
676 | } | |
677 | ||
74b3689a TC |
678 | =item visible_files |
679 | ||
680 | files the user can see, both owned and owned by groups | |
681 | ||
682 | =cut | |
683 | ||
32696f84 TC |
684 | sub visible_files { |
685 | my ($self, $cfg) = @_; | |
686 | ||
687 | return | |
688 | ( | |
689 | $self->files, | |
690 | $self->admin_group_files, | |
691 | $self->query_group_files($cfg) | |
692 | ); | |
693 | } | |
694 | ||
695 | sub file_owner_type { | |
696 | return OWNER_TYPE; | |
697 | } | |
698 | ||
699 | sub subscribed_file_categories { | |
700 | my ($self) = @_; | |
701 | ||
702 | return map $_->{category}, BSE::DB->query(siteuserSubscribedFileCategories => $self->{id}); | |
703 | } | |
704 | ||
705 | sub set_subscribed_file_categories { | |
706 | my ($self, $cfg, @new) = @_; | |
707 | ||
708 | require BSE::TB::OwnedFiles; | |
709 | my %current = map { $_ => 1 } $self->subscribed_file_categories; | |
710 | my %new = map { $_ => 1 } @new; | |
711 | my @all = BSE::TB::OwnedFiles->categories($cfg); | |
712 | for my $cat (@all) { | |
713 | if ($new{$cat->{id}} && !$current{$cat->{id}}) { | |
714 | eval { | |
715 | BSE::DB->run(siteuserAddFileCategory => $self->{id}, $cat->{id}); | |
716 | }; # a race condition might cause a duplicate key error here | |
717 | } | |
718 | elsif (!$new{$cat->{id}} && $current{$cat->{id}}) { | |
719 | BSE::DB->run(siteuserRemoveFileCategory => $self->{id}, $cat->{id}); | |
720 | } | |
721 | } | |
722 | } | |
723 | ||
a0edb02e TC |
724 | =item describe |
725 | ||
726 | Returns a description of the user | |
727 | ||
728 | =cut | |
729 | ||
730 | sub describe { | |
731 | my ($self) = @_; | |
732 | ||
733 | return "Member: " . $self->userId; | |
734 | } | |
735 | ||
736c2142 TC |
736 | =item paid_files |
737 | ||
738 | Files that require payment that the user has paid for. | |
739 | ||
740 | =cut | |
741 | ||
742 | sub paid_files { | |
743 | my ($self) = @_; | |
744 | ||
745 | require BSE::TB::ArticleFiles; | |
746 | return BSE::TB::ArticleFiles->getSpecial(userPaidFor => $self->id); | |
747 | } | |
748 | ||
a0edb02e TC |
749 | sub remove { |
750 | my ($self, $cfg) = @_; | |
751 | ||
752 | $cfg or confess "Missing parameter cfg"; | |
753 | ||
754 | # remove any owned files | |
755 | for my $file ($self->files) { | |
756 | $file->remove($cfg); | |
757 | } | |
758 | ||
759 | # file subscriptions | |
760 | BSE::DB->run(bseRemoveUserFileSubs => $self->id); | |
761 | ||
762 | # file notifies | |
763 | BSE::DB->run(bseRemoveUserFileNotifies => $self->id); | |
764 | ||
765 | # download log | |
766 | BSE::DB->run(bseMarkUserFileAccessesAnon => $self->id); | |
767 | ||
768 | # mark any orders owned by the user as anonymous | |
769 | BSE::DB->run(bseMarkOwnedOrdersAnon => $self->id); | |
770 | ||
771 | # newsletter subscriptions | |
772 | BSE::DB->run(bseRemoveUserSubs => $self->id); | |
773 | ||
774 | # wishlist | |
775 | BSE::DB->run(bseRemoveUserWishlist => $self->id); | |
776 | ||
777 | # group memberships | |
778 | BSE::DB->run(bseRemoveUserMemberships => $self->id); | |
779 | ||
780 | # seminar bookings | |
781 | BSE::DB->run(bseRemoveUserBookings => $self->id); | |
782 | ||
783 | # paid subscriptions | |
784 | BSE::DB->run(bseRemoveUserProdSubs => $self->id); | |
785 | ||
786 | # images | |
787 | for my $im ($self->images) { | |
788 | $self->remove_image($cfg, $im->{image_id}); | |
789 | } | |
790 | ||
791 | $self->SUPER::remove(); | |
792 | } | |
793 | ||
95e517da TC |
794 | sub link { |
795 | my ($self) = @_; | |
796 | ||
797 | return BSE::Cfg->single->admin_url(siteusers => { a_edit => 1, id => $self->id }); | |
798 | } | |
799 | ||
f197f061 TC |
800 | =item send_registration_notify(remote_addr => $ip_address) |
801 | ||
802 | Send an email to the customer with registration information. | |
803 | ||
804 | Template: user/email_register | |
805 | ||
806 | Basic static tags and: | |
807 | ||
808 | =over | |
809 | ||
810 | =item * | |
811 | ||
812 | host - IP address of the machine that registered the user. | |
813 | ||
814 | =item * | |
815 | ||
816 | user - the user registered. | |
817 | ||
818 | =back | |
819 | ||
820 | =cut | |
821 | ||
822 | sub send_registration_notify { | |
823 | my ($self, %opts) = @_; | |
824 | ||
825 | defined $opts{remote_addr} | |
826 | or confess "Missing remote_addr parameter"; | |
827 | ||
828 | require BSE::ComposeMail; | |
829 | require BSE::Util::Tags; | |
830 | BSE::ComposeMail->send_simple | |
831 | ( | |
832 | id => 'notify_register_customer', | |
833 | template => 'user/email_register', | |
834 | subject => 'Thank you for registering', | |
835 | to => $self, | |
836 | extraacts => | |
837 | { | |
838 | host => $opts{remote_addr}, | |
839 | user => [ \&BSE::Util::Tags::tag_hash_plain, $self ], | |
840 | }, | |
68d44fe0 | 841 | log_msg => "Send registration email to Site User (" . $self->email .")", |
45408d74 | 842 | log_component => "member:register:notifyuser", |
f197f061 TC |
843 | ); |
844 | } | |
845 | ||
5899bc52 | 846 | sub changepw { |
93be4a7b | 847 | my ($self, $password, $who, %log) = @_; |
5899bc52 TC |
848 | |
849 | require BSE::Passwords; | |
850 | ||
851 | my ($hash, $type) = BSE::Passwords->new_password_hash($password); | |
852 | ||
853 | $self->set_password($hash); | |
854 | $self->set_password_type($type); | |
855 | ||
856 | require BSE::TB::AuditLog; | |
857 | BSE::TB::AuditLog->log | |
858 | ( | |
859 | component => "siteusers::changepw", | |
860 | object => $self, | |
861 | actor => $who, | |
87a74ac9 | 862 | level => "notice", |
68d44fe0 | 863 | msg => "Site User '" . $self->userId . "' changed their password", |
93be4a7b | 864 | %log, |
5899bc52 TC |
865 | ); |
866 | ||
867 | 1; | |
868 | } | |
869 | ||
870 | sub check_password { | |
871 | my ($self, $password, $error) = @_; | |
872 | ||
873 | require BSE::Passwords; | |
874 | return BSE::Passwords->check_password_hash($self->password, $self->password_type, $password, $error); | |
875 | } | |
876 | ||
93be4a7b TC |
877 | =item lost_password |
878 | ||
879 | Call to send a lost password email. | |
880 | ||
881 | =cut | |
882 | ||
883 | sub lost_password { | |
884 | my ($self, $error) = @_; | |
885 | ||
886 | my $cfg = BSE::Cfg->single; | |
887 | require BSE::CfgInfo; | |
888 | my $custom = BSE::CfgInfo::custom_class($cfg); | |
889 | my $email_user = $self; | |
890 | my $to = $self; | |
891 | if ($custom->can('send_user_email_to')) { | |
892 | eval { | |
893 | $email_user = $custom->send_user_email_to($self, $cfg); | |
894 | }; | |
895 | $to = $email_user->{email}; | |
896 | } | |
897 | else { | |
898 | require BSE::Util::SQL; | |
899 | my $lost_limit = $cfg->entry("lost password", "daily_limit", 3); | |
900 | my $today = BSE::Util::SQL::now_sqldate(); | |
901 | my $lost_today = 0; | |
902 | if ($self->lost_date | |
903 | && $self->lost_date eq $today) { | |
904 | $lost_today = $self->lost_today; | |
905 | } | |
906 | if ($lost_today+1 > $lost_limit) { | |
907 | $$error = "Too many password recovery attempts today, please try again tomorrow"; | |
908 | return; | |
909 | } | |
910 | $self->set_lost_date($today); | |
911 | $self->set_lost_today($lost_today+1); | |
912 | $self->set_lost_id(BSE::Util::Secure::make_secret($cfg)); | |
913 | } | |
914 | ||
915 | require BSE::ComposeMail; | |
916 | my $mail = BSE::ComposeMail->new(cfg => $cfg); | |
917 | ||
918 | require BSE::Util::Tags; | |
919 | my %mailacts; | |
920 | %mailacts = | |
921 | ( | |
922 | BSE::Util::Tags->mail_tags(), | |
923 | user => [ \&BSE::Util::Tags::tag_object_plain, $self ], | |
924 | host => $ENV{REMOTE_ADDR}, | |
925 | site => $cfg->entryErr('site', 'url'), | |
926 | emailuser => [ \&BSE::Util::Tags::tag_hash_plain, $email_user ], | |
927 | ); | |
928 | my $from = $cfg->entry('confirmations', 'from') || | |
929 | $cfg->entry('basic', 'emailfrom') || $SHOP_FROM; | |
930 | my $nopassword = $cfg->entryBool('site users', 'nopassword', 0); | |
931 | my $subject = $cfg->entry('basic', 'lostpasswordsubject') | |
932 | || ($nopassword ? "Your options" : "Your password"); | |
933 | unless ($mail->send | |
934 | ( | |
935 | template => 'user/lostpwdemail', | |
936 | acts => \%mailacts, | |
937 | from=>$from, | |
938 | to => $to, | |
939 | subject=>$subject, | |
68d44fe0 | 940 | log_msg => "Send password recovery email to Site User (" . $self->email . ")", |
93be4a7b TC |
941 | log_component => "siteusers:lost:send", |
942 | log_object => $self, | |
943 | )) { | |
944 | $$error = $mail->errstr; | |
945 | return; | |
946 | } | |
947 | $self->save; | |
948 | ||
949 | return $email_user; | |
950 | } | |
951 | ||
952 | sub check_password_rules { | |
77f53961 | 953 | my ($class, %opts) = @_; |
93be4a7b | 954 | |
77f53961 | 955 | require BSE::Util::PasswordValidate; |
93be4a7b | 956 | |
77f53961 TC |
957 | my %rules = BSE::Cfg->single->entries("siteuser passwords"); |
958 | ||
959 | return BSE::Util::PasswordValidate->validate | |
960 | ( | |
961 | %opts, | |
962 | rules => \%rules, | |
963 | ); | |
964 | } | |
965 | ||
966 | sub password_check_fields { | |
967 | return qw(name1 name2); | |
93be4a7b TC |
968 | } |
969 | ||
74b3689a TC |
970 | =item locked_out |
971 | ||
972 | Return true if logons are disabled due to too many authentication | |
973 | failures. | |
974 | ||
975 | =cut | |
976 | ||
977 | sub locked_out { | |
978 | my ($self) = @_; | |
979 | ||
980 | return $self->lockout_end && $self->lockout_end gt now_datetime(); | |
981 | } | |
982 | ||
983 | sub check_lockouts { | |
984 | my ($class, %opts) = @_; | |
985 | ||
986 | require BSE::Util::Lockouts; | |
987 | BSE::Util::Lockouts->check_lockouts | |
988 | ( | |
989 | %opts, | |
990 | section => "site user lockouts", | |
991 | component => "siteuser", | |
992 | module => "logon", | |
993 | type => $class->lockout_type, | |
994 | ); | |
995 | } | |
996 | ||
997 | sub unlock { | |
998 | my ($self, %opts) = @_; | |
999 | ||
1000 | require BSE::Util::Lockouts; | |
1001 | BSE::Util::Lockouts->unlock_user | |
1002 | ( | |
1003 | %opts, | |
1004 | user => $self, | |
1005 | component => "siteuser", | |
1006 | module => "logon", | |
1007 | ); | |
1008 | } | |
1009 | ||
1010 | sub unlock_ip_address { | |
1011 | my ($class, %opts) = @_; | |
1012 | ||
1013 | require BSE::Util::Lockouts; | |
1014 | BSE::Util::Lockouts->unlock_ip_address | |
1015 | ( | |
1016 | %opts, | |
1017 | component => "siteuser", | |
1018 | module => "logon", | |
1019 | type => $class->lockout_type, | |
1020 | ); | |
1021 | } | |
1022 | ||
1023 | sub lockout_type { | |
1024 | "S"; | |
1025 | } | |
1026 | ||
1027 | =back | |
1028 | ||
1029 | =cut | |
1030 | ||
589b789c | 1031 | 1; |