0.14_30 commit
[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);
af74f0b4 8use BSE::Util::SQL qw/now_datetime now_sqldate sql_normal_date/;
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
TC
23 customStr1 customStr2 customStr3
24 affiliate_name/;
b19047a6
TC
25}
26
27sub removeSubscriptions {
28 my ($self) = @_;
29
30 SiteUsers->doSpecial('removeSubscriptions', $self->{id});
589b789c
TC
31}
32
531fb3bc
TC
33sub removeSubscription {
34 my ($self, $subid) = @_;
35
36 SiteUsers->doSpecial('removeSub', $self->{id}, $subid);
37}
38
9063386f
TC
39sub generic_email {
40 my ($class, $checkemail) = @_;
41
42 # Build a generic form for the email - since an attacker could
43 # include comments or extra spaces or a bunch of other stuff.
44 # this isn't strictly correct, but it's good enough
45 1 while $checkemail =~ s/\([^)]\)//g;
46 if ($checkemail =~ /<([^>]+)>/) {
47 $checkemail = $1;
48 }
49 $checkemail = lc $checkemail;
50 $checkemail =~ s/\s+//g;
51
52 $checkemail;
53}
54
55sub subscriptions {
56 my ($self) = @_;
57
58 require BSE::SubscriptionTypes;
59 return BSE::SubscriptionTypes->getSpecial(userSubscribedTo => $self->{id});
60}
61
62sub send_conf_request {
63 my ($user, $cgi, $cfg, $rcode, $rmsg) = @_;
64
65 my $nopassword = $cfg->entryBool('site users', 'nopassword', 0);
66
67 # check for existing in-progress confirmations
68 my $checkemail = $user->generic_email($user->{email});
69
70 # check the blacklist
71 require BSE::EmailBlacklist;
72
73 # check that the from address has been configured
74 my $from = $cfg->entry('confirmations', 'from') ||
75 $cfg->entry('basic', 'emailfrom')|| $SHOP_FROM;
76 unless ($from) {
77 $$rcode = 'config';
78 $$rmsg = "Configuration Error: The confirmations from address has not been configured";
79 return;
80 }
81
82 my $blackentry = BSE::EmailBlacklist->getEntry($checkemail);
83
84 if ($blackentry) {
85 $$rcode = "blacklist";
86 $$rmsg = $blackentry->{why};
87 return;
88 }
89
90 unless ($user->{confirmSecret}) {
91 use BSE::Util::Secure qw/make_secret/;
92 # print STDERR "Generating secret\n";
93 $user->{confirmSecret} = make_secret($cfg);
94 $user->save;
95 }
96
97 # check for existing confirmations
220c179a 98 require BSE::EmailRequests;
9063386f
TC
99 my $confirm = BSE::EmailRequests->getBy(genEmail=>$checkemail);
100 if ($confirm) {
101 if ($confirm->{unackedConfMsgs} >= MAX_UNACKED_CONF_MSGS) {
102 $$rcode = 'toomany';
103 $$rmsg = "Too many confirmations have been sent to this email address";
104 return;
105 }
106 use BSE::Util::SQL qw/sql_datetime_to_epoch/;
107 my $lastSentEpoch = sql_datetime_to_epoch($confirm->{lastConfSent});
108 if ($lastSentEpoch + MIN_UNACKED_CONF_GAP > time) {
109 $$rcode = 'toosoon';
110 $$rmsg = "The last confirmation was sent too recently, please wait before trying again";
111 return;
112 }
113 }
114 else {
115 my %confirm;
116 my @cols = BSE::EmailRequest->columns;
117 shift @cols;
118 $confirm{email} = $user->{email};
119 $confirm{genEmail} = $checkemail;
120 # prevents silliness on error
121 use BSE::Util::SQL qw(sql_datetime);
122 $confirm{lastConfSent} = sql_datetime(time - MIN_UNACKED_CONF_GAP);
123 $confirm{unackedConfMsgs} = 0;
124 $confirm = BSE::EmailRequests->add(@confirm{@cols});
125 }
126
127 # ok, now we can send the confirmation request
128 my %confacts;
129 %confacts =
130 (
131 BSE::Util::Tags->basic(\%confacts, $cgi, $cfg),
132 user => sub { $user->{$_[0]} },
133 confirm => sub { $confirm->{$_[0]} },
134 remote_addr => sub { $ENV{REMOTE_ADDR} },
135 );
136 my $email_template =
137 $nopassword ? 'user/email_confirm_nop' : 'user/email_confirm';
138 my $body = BSE::Template->get_page($email_template, $cfg, \%confacts);
220c179a
TC
139
140 require BSE::Mail;
9063386f
TC
141 my $mail = BSE::Mail->new(cfg=>$cfg);
142 my $subject = $cfg->entry('confirmations', 'subject')
143 || 'Subscription Confirmation';
144 unless ($mail->send(from=>$from, to=>$user->{email}, subject=>$subject,
145 body=>$body)) {
146 # a problem sending the mail
147 $$rcode = "mail";
148 $$rmsg = $mail->errstr;
149 return;
150 }
151 ++$confirm->{unackedConfMsgs};
152 $confirm->{lastConfSent} = now_datetime;
153 $confirm->save;
154
155 return 1;
156}
157
6a8a205a
TC
158sub orders {
159 my ($self) = @_;
160
3c32512d 161 require BSE::TB::Orders;
6a8a205a 162
3c32512d 163 return BSE::TB::Orders->getBy(userId => $self->{userId});
6a8a205a
TC
164}
165
af74f0b4
TC
166sub _user_sub_entry {
167 my ($self, $sub) = @_;
168
169 my ($entry) = BSE::DB->query(userSubscribedEntry => $self->{id},
170 $sub->{subscription_id})
171 or return;
172
173 return $entry;
174}
175
0ec4ac8a
TC
176# check if the user is subscribed to the given subscription
177sub subscribed_to {
178 my ($self, $sub) = @_;
179
af74f0b4
TC
180 my $entry = $self->_user_sub_entry($sub)
181 or return;
182
183 my $today = now_sqldate;
184 my $end_date = sql_normal_date($entry->{end});
185 return $today le $end_date;
0ec4ac8a
TC
186}
187
188# check if the user is subscribed to the given subscription, and allow
189# for the max_lapsed grace period
190sub subscribed_to_grace {
191 my ($self, $sub) = @_;
192
af74f0b4
TC
193 my $entry = $self->_user_sub_entry($sub)
194 or return;
195
196 my $today = now_sqldate;
197 my $end_date = sql_add_date_days($entry->{end}, $entry->{max_lapsed});
198 return $today le $end_date;
0ec4ac8a
TC
199}
200
dfdeb4fe
TC
201my @image_cols =
202 qw(siteuser_id image_id filename width height bytes content_type alt);
203
204sub images_cfg {
205 my ($self, $cfg) = @_;
206
207 my @images;
208 my %ids = $cfg->entries('BSE Siteuser Images');
209 for my $id (keys %ids) {
210 my %image = ( id => $id );
211
212 my $sect = "BSE Siteuser Image $id";
213 for my $key (qw(description help minwidth minheight maxwidth maxheight
214 minratio maxratio properror
215 widthsmallerror heightsmallerror smallerror
216 widthlargeerror heightlargeerror largeerror
217 maxspace spaceerror)) {
218 my $value = $cfg->entry($sect, $key);
219 if (defined $value) {
220 $image{$key} = $value;
221 }
222 }
223 push @images, \%image;
224 }
225
226 @images;
227}
228
229sub images {
230 my ($self) = @_;
231
232 BSE::DB->query(getBSESiteuserImages => $self->{id});
233}
234
235sub get_image {
236 my ($self, $id) = @_;
237
238 my ($image) = BSE::DB->query(getBSESiteuserImage => $self->{id}, $id)
239 or return;
240
241 $image;
242}
243
244sub set_image {
245 my ($self, $cfg, $id, $image) = @_;
246
247 my %image = %$image;
248 $image{siteuser_id} = $self->{id};
249 my $old = $self->get_image($id);
250
251 if ($old) {
252 # replace it
253 BSE::DB->run(replaceBSESiteuserImage => @image{@image_cols});
254
255 # lose the old file
256 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
257 unlink "$image_dir/$old->{filename}";
258 }
259 else {
260 # add it
261 # replace it
262 BSE::DB->run(addBSESiteuserImage => @image{@image_cols});
263 }
264}
265
266sub remove_image {
267 my ($self, $cfg, $id) = @_;
268
269 if (my $old = $self->get_image($id)) {
270 # remove the entry
271 BSE::DB->run(deleteBSESiteuserImage => $self->{id}, $id);
272
273 # lose the old file
274 my $image_dir = $cfg->entryVar('paths', 'siteuser_images');
275 unlink "$image_dir/$old->{filename}";
276 }
277}
278
af74f0b4
TC
279sub recalculate_subscriptions {
280 my ($self, $cfg) = @_;
281
282 require BSE::TB::Subscriptions;
283 my @subs = BSE::TB::Subscriptions->all;
284 for my $sub (@subs) {
285 $sub->update_user_expiry($self, $cfg);
286 }
287}
dfdeb4fe 288
589b789c 2891;