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