docs
[bse.git] / site / cgi-bin / modules / SiteUser.pm
CommitLineData
589b789c
TC
1package SiteUser;
2use strict;
3# represents a registered user
4use Squirrel::Row;
5use vars qw/@ISA/;
6@ISA = qw/Squirrel::Row/;
9063386f 7use Constants qw($SHOP_FROM);
9d576c12 8use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date sql_add_date_days/;
9063386f
TC
9
10use constant MAX_UNACKED_CONF_MSGS => 3;
11use constant MIN_UNACKED_CONF_GAP => 2 * 24 * 60 * 60;
32696f84 12use constant OWNER_TYPE => "U";
589b789c
TC
13
14sub columns {
15 return qw/id userId password email keepAddress whenRegistered lastLogon
16 name1 name2 address city state postcode telephone facsimile
b19047a6
TC
17 country wantLetter confirmed confirmSecret waitingForConfirmation
18 textOnlyMail title organization referral otherReferral
9063386f
TC
19 prompt otherPrompt profession otherProfession previousLogon
20 billFirstName billLastName billStreet billSuburb billState
21 billPostCode billCountry instructions billTelephone billFacsimile
4175638b
TC
22 billEmail adminNotes disabled flags
23 customText1 customText2 customText3
dfdeb4fe 24 customStr1 customStr2 customStr3
37dd20ad
TC
25 affiliate_name delivMobile billMobile
26 delivStreet2 billStreet2
288ef5b8
TC
27 billOrganization
28 customInt1 customInt2/;
b19047a6
TC
29}
30
829c9ed9
TC
31sub valid_fields {
32 my ($class, $cfg, $admin) = @_;
33
34 my %fields =
35 (
4c4d3c3f 36 email => { rules=>'email', description=>'Email Address',
829c9ed9
TC
37 maxlen => 255},
38 name1 => { description=>'First Name', rules=>"dh_one_line", maxlen=>127 },
39 name2 => { description=>'Surname', rules=>"dh_one_line", maxlen=>127 },
40 address => { description => 'Address', rules=>"dh_one_line", maxlen=>127 },
41 city => { description=>'City/Suburb', rules=>"dh_one_line", maxlen=>127 },
42 state => { description => 'State', rules=>"dh_one_line", maxlen=>40 },
43 postcode => { rules=>'postcode', description=>'Post Code', maxlen=>40 },
44 telephone => { rules=>'phone', description=>'Telephone', maxlen=>80 },
45 facsimile => { rules=>'phone', description=>'Facsimile', maxlen=>80 },
46 country => { description=>'Country', rules=>"dh_one_line", maxlen=>127 },
47 title => { description=>'Title', rules=>"dh_one_line", maxlen=>127 },
48 organization => { description=>'Organization', rules=>"dh_one_line",
49 maxlen=>127 },
e3d242f7
TC
50 delivMobile => { description => "Mobile", rules=>"phone",
51 maxlen => 80 },
37dd20ad
TC
52 delivStreet2 => { description => 'Address2', rules => "dh_one_line",
53 maxlen=> 127 },
829c9ed9
TC
54 textOnlyEmail => { description => "Text Only Email", type=>"boolean" },
55 referral => { description=>'Referral', rules=>"natural" },
56 otherReferral => { description=>'Other Referral', rules=>"dh_one_line",
57 maxlen=>127},
58 prompt => { description=>'Prompt', rules=>"natural" },
59 otherPrompt => { description => 'Other Prompt', rules=>"dh_one_line",
60 maxlen=>127 },
61 profession => { description => 'Profession', rules=>"natural" },
62 otherProfession => { description=>'Other Profession',
63 rules=>"dh_one_line", maxlen=>127 },
64 billFirstName => { description=>"Billing First Name",
65 rules=>"dh_one_line", maxlen=>127 },
66 billLastName => { descriptin=>"Billing Last Name", rules=>"dh_one_line" },
67 billStreet => { description => "Billing Street Address",
68 rules=>"dh_one_line", maxlen=>127 },
37dd20ad
TC
69 billStreet2 => { description => 'Billing Street Address 2',
70 rules => "dh_one_line", maxlen=> 127 },
829c9ed9
TC
71 billSuburb => { description => "Billing Suburb", rules=>"dh_one_line",
72 maxlen=>127 },
73 billState => { description => "Billing State", rules=>"dh_one_line",
74 maxlen=>40 },
75 billPostCode => { description => "Billing Post Code", rules=>"postcode",
76 maxlen=>40 },
77 billCountry => { description => "Billing Country", rules=>"dh_one_line",
78 maxlen=>127 },
79 instructions => { description => "Delivery Instructions" },
80 billTelephone => { description => "Billing Phone", rules=>"phone",
81 maxlen=>80 },
82 billFacsimile => { description => "Billing Facsimie", rules=>"phone",
83 maxlen=>80 },
84 billEmail => { description => "Billing Email", rules=>"email",
85 maxlen=>255 },
e3d242f7
TC
86 billMobile => { description => "Billing Mobile", rules=>"phone",
87 maxlen => 80 },
37dd20ad
TC
88 billOrganization => { description => "Billing Organization",
89 rules=>"dh_one_line", maxlen => 127 },
829c9ed9
TC
90 customText1 => { description => "Custom Text 1" },
91 customText2 => { description => "Custom Text 2" },
92 customText3 => { description => "Custom Text 3" },
93 customStr1 => { description => "Custom String 1", rules=>"dh_one_line",
94 maxlen=>255 },
95 customStr2 => { description => "Custom String 2", rules=>"dh_one_line",
96 maxlen=>255 },
97 customStr3 => { description => "Custom String 3", rules=>"dh_one_line",
98 maxlen=>255 },
99 );
100
101 if ($admin) {
102 $fields{adminNotes} =
103 { description => "Administrator Notes" };
104 $fields{disabled} =
105 { description => "User Disabled", type=>"boolean" };
106 }
107
829c9ed9
TC
108 return %fields;
109}
110
111sub valid_rules {
112 return;
113}
114
b19047a6
TC
115sub removeSubscriptions {
116 my ($self) = @_;
117
118 SiteUsers->doSpecial('removeSubscriptions', $self->{id});
589b789c
TC
119}
120
531fb3bc
TC
121sub removeSubscription {
122 my ($self, $subid) = @_;
123
124 SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
125}
126
9063386f
TC
127sub generic_email {
128 my ($class, $checkemail) = @_;
129
130 # Build a generic form for the email - since an attacker could
131 # include comments or extra spaces or a bunch of other stuff.
132 # this isn't strictly correct, but it's good enough
133 1 while $checkemail =~ s/\([^)]\)//g;
134 if ($checkemail =~ /<([^>]+)>/) {
135 $checkemail = $1;
136 }
137 $checkemail = lc $checkemail;
138 $checkemail =~ s/\s+//g;
139
140 $checkemail;
141}
142
143sub subscriptions {
144 my ($self) = @_;
145
146 require BSE::SubscriptionTypes;
147 return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
148}
149
150sub send_conf_request {
151 my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
6a8a6ac5
TC
152
153 if ($user->is_disabled) {
154 $$rmsg = "User is disabled";
155 return;
156 }
9063386f
TC
157
158 my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
159
160 # check for existing in-progress confirmations
161 my $checkemail = $user->generic_email($user->{email});
162
163 # check the blacklist
164 require BSE::EmailBlacklist;
165
166 # check that the from address has been configured
167 my $from = $cfg->entry('confirmations', 'from') ||
168 $cfg->entry('basic', 'emailfrom')|| $SHOP_FROM;
169 unless ($from) {
170 $$rcode = 'config';
171 $$rmsg = "Configuration Error: The confirmations from address has not been configured";
172 return;
173 }
174
175 my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
176
177 if ($blackentry) {
178 $$rcode = "blacklist";
179 $$rmsg = $blackentry->{why};
180 return;
181 }
182
183 unless ($user->{confirmSecret}) {
184 use BSE::Util::Secure qw/make_secret/;
185 # print STDERR "Generating secret\n";
186 $user->{confirmSecret} = make_secret($cfg);
187 $user->save;
188 }
189
190 # check for existing confirmations
220c179a 191 require BSE::EmailRequests;
9063386f
TC
192 my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
193 if ($confirm) {
194 if ($confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS) {
195 $$rcode = 'toomany';
196 $$rmsg = "Too many confirmations have been sent to this email address";
197 return;
198 }
199 use BSE::Util::SQL qw/sql_datetime_to_epoch/;
200 my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
201 if ($lastSentEpoch + MIN_UNACKED_CONF_GAP > time) {
202 $$rcode = 'toosoon';
203 $$rmsg = "The last confirmation was sent too recently, please wait before trying again";
204 return;
205 }
206 }
207 else {
208 my %confirm;
209 my @cols = BSE::EmailRequest->columns;
210 shift @cols;
211 $confirm{email} = $user->{email};
212 $confirm{genEmail} = $checkemail;
213 # prevents silliness on error
214 use BSE::Util::SQL qw(sql_datetime);
215 $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
216 $confirm{unackedConfMsgs} = 0;
217 $confirm = BSE::EmailRequests->add(@confirm{@cols});
218 }
219
220 # ok, now we can send the confirmation request
221 my %confacts;
222 %confacts =
223 (
224 BSE::Util::Tags->basic(\%confacts, $cgi, $cfg),
225 user => sub { $user->{$_[0]} },
226 confirm => sub { $confirm->{$_[0]} },
227 remote_addr => sub { $ENV{REMOTE_ADDR} },
228 );
229 my $email_template =
230 $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
231 my $body = BSE::Template->get_page($email_template, $cfg, \%confacts);
220c179a
TC
232
233 require BSE::Mail;
9063386f
TC
234 my $mail = BSE::Mail->new(cfg=>$cfg);
235 my $subject = $cfg->entry('confirmations', 'subject')
236 || 'Subscription Confirmation';
237 unless ($mail->send(from=>$from, to=>$user->{email}, subject=>$subject,
238 body=>$body)) {
239 # a problem sending the mail
240 $$rcode = "mail";
241 $$rmsg = $mail->errstr;
242 return;
243 }
244 ++$confirm->{unackedConfMsgs};
245 $confirm->{lastConfSent} = now_datetime;
246 $confirm->save;
247
248 return 1;
249}
250
6a8a205a
TC
251sub orders {
252 my ($self) = @_;
253
3c32512d 254 require BSE::TB::Orders;
6a8a205a 255
3c32512d 256 return BSE::TB::Orders->getBy(userId => $self->{userId});
6a8a205a
TC
257}
258
af74f0b4
TC
259sub _user_sub_entry {
260 my ($self, $sub) = @_;
261
262 my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id},
263 $sub->{subscription_id})
264 or return;
265
266 return $entry;
267}
268
0ec4ac8a
TC
269# check if the user is subscribed to the given subscription
270sub subscribed_to {
271 my ($self, $sub) = @_;
272
af74f0b4
TC
273 my $entry = $self->_user_sub_entry($sub)
274 or return;
275
276 my $today = now_sqldate;
829c9ed9 277 my $end_date = sql_normal_date($entry->{ends_at});
af74f0b4 278 return $today le $end_date;
0ec4ac8a
TC
279}
280
281# check if the user is subscribed to the given subscription, and allow
282# for the max_lapsed grace period
283sub subscribed_to_grace {
284 my ($self, $sub) = @_;
285
af74f0b4
TC
286 my $entry = $self->_user_sub_entry($sub)
287 or return;
288
289 my $today = now_sqldate;
9d576c12 290 my $end_date = sql_add_date_days($entry->{ends_at}, $entry->{max_lapsed});
af74f0b4 291 return $today le $end_date;
0ec4ac8a
TC
292}
293
dfdeb4fe
TC
294my @image_cols =
295 qw(siteuser_id image_id filename width height bytes content_type alt);
296
297sub images_cfg {
298 my ($self, $cfg) = @_;
299
300 my @images;
301 my %ids = $cfg->entries('BSE Siteuser Images');
302 for my $id (keys %ids) {
303 my %image = ( id => $id );
304
305 my $sect = "BSE Siteuser Image $id";
306 for my $key (qw(description help minwidth minheight maxwidth maxheight
307 minratio maxratio properror
308 widthsmallerror heightsmallerror smallerror
309 widthlargeerror heightlargeerror largeerror
310 maxspace spaceerror)) {
311 my $value = $cfg->entry($sect, $key);
312 if (defined $value) {
313 $image{$key} = $value;
314 }
315 }
316 push @images, \%image;
317 }
318
319 @images;
320}
321
322sub images {
323 my ($self) = @_;
324
325 BSE::DB->query(getBSESiteuserImages => $self->{id});
326}
327
328sub get_image {
329 my ($self, $id) = @_;
330
331 my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id)
332 or return;
333
334 $image;
335}
336
337sub set_image {
338 my ($self, $cfg, $id, $image) = @_;
339
340 my %image = %$image;
341 $image{siteuser_id} = $self->{id};
342 my $old = $self->get_image($id);
343
344 if ($old) {
345 # replace it
346 BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols});
347
348 # lose the old file
349 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
350 unlink "$image_dir/$old->{filename}";
351 }
352 else {
353 # add it
354 # replace it
355 BSE::DB->run(addBSESiteuserImage => @image{@image_cols});
356 }
357}
358
359sub remove_image {
360 my ($self, $cfg, $id) = @_;
361
362 if (my $old = $self->get_image($id)) {
363 # remove the entry
364 BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id);
365
366 # lose the old file
367 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
368 unlink "$image_dir/$old->{filename}";
369 }
370}
371
af74f0b4
TC
372sub recalculate_subscriptions {
373 my ($self, $cfg) = @_;
374
375 require BSE::TB::Subscriptions;
376 my @subs = BSE::TB::Subscriptions->all;
377 for my $sub (@subs) {
378 $sub->update_user_expiry($self, $cfg);
379 }
380}
dfdeb4fe 381
9d576c12
TC
382sub subscribed_services {
383 my ($self) = @_;
384
385 BSE::DB->query(siteuserSubscriptions => $self->{id});
386}
387
6a8a6ac5
TC
388sub is_disabled {
389 my ($self) = @_;
390
391 return $self->{disabled};
392}
393
718a070d
TC
394sub seminar_sessions_booked {
395 my ($self, $seminar_id) = @_;
396
397 return map $_->{session_id},
398 BSE::DB->query(userSeminarSessionBookings => $seminar_id, $self->{id});
399}
400
efcc5a30
TC
401sub is_member_of {
402 my ($self, $group) = @_;
403
404 my $group_id = ref $group ? $group->{id} : $group;
405
406 my @result = BSE::DB->query(siteuserMemberOfGroup => $self->{id}, $group_id);
407
408 return scalar(@result);
409}
410
411sub group_ids {
412 my ($self) = @_;
413
414 map $_->{id}, BSE::DB->query(siteuserGroupsForUser => $self->{id});
415}
416
7aa0262a
TC
417sub allow_html_email {
418 my ($self) = @_;
419
420 !$self->{textOnlyMail};
421}
422
2076966c
TC
423sub seminar_bookings_detail {
424 my ($self) = @_;
425
426 BSE::DB->query(bse_siteuserSeminarBookingsDetail => $self->{id});
427}
428
d49667a2
TC
429sub wishlist {
430 my $self = shift;
431 require Products;
432 return Products->getSpecial(userWishlist => $self->{id});
433}
434
435sub wishlist_order {
436 my $self = shift;
437 return BSE::DB->query(bse_userWishlistOrder => $self->{id});
438}
439
440sub product_in_wishlist {
441 my ($self, $product) = @_;
442
443 grep $_->{product_id} == $product->{id}, $self->wishlist_order;
444}
445
446sub add_to_wishlist {
447 my ($self, $product) = @_;
448
449 return
450 eval {
451 BSE::DB->run(bse_addToWishlist => $self->{id}, $product->{id}, time());
452 1;
453 };
454}
455
456sub remove_from_wishlist {
457 my ($self, $product) = @_;
458
459 BSE::DB->run(bse_removeFromWishlist => $self->{id}, $product->{id});
460}
461
462sub _set_wishlist_order {
463 my ($self, $product_id, $display_order) = @_;
464
465 print STDERR "_set_wishlist_order($product_id, $display_order)\n";
466
467 BSE::DB->run(bse_userWishlistReorder => $display_order, $self->{id}, $product_id);
468}
469
470sub _find_in_wishlist {
471 my ($self, $product_id) = @_;
472
473 my @order = $self->wishlist_order;
474
475 my ($index) = grep $order[$_]{product_id} == $product_id, 0 .. $#order
476 or return;
477
478 return \@order, $index;
479}
480
481sub move_to_wishlist_top {
482 my ($self, $product) = @_;
483
484 my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
485 or return;
486 $move_index > 0
487 or return; # nothing to do
488
489 my $top_order = $order->[0]{display_order};
490 for my $index (0 .. $move_index-1) {
491 $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index+1]{display_order});
492 }
493 $self->_set_wishlist_order($product->{id}, $top_order);
494}
495
496sub move_to_wishlist_bottom {
497 my ($self, $product) = @_;
498
499 my ($order, $move_index) = $self->_find_in_wishlist($product->{id})
500 or return;
501 $move_index < $#$order
502 or return; # nothing to do
503
504 my $bottom_order = $order->[-1]{display_order};
505 for my $index (reverse($move_index+1 .. $#$order)) {
506 $self->_set_wishlist_order($order->[$index]{product_id}, $order->[$index-1]{display_order});
507 }
508 $self->_set_wishlist_order($product->{id}, $bottom_order);
509}
510
511sub move_down_wishlist {
512 my ($self, $product) = @_;
513
514 my ($order, $index) = $self->_find_in_wishlist($product->{id})
515 or return;
516 $index < $#$order
517 or return; # nothing to do
518
519 $self->_set_wishlist_order($product->{id}, $order->[$index+1]{display_order});
520 $self->_set_wishlist_order($order->[$index+1]{product_id}, $order->[$index]{display_order});
521}
522
523sub move_up_wishlist {
524 my ($self, $product) = @_;
525
526 my ($order, $index) = $self->_find_in_wishlist($product->{id})
527 or return;
528 $index > 0
529 or return; # nothing to do
530
531 $self->_set_wishlist_order($product->{id}, $order->[$index-1]{display_order});
532 $self->_set_wishlist_order($order->[$index-1]{product_id}, $order->[$index]{display_order});
533}
534
32696f84
TC
535# files owned specifically by this user
536sub files {
537 my ($self) = @_;
538
539 require BSE::TB::OwnedFiles;
540 return BSE::TB::OwnedFiles->getBy(owner_type => OWNER_TYPE,
541 owner_id => $self->id);
542}
543
544sub admin_group_files {
545 my ($self) = @_;
546
547 require BSE::TB::OwnedFiles;
548 return BSE::TB::OwnedFiles->getSpecial(userVisibleGroupFiles => $self->{id});
549}
550
551sub query_group_files {
552 my ($self, $cfg) = @_;
553
554 require BSE::TB::SiteUserGroups;
555 return
556 (
557 map $_->files, BSE::TB::SiteUserGroups->query_groups($cfg)
558 );
559}
560
561# files the user can see, both owned and owned by groups
562sub visible_files {
563 my ($self, $cfg) = @_;
564
565 return
566 (
567 $self->files,
568 $self->admin_group_files,
569 $self->query_group_files($cfg)
570 );
571}
572
573sub file_owner_type {
574 return OWNER_TYPE;
575}
576
577sub subscribed_file_categories {
578 my ($self) = @_;
579
580 return map $_->{category}, BSE::DB->query(siteuserSubscribedFileCategories => $self->{id});
581}
582
583sub set_subscribed_file_categories {
584 my ($self, $cfg, @new) = @_;
585
586 require BSE::TB::OwnedFiles;
587 my %current = map { $_ => 1 } $self->subscribed_file_categories;
588 my %new = map { $_ => 1 } @new;
589 my @all = BSE::TB::OwnedFiles->categories($cfg);
590 for my $cat (@all) {
591 if ($new{$cat->{id}} && !$current{$cat->{id}}) {
592 eval {
593 BSE::DB->run(siteuserAddFileCategory => $self->{id}, $cat->{id});
594 }; # a race condition might cause a duplicate key error here
595 }
596 elsif (!$new{$cat->{id}} && $current{$cat->{id}}) {
597 BSE::DB->run(siteuserRemoveFileCategory => $self->{id}, $cat->{id});
598 }
599 }
600}
601
589b789c 6021;