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