Pm/User.pm
Copying Source is Forbidden
1740 lines of code
1
package User;
2
3
#/
4
# Encapsulates all user related functions
5
# these routines do NOT require a DBH
6
# the DB is connected to automagically!
7
# <hr>All HTML should be removed from this
8
# module and moved into Html2.pm! This
9
# module's intent is solely for data
10
# retrieval.
11
#
12
# CHANGE LOG
13
# ==========
14
# May 4, 2021
15
# - Added Change Log
16
# - Modified module description a little
17
#/
18
19
20
21
##########################
22
use strict;
23
use warnings;
24
use CGI::Carp qw(fatalsToBrowser);
25
use URI::Escape;
26
require Exporter;
27
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT);
28
##########################
29
30
31
32
##########################
33
our $VERSION = 1.00;
34
our @ISA = qw(Exporter);
35
36
our @EXPORT = qw(
37
get_user_stat
38
isUserAdmin
39
isUserModerator
40
isUserSuperAdmin
41
$USER_DATA
42
);
43
44
our @EXPORT_OK = qw(
45
_tests
46
47
blockedUser
48
49
check_user_stats
50
51
get_uid_byEmail
52
get_uid_byNickname
53
54
get_user_age
55
get_user_blocked_users
56
get_user_city
57
get_user_country
58
get_user_dp
59
get_user_dpID
60
get_user_flags
61
get_user_flag_count
62
get_user_friend_requests
63
get_user_friends
64
get_user_fuck_alert_count
65
get_user_inventory
66
get_user_message
67
get_user_messages
68
get_user_pic
69
get_user_pics
70
get_user_points
71
get_user_stat
72
get_user_stats
73
get_user_stats_asIcons
74
get_user_subscription_info
75
get_user_subscription_type
76
get_user_theme
77
get_user_theme_data
78
get_user_unread_messages
79
80
get_users_emails
81
get_users_nicknames
82
83
isFriend
84
isFriendRequestIgnored
85
isFriendRequestPending
86
isThemePurchased
87
88
isUser
89
isUserAdmin
90
isUserBday
91
isUserBeta
92
isUserModerator
93
isUserSubscriber
94
isUserSuperAdmin
95
96
set_user_stats
97
set_user_theme
98
99
user_paid_expired
100
101
nickname_in_use
102
valid_email
103
104
$ISADMIN
105
$ISMODERATOR
106
$USER_DATA
107
$THEME_DATA
108
$DEBUGGER_ALLOWED
109
);
110
##########################
111
112
use lib "./";
113
#require Bc_sql; # qw(user_exists);
114
use Bc_sql qw(user_exists);
115
116
##########################
117
118
119
our $ISADMIN;
120
our $ISMODERATOR;
121
our $USER_DATA;
122
our $THEME_DATA;
123
our $DEBUGGER_ALLOWED;
124
125
;sub isUserAdmin(;$$$);
126
;sub isUserModerator(;$);
127
;sub isFriend($;$);
128
;sub get_user_stats(;$);
129
130
{
131
# ok, let's setup some common stuff
132
$ISADMIN = isUserAdmin($Bc_sql::LOGGEDIN);
133
$ISMODERATOR = isUserModerator($Bc_sql::LOGGEDIN);
134
my %ud = get_user_stats($Bc_sql::LOGGEDIN);
135
$USER_DATA = \%ud;
136
$THEME_DATA = &get_user_theme_data($USER_DATA->{TID}, 1);
137
$DEBUGGER_ALLOWED = Bc_sql::is_debuggerAllowed($Bc_sql::LOGGEDIN);
138
}
139
140
141
142
##########################
143
##########################
144
##########################
145
##########################
146
##########################
147
##########################
148
##########################
149
##########################
150
151
sub get_user_age($) {
152
#*
153
# calculates a user's age
154
#*
155
my ($uid) = @_; # a uid
156
my $rv = 0;
157
158
if (Bc_sql::user_exists($uid)) {
159
my %ustats;
160
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
161
{ %ustats = %$USER_DATA; } else
162
{ %ustats = get_user_stats($uid); }
163
164
if ($ustats{ID} eq $uid) {
165
my ($today_yr, $today_mon, $today_day) = split("-", Date::get_today("db", 0));
166
my ($bday_yr, $bday_mon, $bday_day) = split("-", $ustats{dob});
167
my $age = $today_yr - $bday_yr;
168
if ($bday_mon > $today_mon) {
169
$age--;
170
} else {
171
if ($bday_mon eq $today_mon and $bday_day > $today_day) { $age--; }
172
}
173
174
$rv = $age;
175
} else {
176
$rv = -1;
177
}
178
}
179
180
return $rv; # a number
181
#usage: if (user_age($uid) > 234) { error_redir("/", "you ain't older than 234, buddy! lol"); }
182
}
183
184
##########################
185
sub get_user_blocked_users(;$) {
186
#*
187
# gets a list of blocked users for the specified user
188
# can return an empty array
189
#*
190
my ($uid) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN)
191
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
192
if (not $uid) { $uid = ""; }
193
194
my @blocks = ();
195
my $results = Bc_sql::sql_execute("select BID from blocks where UID = " . $Bc_sql::DB->quote($uid), "User.pm - get user blocked users"); # could be a single hash ref, or a ref to an array
196
if (ref $results eq "HASH") {
197
if (Bc_sql::user_exists($results->{BID}) and not Security::banned($results->{BID})) { push @blocks, $results->{BID}; }
198
} elsif (ref $results eq "ARRAY") {
199
foreach my $ref (@$results) {
200
if (Bc_sql::user_exists($ref->{BID}) and not Security::banned($ref->{BID})) { push @blocks, $ref->{BID}; }
201
}
202
}
203
204
return @blocks; # an array of blocked uid's
205
#usage: my @blocked_users = get_user_blocked_users($uid);
206
}
207
208
##########################
209
sub get_user_city($) {
210
#*
211
# returns a user's city ID only
212
#*
213
my ($uid) = @_; # a uid
214
my $loc = get_user_stat($uid, "location", "city");
215
$loc =~ s/(.)*\.//;
216
217
return $loc; # a city ID only
218
#usage: if (get_user_city($uid) eq $searchCityID) { ... }
219
}
220
221
##########################
222
sub get_user_country($) {
223
#*
224
# returns a user's country ID only
225
#*
226
my ($uid) = @_; # a uid
227
my $loc = get_user_stat($uid, "location", "country");
228
$loc =~ s/\.(.)*//;
229
230
return $loc; # a country ID only
231
#usage: if (get_user_country($uid) eq $searchCountryID) { ... }
232
}
233
234
########################
235
sub get_user_dp(;$$) {
236
#*
237
# gets just the location of the DP img for the specified user
238
#*
239
my ($uid, $size) = @_; # the uid to look up (optional, default = $Bc_sql::LOGGEDIN) && a size (default = 0 = dp)
240
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
241
if (not $uid) { $uid = ""; }
242
if (not $size) { $size = "dp"; }
243
my $id = get_user_dpID();
244
my %img;
245
$img{tag} = "img";
246
247
if ($id > 0) {
248
if ($size eq "dp") { $size = 2; }
249
if ($size eq "s") { $size = 3; }
250
251
$img{src} = "/getimage.pl?id=$id&th=$size";
252
} else {
253
if (Bc_sql::user_exists($uid)) {
254
if (get_user_stat($uid, "gender", "") eq 1)
255
{ $img{src} = "/img.pl?i=site/default_boy.png&s=$size"; } else
256
{ $img{src} = "/img.pl?i=site/default_girl.png&s=$size"; }
257
} else {
258
# this shouldn't actually happen
259
$img{src} = "/img.pl?i=site/default_guest.png&s=$size";
260
}
261
}
262
263
return Html2::tag(\%img); # an image location (eg: default_boy.png)
264
#usage: my $dp = get_user_dp($uid);
265
}
266
267
##########################
268
sub get_user_flags(;$$) {
269
#*
270
# grab a list of active flags for a given uid
271
# optionally include inactive/resolved/deleted flags
272
#*
273
my ($uid, $alltime) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN) && show all flags (option, default 0 = no)
274
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
275
if (not $uid) { $uid = ""; }
276
277
my $sql = "select * from flagged where";
278
279
if (not $alltime) {
280
$sql .= " not status='trashed'" .
281
" and not status='invalid'" .
282
" and not status='msg1'" .
283
" and not status='msg2'" .
284
" and not status='msg3'" .
285
" and";
286
}
287
288
$sql .= " UID=" . $Bc_sql::DB->quote($uid);
289
my $rv = Bc_sql::sql_execute($sql, "", 1); # always returns an array reference!
290
291
if (@$rv == 0) { $rv = undef; }
292
293
return $rv; # an array reference, or undef
294
#usage: my $flagList = get_user_flags($uid);
295
}
296
297
##########################
298
sub get_user_flag_count($;$$$) {
299
#*
300
# gets a number of flags the specified user has
301
# for a particular KIND of flag, or all flags
302
#
303
# valid values for $type are:
304
# n = nickname
305
# d = description
306
# i = img
307
# m = message
308
# anything else is ignored and retrieves
309
# all flags for the specified user (default)
310
#
311
# valid values for $rtype are:
312
# c = flag count (default)
313
# d = all flag data as a hash reference
314
#*
315
my ($uid, $type, $rtype, $includeHidden) = @_; # the uid to look up && type of flag to seek && return type && include hidden (default: 0 = no)
316
if (not $rtype) { $rtype = "c"; }
317
$type = lc $type;
318
$rtype = lc $rtype;
319
my $rv = 0;
320
my $count = 0;
321
322
if (Bc_sql::user_exists($uid)) {
323
my $sql = "select * from flagged where UID=" . $Bc_sql::DB->quote($uid);
324
if ($type eq "n" or $type eq "d" or $type eq "i" or $type eq "m") { $sql .= " and type=" . $Bc_sql::DB->quote($type); }
325
if (not $includeHidden) { $sql .= " and not status='trashed' and not status='invalid' and not status='rectified'"; }
326
327
my $results = Bc_sql::sql_execute($sql, "User.pm - get_user_flag_count(\"$uid\", \"$type\", \"$rtype\", \"$includeHidden\")");
328
329
if ($rtype eq "c") {
330
if (ref $results eq "HASH")
331
{ $count = 1; } else
332
{ $count = @$results; }
333
334
$rv = $count;
335
} else {
336
if (ref $results eq "HASH") {
337
my @arr = ();
338
push @arr, $results;
339
$rv = \@arr;
340
} else {
341
$rv = $results;
342
}
343
}
344
}
345
346
return $rv; # a sum of flags for requested type
347
#usage: my $c = get_user_flag_count($Bc_sql::LOGGEDIN, "all");
348
}
349
350
##########################
351
sub get_user_friend_requests(;$) {
352
#*
353
# gets a list of UID's who have
354
# added $Bc_sql::LOGGEDIN to their list(s)
355
356
# !this function is not yet completed!
357
358
# you may optionally override $Bc_sql::LOGGEDIN
359
# by assigning a value to $uid
360
#*
361
my ($uid) = @_; # a uid
362
if ($Bc_sql::LOGGEDIN and not $uid) { $uid = $Bc_sql::LOGGEDIN; }
363
if (not $uid) { $uid = ""; }
364
my @requests = ();
365
366
# so, find user's who have $uid on their list
367
# and filter those for who are not on $uid's list!
368
my $sql = "select * from friends where FID = " . $Bc_sql::DB->quote($uid);
369
my $ref = Bc_sql::sql_execute($sql, "User.pm - get user friend requests");
370
371
# okay, got the list (even if it is empty)
372
if (ref $ref eq "HASH") {
373
# one request
374
# check if $ref->{UID} is NOT a friend of $uid
375
if (not isFriend($uid, $ref->{UID})) {
376
# add them to the requests list but
377
# only if that friend has NOT declined the request!
378
if ($ref->{declined} eq 1) { push @requests, $ref->{UID}; }
379
}
380
} elsif (ref $ref eq "ARRAY") {
381
# zero, two or more requests
382
if (@$ref) {
383
foreach my $fidref (@$ref) {
384
if (not isFriend($uid, $fidref->{UID})) {
385
# add them to the requests list but
386
# only if that friend has NOT declined the request!
387
if ($fidref->{declined} eq 1) { push @requests, $fidref->{UID}; }
388
}
389
}
390
}
391
} else {
392
# this ... can't happen ...
393
push @requests, "major fuckin glitch!";
394
}
395
396
return @requests; # an array of uid's
397
#usage: my @fr = get_user_friend_requests($uid);
398
}
399
400
##########################
401
sub get_user_fuck_alert_count($;$) {
402
#*
403
# returns a number of FMA's on file (reciprocated and/or unreciprocated) for the specified UID
404
# set $allTime to 0 to count unreciprocated FMA's only
405
# set $allTime to 1 to count all FMA's ever received (whether reciprocated or not!)
406
# !will return 0 if Bc_sql::user_exists($uid) returns 0
407
#*
408
my ($uid, $allTime) = @_; # a uid && set to 1 to count received FMAs (optional)
409
410
my $rv = 0;
411
412
if (Bc_sql::user_exists($uid)) {
413
my $sql = "select * from fuck_alerts where to_UID = " . $Bc_sql::DB->quote($uid);
414
if (not $allTime) { $sql .= " and reciprocated = '1'"; }
415
my $results = Bc_sql::sql_execute($sql, "User.pm - get user fuck alert count"); # will result in either an array ref, or a hash ref
416
if (ref $results eq "HASH") { $rv = 1; } else { $rv = @$results; }
417
}
418
419
return $rv; # a number >= 0
420
421
#usage: my $lifeTime_numFuckAlerts = get_user_fuck_alert_count($uid, 1);
422
}
423
424
##########################
425
sub get_user_inventory($) {
426
#*
427
# returns a list of items in the user's inventory
428
# each element will be an ID to their items
429
#*
430
my ($uid) = @_; # a uid
431
432
my @inventory = ();
433
434
if (Bc_sql::user_exists($uid)) {
435
my $sql = "select GID, quantity from purchased_gifts where UID=" . $Bc_sql::DB->quote($uid);
436
my $results = Bc_sql::sql_execute($sql, "User.pm - get user inventory"); # will result in either an array ref, or a hash ref
437
if (ref $results eq "HASH") {
438
push @inventory, "$results->{GID}=$results->{quantity}";
439
} else {
440
if (@$results) {
441
foreach my $item (@$results) {
442
push @inventory, "$item->{GID}=$item->{quantity}";
443
}
444
}
445
}
446
}
447
448
return @inventory; # a list of items (can be empty)
449
#usage: my $inventory = get_user_inventory($uid);
450
}
451
452
##########################
453
sub get_user_pic(;$$$) {
454
#*
455
# gets the user's display picture as an html img tag
456
# where $iconic can be: i = 24x27px, t = 12x13px
457
#*
458
my ($uid, $iconic, $spacing) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN) && whether to display as an icon, or DP (optional) && spacing for pretty printing HTML output (optional)
459
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
460
if (not $uid) { $uid = ""; }
461
if (not $spacing) { $spacing = 0; }
462
463
# if iconic = 1, then display as an icon.
464
# otherise, display as a display picture
465
my $img;
466
467
# picture dimensions when shown as a dp
468
my $width = 35;
469
my $height = 35;
470
471
if ($iconic eq "i") {
472
# dimensions for icon sized dp
473
$width = 24;
474
$height= 27;
475
} elsif ($iconic eq "t") {
476
# dimensions for tiny icon sized dp
477
$width = 12;
478
$height= 13;
479
}
480
481
# now, get the user's dp
482
my $sql = "select * from images where UID=" . $Bc_sql::DB->quote($uid) . " and dp='2'";
483
my $ref = Bc_sql::sql_execute($sql, "get user pic");
484
my $g = get_user_stat($uid, "gender");
485
my $gender = Bc_sql::get_gender_asWord($g);
486
if (ref $ref eq "HASH") {
487
# user has a dp, send that...
488
# but first, see if it's "flagged" or not
489
my $fid = is_flagged($uid, $ref->{ID}, "i");
490
if (not $fid) {
491
$img = "<img src=\"/getimage.pl?id=$ref->{ID}\" width=$width height=$height alt=\"$gender\" title=\"$gender\">";
492
} else {
493
if ($g eq 1) {
494
# boy
495
$img = "<img src=\"/images/" . Bc_sql::get_constant("IMAGE_BOY") . "\" width=$width height=$height alt=\"$gender\" title=\"$gender\">";
496
} else {
497
# girl
498
$img = "<img src=\"/images/" . Bc_sql::get_constant("IMAGE_GIRL") . "\" width=$width height=$height alt=\"$gender\" title=\"$gender\">";
499
}
500
}
501
} else {
502
# user has no dp, return a gender based image
503
if (get_user_stat($uid, "gender") eq 1) {
504
# boy
505
$img = "<img src=\"/images/" . Bc_sql::get_constant("IMAGE_BOY") . "\" width=$width height=$height alt=\"$gender\" title=\"$gender\">";
506
} else {
507
# girl
508
$img = "<img src=\"/images/" . Bc_sql::get_constant("IMAGE_GIRL") . "\" width=$width height=$height alt=\"$gender\" title=\"$gender\">";
509
}
510
}
511
512
if ($spacing) { $img = $spacing . $img; }
513
514
return $img; # an html <img> element
515
#usage: my $uPic = get_user_pic($uid);
516
}
517
518
##########################
519
sub get_user_dpID(;$) {
520
#*
521
# returns the specified user's display picture ID
522
#*
523
my ($uid) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN)
524
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
525
if (not $uid) { $uid = ""; }
526
my $rv = 0;
527
528
my $sql = "select * from images where UID=" . $Bc_sql::DB->quote($uid) . " and dp='2'";
529
my $pic = Bc_sql::sql_execute($sql, "sql::get user dpID");
530
if (ref $pic eq "HASH") { $rv = $pic->{ID}; }
531
532
return $rv; # a picture ID, or 0
533
#usage: my $uPicID = get_user_idID($uid);
534
}
535
536
##########################
537
sub get_user_pics(;$) {
538
#*
539
# returns an array of the specified user's pics
540
# each element will be a hash ref to pic data
541
# will not check if UID is valid
542
# may return an empty array
543
#*
544
my ($uid) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN)
545
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
546
if (not $uid) { $uid = ""; }
547
my @rv;
548
549
my $sql = "select * from images where UID=" . $Bc_sql::DB->quote($uid);
550
my $results = Bc_sql::sql_execute($sql, "getuser_pics");
551
552
if (ref $results eq "HASH") {
553
@rv = ($results);
554
} else {
555
@rv = @$results;
556
}
557
558
return @rv; # an array (can be empty)
559
#usage: my @picsList = get_user_pics("123abc");
560
}
561
562
##########################
563
sub get_user_points(;$) {
564
#*
565
# returns the users total liquidatable points
566
#*
567
my ($uid) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN);
568
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
569
if (not $uid) { $uid = ""; }
570
my $rv = 0;
571
572
if (Bc_sql::user_exists($uid)) {
573
my $sql = "select points from coins where ID=" . $Bc_sql::DB->quote($uid);
574
my $ref = Bc_sql::sql_execute($sql, "get user points");
575
if (ref $ref eq "HASH") { $rv = $ref->{points}; }
576
}
577
578
return $rv; # a number
579
#usage: my $upoints = get_user_points("123abc");
580
}
581
582
##########################
583
sub get_user_stat($$;$) {
584
#*
585
# gets a single user stat
586
#*
587
my ($uid, $stat, $stat_part) = @_; # a uid && the stat to retrieve && an optional stat "part" (like DOB month or year)
588
my $rv = 0;
589
590
if (Bc_sql::user_exists($uid)) {
591
my %ustats;
592
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
593
{ %ustats = %$USER_DATA; } else
594
{ %ustats = get_user_stats($uid); }
595
596
if ($ustats{$stat}) {
597
my $info = $ustats{$stat};
598
if ($stat_part) {
599
# generally, this will be used to extract a month, day, or year from a date (like a DOB) or city/country
600
# format in DB is: 1976-01-19 (year, month, day);
601
if ($stat_part eq "doby" or $stat_part eq "country") { $info =~ s/-(.)*//; }
602
if ($stat_part eq "dobm") { $info =~ s/[0-9][0-9][0-9][0-9]-//; $info =~ s/-(.)*//; }
603
if ($stat_part eq "dobd") { $info =~ s/^[0-9][0-9][0-9][0-9]-[0-9][0-9]-//; }
604
if ($stat_part eq "city") { $info =~ s/(.)*-//; }
605
}
606
607
$rv = $info;
608
}
609
}
610
611
#if ($rv eq 0) { $rv .= " - $uid"; }
612
return $rv; # a hash reference to the stat info, or 0 on failure
613
#usage: my $stat = get_user_stat($uid, "gender');
614
}
615
616
##########################
617
sub get_user_stats(;$) {
618
#*
619
# retrieves user data
620
# some "fields" will be URI encoded (@ symbols converted to %40, for instance)
621
# empty hash is possible
622
# i have no idea why $uid appears twice under "when"!
623
# returns a hash
624
#*
625
my ($uid) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN)
626
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
627
if (not $uid) { $uid = ""; }
628
my %rv;
629
630
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH") {
631
%rv = %$USER_DATA;
632
} else {
633
if (Bc_sql::user_exists($uid)) {
634
my $results = Bc_sql::sql_execute("select * from users where ID=" . $Bc_sql::DB->quote($uid), "get_user_stats($uid)");
635
if (ref $results eq "HASH") {
636
%rv = %$results;
637
}
638
}
639
}
640
641
return %rv; # a hash of user stats (like dob, security level, etc)
642
#usage: my %ustats = get_user_stats($uid);
643
}
644
645
##########################
646
sub get_user_stats_asIcons(;$$$) {
647
#*
648
# builds a string of icons (in HTML) reflecting some user stats
649
# eg: gender, zodiac, and join date (if less than a week old)
650
#*
651
my ($uid, $spacing, $break) = @_; # a uid && spacing for pretty printing HTML output && insert <br> between icons
652
if (not Bc_sql::user_exists($uid)) {
653
my $error = $Bc_sql::ERRORS{ERROR_INVALID_USER}->{code};
654
return $error; # an invalid user error
655
}
656
my $output = "";
657
658
if (get_user_stat($uid, "gender") eq 2) {
659
$output .= "<img src=\"/img.pl?i=" . Bc_sql::get_constant("IMAGE_FEMALE_ICON") . "&s=ss\" title=\"Gal\">";
660
} else {
661
$output .= "<img src=\"/img.pl?i=" . Bc_sql::get_constant("IMAGE_MALE_ICON") . "&s=ss\" title=\"Guy\">";
662
}
663
664
if ($break) { $output .= "<br>"; }
665
$output .= Date::determine_zodiac(get_user_stat($uid, "dob"), "i");
666
667
#my $jd = get_user_stat($uid, "enrolled");
668
#$jd = minus_date($jd, 7, "d");
669
#if ($break) { $output .= "<br>"; }
670
671
$output .= "\n";
672
return $output; # a scalar
673
#usage: my $statsAsIcons = get_user_stats_asIcons
674
}
675
676
##########################
677
sub get_user_subscription_info($) {
678
#*
679
# gathers subscription info into a hash. keys will be:
680
# enrolled, subscriber, subscription_date,
681
# subscription_type
682
#*
683
my ($uid) = @_; # a uid
684
my %rv = {};
685
686
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH") {
687
$rv{enrolled} = $USER_DATA->{enrolled};
688
$rv{subscriber} = $USER_DATA->{subscriber};
689
$rv{subscription_data} = $USER_DATA->{subscription_date};
690
$rv{subscription_type} = $USER_DATA->{subscription_type};
691
} else {
692
my $sql = "select enrolled, subscriber, subscription_date, subscription_type from users where ID=" . $Bc_sql::DB->quote($uid);
693
my $ref = Bc_sql::sql_execute($sql, "User.pm - get user subscription info");
694
if (ref $ref eq "HASH") { %rv = %$ref; }
695
}
696
697
return %rv; # a hash (can be empty)
698
#usage: my %subinfo = get_user_subscription_info($uid);
699
}
700
701
##########################
702
sub get_user_subscription_type($) {
703
#*
704
# determines subscription type
705
#*
706
my ($uid) = @_; # a uid
707
if (Bc_sql::user_exists($uid)) {
708
my %ustats;
709
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
710
{ %ustats = %$USER_DATA; } else
711
{ %ustats = get_user_stats($uid); }
712
713
if ($ustats{paid} eq "no") {
714
return 0; # 0 if uid is not a subscriber
715
}
716
my @paid = split($ustats{paid}, ";");
717
if ($paid[0] eq "m") {
718
return "m"; # 'm' if a monthly subscriber
719
}
720
if ($paid[0] eq "y") {
721
return "y"; # 'y' if a yearly subscriber
722
}
723
} else {
724
return 0; # when UID not valid
725
}
726
#usage: my $subtype = get_user_subscription_type($uid);
727
}
728
729
########################
730
sub get_user_theme_data(;$$) {
731
#*
732
# gets a user's theme data
733
#*
734
my ($uid, $asRef) = @_; # a uid (optional, default = $Bc_sql::LOGGEDIN) && rv as reference to hash
735
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
736
if (not $uid) {
737
return 0; # 0 when $Bc_sql::LOGGEDIN == 0
738
}
739
my $rv;
740
741
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH") {
742
if (ref $THEME_DATA eq "HASH") { $rv = Bc_sql::get_theme_data($USER_DATA->{TID}); }
743
} else {
744
my $utid = get_user_stat($USER_DATA->{TID}, "TID");
745
my $data = Bc_sql::get_theme_data($utid);
746
if (ref $data eq "HASH") {
747
$rv = $data;
748
} else {
749
$data = Bc_sql::get_theme_data(Bc_sql::get_default_theme($USER_DATA->{TID}));
750
if (ref $data eq "HASH") {
751
$rv = $data;
752
}
753
}
754
}
755
756
if ($asRef) {
757
return $rv; # a hash reference to theme data
758
} else {
759
return %$rv; # a hash of theme data
760
}
761
#usage: my %theme = get_user_theme_data($uid);
762
}
763
764
##########################
765
##########################
766
##########################
767
##########################
768
##########################
769
##########################
770
##########################
771
##########################
772
773
##########################
774
sub get_users_emails() {
775
#*
776
# retrieves a list of <b>all</b> users email addresses
777
# !use with caution
778
#*
779
#@_; # (no parameters)
780
my @users = Bc_sql::get_users(1);
781
my @emails;
782
foreach my $uid (@users) {
783
push @emails, get_user_stat($uid, "email");
784
}
785
786
return @emails; # a list of all user emails (including admins)
787
#usage: my @userEmails = get_users_emails();
788
}
789
790
##########################
791
sub get_users_nicknames() {
792
#*
793
# retrieves a list of all users nicknames (including admins)
794
#*
795
#@_; # (no parameters)
796
my @users = Bc_sql::get_users(1);
797
my @nn;
798
foreach my $uid (@users) {
799
push @nn, get_user_stat($uid, "nickname");
800
}
801
802
return @nn; # a list of all user names (inlcuding admins)
803
#usage: my @userNN = get_users_nicknames();
804
}
805
806
##########################
807
sub get_uid_byEmail($) {
808
#*
809
# gets a user's ID using the supplied email address
810
# this function will not sanitize the parameters
811
# the sql command will be sanitized for sql injections, tho
812
#*
813
my ($e) = @_; # an email address
814
my $rv = 0;
815
my $sql = "select ID from users where email like " . $Bc_sql::DB->quote($e);
816
my $id = Bc_sql::sql_execute($sql, "User.pm - get uid by email");
817
818
if (ref $id ne "ARRAY") { $rv = $id->{ID}; }
819
820
return $rv; # 0 on failure, ID on success
821
#usage: my $uid = get_uid_byEmail('bob@host.tld');
822
}
823
824
##########################
825
sub get_uid_byNickname($) {
826
#*
827
# gets a user's ID using the supplied nickname
828
# casing is ignored
829
#*
830
my ($nn) = @_; # a nickname
831
my $rv = 0;
832
my $sql = "select ID from users where nickname like '$nn'";
833
my $id = Bc_sql::sql_execute($sql, "User.pm - get_uid_byNickname");
834
if (ref $id eq "HASH") { $rv = $id->{ID}; }
835
836
return $rv; # 0 on failure, ID on success
837
#usage: my $uid = get_uid_byNickname('bob');
838
}
839
840
##########################
841
sub set_user_theme($) {
842
#*
843
# sets the user's theme ID to $tid
844
#*
845
my ($tid) = @_; # a theme ID
846
my $rv = 0;
847
my $DEBUG_THIS = 0;
848
849
if (theme_exists($tid)) {
850
my $sql = "update users set TID=" . $Bc_sql::DB->quote($tid);
851
$sql .= " where ID=" . $Bc_sql::DB->quote($Bc_sql::LOGGEDIN);
852
853
if ($DEBUG_THIS) {
854
$rv = $tid . "\n";
855
} else {
856
if (sql_execute($sql, "User.pm - set user theme($tid)")) {
857
$rv = $tid;
858
}
859
}
860
} else {
861
if ($DEBUG_THIS) {
862
$rv = $tid . "\n";
863
}
864
}
865
866
return $rv; # 0 on failure, $tid on success
867
#usage: if (set_user_theme('bob')) { print notice_redir(referrer(), "tid update successful"); }
868
}
869
870
##########################
871
sub set_user_stats($) {
872
#*
873
# sets ALL of a user's stats
874
#*
875
my ($statsRef) = @_; # a reference to a hash of user data
876
my $rv = 0;
877
878
if (ref $statsRef eq "HASH") {
879
if (Bc_sql::user_exists($statsRef->{ID})) {
880
# ensure the provided nickname is not already taken by ANOTHER uid (not this UID)
881
# ensure the provided email is not already taken by ANOTHER uid (not this UID)
882
my $inuse = nickname_in_use($statsRef->{nickname});
883
884
if ($inuse ne 0 and $inuse ne $statsRef->{ID}) {
885
# nickname taken by UID other than $statsRef->{ID}
886
return get_error("USER_NICKNAME_TAKEN", "n", "d"); # an error when nickname in use
887
}
888
889
# make sure the data provided is valid.
890
# then 'update' that data in the db.
891
my $checkstats = check_user_stats($statsRef);
892
my %origStats = get_user_stats($statsRef->{ID});
893
if ($checkstats) {
894
my $sql = "update users set";
895
if ($statsRef->{nickname} ne $origStats{nickname}) { $sql .= " nickname=" . $Bc_sql::DB->quote($statsRef->{nickname}) . ","; }
896
if ($statsRef->{email} ne $origStats{email}) { $sql .= " email=" . $Bc_sql::DB->quote($statsRef->{email}) . ","; }
897
$sql .= " dob=" . $Bc_sql::DB->quote($statsRef->{dob}) . ",";
898
$sql .= " showbday=" . $Bc_sql::DB->quote($statsRef->{showbday}) . ",";
899
$sql .= " lastip=" . $Bc_sql::DB->quote($statsRef->{lastip}) . ",";
900
$sql .= " password=" . $Bc_sql::DB->quote($statsRef->{password}) . ",";
901
$sql .= " race=" . $Bc_sql::DB->quote($statsRef->{race}) . ",";
902
$sql .= " gender=" . $Bc_sql::DB->quote($statsRef->{gender}) . ",";
903
$sql .= " location=" . $Bc_sql::DB->quote($statsRef->{location}) . ",";
904
$sql .= " orientation=" . $Bc_sql::DB->quote($statsRef->{orientation}) . ",";
905
$sql .= " drugs=" . $Bc_sql::DB->quote($statsRef->{drugs}) . ",";
906
$sql .= " wheels=" . $Bc_sql::DB->quote($statsRef->{wheels}) . ",";
907
$sql .= " can_host=" . $Bc_sql::DB->quote($statsRef->{can_host}) . ",";
908
$sql .= " drinker=" . $Bc_sql::DB->quote($statsRef->{drinker}) . ",";
909
$sql .= " smoker=" . $Bc_sql::DB->quote($statsRef->{smoker}) . ",";
910
$sql .= " seeking=" . $Bc_sql::DB->quote($statsRef->{seeking}) . ",";
911
$sql .= " seeking_gender=" . $Bc_sql::DB->quote($statsRef->{seeking_gender}) . ",";
912
$sql .= " erection=" . $Bc_sql::DB->quote($statsRef->{erection}) . ",";
913
$sql .= " bust=" . $Bc_sql::DB->quote($statsRef->{bust}) . ",";
914
$sql .= " eye_clr=" . $Bc_sql::DB->quote($statsRef->{eye_clr}) . ",";
915
$sql .= " hair_clr=" . $Bc_sql::DB->quote($statsRef->{hair_clr}) . ",";
916
$sql .= " weight=" . $Bc_sql::DB->quote($statsRef->{weight}) . ",";
917
$sql .= " height=" . $Bc_sql::DB->quote($statsRef->{height}) . ",";
918
$sql .= " body=" . $Bc_sql::DB->quote($statsRef->{body}) . ",";
919
$sql .= " enrolled=" . $Bc_sql::DB->quote($statsRef->{enrolled}) . ",";
920
$sql .= " subscriber=" . $Bc_sql::DB->quote($statsRef->{subscriber}) . ",";
921
$sql .= " subscription_date=" . $Bc_sql::DB->quote($statsRef->{subscription_date}) . ",";
922
$sql .= " subscription_type=" . $Bc_sql::DB->quote($statsRef->{subscription_type}) . ",";
923
if ($statsRef->{CCID} ne $origStats{CCID}) {
924
$sql .= " CCID=" . $Bc_sql::DB->quote($statsRef->{CCID}) . ",";
925
}
926
$sql .= " TID=" . $Bc_sql::DB->quote($statsRef->{TID}) . ",";
927
$sql .= " security=" . $Bc_sql::DB->quote($statsRef->{security}) . ",";
928
$sql .= " description=" . $Bc_sql::DB->quote($statsRef->{description}) . ",";
929
$sql .= " Security::banned=" . $Bc_sql::DB->quote($statsRef->{banned});
930
$sql .= " where ID = " . $Bc_sql::DB->quote($statsRef->{ID});
931
932
$rv = Bc_sql::sql_execute($sql, "User.pm - set user stats");
933
if ($rv eq 0) { $rv = -100; } # no results
934
} else {
935
$rv = $checkstats; # something is wrong with the stats hash data
936
}
937
} else {
938
$rv = -101; # no such user
939
}
940
} else {
941
$rv = -102; # $statsRef is not a hash reference
942
}
943
944
return $rv; # 0 on failure, 1 on success
945
#usage: my $set_rv = set_user_stats($uid, %stats);
946
}
947
948
##########################
949
sub check_user_stats($) {
950
#*
951
# validates user info
952
# does not, and will never check if $statsRef->{ID} exists in DB
953
# before executing this subroutine, execute
954
# <a href=\"?dp=sql#user_exists\">user_exists($$)</a> to validate existence
955
#
956
# this subroutine has a debug toggle. see code.
957
#*
958
my ($statsRef) = @_; # a reference to a hash of user data
959
960
my $valid = 1; # assume the data is valid
961
my $thisYear = Date::get_today("y", 0);
962
my $numRaces = get_config("races");
963
my $numOrientations = get_config("orientations");
964
my $numErections = get_config("erections");
965
my $numBusts = get_config("busts");
966
my $numEyes = get_config("eyes");
967
my $numHair = get_config("hair");
968
my $numHeights = get_config("heights");
969
my $numWeights = get_config("weights");
970
my $numBodies = get_config("bodies");
971
my $numSubTypes = get_config("membership_types");
972
my $numSecurity = get_config("sec_levels");
973
my $numSeeking = get_config("styles");
974
975
my $DEBUG_THIS = 0;
976
my $debug_rv = "this year: $thisYear\n\n";;
977
978
# now a whole bunch of if statements
979
if ($statsRef->{nickname} =~ /\'|\"/g) { $valid = 0; $debug_rv .= "nickname invalid: $statsRef->{nickname}\n"; }
980
if ($statsRef->{ID} !~ /^[a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9]$/i) { $valid = -1; $debug_rv .= "id invalid: $statsRef->{ID}\n"; }
981
my ($doby, $dobm, $dobd) = split("-", $statsRef->{dob});
982
if ($doby < 1850 or $doby > $thisYear-18) { $valid = -2; $debug_rv .= "invalid dob year: $doby\n"; }
983
if ($dobm < 1 or $dobm > 12) { $valid = -3; $debug_rv .= "invalid dob month: $dobm\n"; }
984
if ($dobd < 1 or $dobd > 31) { $valid = -4; $debug_rv .= "invalid dob day: $dobd\n"; }
985
if ($statsRef->{showbday} !~ /^1|2$/) { $valid = -5; $debug_rv .= "showbday invalid: $statsRef->{showbday}\n"; }
986
if ($statsRef->{lastip} ne "0.0.0.0" and $statsRef->{lastip} !~ /^[1][0-9]{0,2}\.[0-9][0-9]{0,2}\.[0-9][0-9]{0,2}\.[0-9][0-9]{0,2}$/) { $valid = -6; $debug_rv .= "lastip invalid: $statsRef->{lastip}\n"; }
987
if ($statsRef->{race} !~ /^1|2$/) { $valid = -7; $debug_rv .= "race invalid: $statsRef->{race}\n"; }
988
if ($statsRef->{gender} !~ /^1|2$/) { $valid = -8; $debug_rv .= "gender invalid: $statsRef->{gender}\n"; }
989
if ($statsRef->{location} !~ /^[1-9][0-9]{0,2}-[1-9][0-9]{0,2}$/) { $valid = -9; $debug_rv .= "location invalid: $statsRef->{location}\n"; }
990
if ($numOrientations) { if ($statsRef->{orientation} !~ /^[1-$numOrientations]$/) { $valid = -10; $debug_rv .= "orientation invalid: $statsRef->{orientation}\n"; } }
991
if ($statsRef->{drugs} !~ /^1|2$/) { $valid = -11; $debug_rv .= "drugs invalid: $statsRef->{drugs}\n"; }
992
if ($statsRef->{wheels} !~ /^1|2$/) { $valid = -12; $debug_rv .= "wheels invalid: $statsRef->{wheels}\n"; }
993
if ($statsRef->{can_host} !~ /^1|2$/) { $valid = -13; $debug_rv .= "can_host invalid: $statsRef->{can_host}\n"; }
994
if ($statsRef->{drinker} !~ /^1|2$/) { $valid = -14; $debug_rv .= "drinker invalid: $statsRef->{drinker}\n"; }
995
if ($statsRef->{smoker} !~ /^1|2$/) { $valid = -15; $debug_rv .= "smoker invalid: $statsRef->{smoker}\n"; }
996
if ($statsRef->{seeking} < 1 and $statsRef->{seeking} > $numSeeking) { $valid = -16; $debug_rv .= "seeking invalid: $statsRef->{seeking} of " . $numSeeking . "\n"; }
997
if ($statsRef->{seeking_gender} !~ /^1|2$/) { $valid = -17; $debug_rv .= "seeking_gender invalid: $statsRef->{seeking_gender}\n"; }
998
if ($statsRef->{erection} < 1 and $statsRef->{erection} > $numErections) { $valid = -18; $debug_rv .= "erection invalid: $statsRef->{erection} of " . $numErections . "\n"; }
999
if ($statsRef->{bust} < 1 and $statsRef->{bust} > $numBusts) { $valid = -19; $debug_rv .= "bust invalid: $statsRef->{bust} of " . $numBusts . "\n"; }
1000
if ($statsRef->{eye_clr} < 1 and $statsRef->{eye_clr} > $numEyes) { $valid = -20; $debug_rv .= "eye_clr invalid: $statsRef->{eye_clr} of " . $numEyes . "\n"; }
1001
if ($statsRef->{hair_clr} < 1 and $statsRef->{hair_clr} > $numHair) { $valid = -21; $debug_rv .= "hair invalid: $statsRef->{hair} of " . $numHair . "\n"; }
1002
if ($statsRef->{height} < 1 and $statsRef->{height} > $numHeights) { $valid = -22; $debug_rv .= "height invalid: $statsRef->{height} of " . $numHeights . "\n"; }
1003
if ($statsRef->{weight} < 1 and $statsRef->{weight} > $numWeights) { $valid = -23; $debug_rv .= "weight invalid: $statsRef->{weight} of " . $numWeights . "\n"; }
1004
my ($ey, $em, $ed) = split("-", $statsRef->{enrolled});
1005
if ($ey < 1850 or $ey > $thisYear) { $valid = -24; $debug_rv .= "invalid enrolled year: $ey\n"; }
1006
if ($em < 1 or $em > 12) { $valid = -25; $debug_rv .= "invalid enrolled month: $em\n"; }
1007
if ($ed < 1 or $ed > 31) { $valid = -26; $debug_rv .= "invalid enrolled day: $ed\n"; }
1008
if ($statsRef->{subscriber} !~ /^1|2$/) { $valid = -27; $debug_rv .= "subscriber invalid: $statsRef->{subscriber}\n"; }
1009
my ($sy, $sm, $sd) = split("-", $statsRef->{subscription_date});
1010
if ($sy < 1850 or $sy > $thisYear) { $valid = -28; $debug_rv .= "invalid subscription_date year: $sy\n"; }
1011
if ($sm < 1 or $sm > 12) { $valid = -29; $debug_rv .= "invalid subscription_date month: $sm\n"; }
1012
if ($sd < 1 or $sd > 31) { $valid = -30; $debug_rv .= "invalid subscription_date day: $sd\n"; }
1013
if ($statsRef->{subscription_type} < 1 and $statsRef->{subscription_type} > $numSubTypes) { $valid = -31; $debug_rv .= "subscription_type invalid: $statsRef->{subscription_type} of " . $numSubTypes . "\n"; }
1014
#if ($statsRef->{CCID} ne 0 and $statsRef->{CCID} !~ /^[a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9]$/i) { $valid = -32; $debug_rv .= "CCID invalid: $statsRef->{CCID}\n"; }
1015
if ($statsRef->{TID} !~ /^[a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9][a-f0-9]$/i) { $valid = -33; $debug_rv .= "TID invalid: $statsRef->{TID}\n"; }
1016
if ($statsRef->{security} < 1 and $statsRef->{security} > $numSecurity) { $valid = -34; $debug_rv .= "security invalid: $statsRef->{security} of " . $numSecurity . "\n"; }
1017
if ($statsRef->{banned} !~ /^1|2$/) { $valid = -35; $debug_rv .= "Security::banned invalid: $statsRef->{banned}\n"; }
1018
1019
# email involves a little more computing than a quick regex
1020
if ($statsRef->{email}) {
1021
$statsRef->{email} =~ s/\%40/\@/g;
1022
my @addy = split(/\@/, $statsRef->{email});
1023
# it should only be two pieces
1024
if (@addy != 2) {
1025
$valid = -36;
1026
} else {
1027
# okay, so it's got two bits.
1028
# now check for double . and leading/trailing dots in both parts of addy
1029
if ($addy[0] =~ /\.(\.)+/ or $addy[1] =~ /\.(\.)+/ or
1030
$addy[0] =~ /^\./ or $addy[1] =~ /^\./ or
1031
$addy[0] =~ /\.$/ or $addy[1] =~ /\.$/ or
1032
$addy[1] !~ /\./) {
1033
$valid = -37;
1034
} else {
1035
# remove all valid characters from the email address. yes!
1036
# whatever's left over is invalid, unless it's blank!
1037
# we want an empty string when we're done
1038
my $addy1 = $addy[0];
1039
my $addy2 = $addy[1];
1040
1041
$addy1 =~ s/[a-z]//ig;
1042
$addy1 =~ s/[0-9]//ig;
1043
1044
# remove `~!#$%^&*-_=+/?{}'
1045
$addy1 =~ s/\\\!|\\\#|\\\$|\\\%|\\\&|\\\*|\\\+|\\\-|\\\/|\\\=|\\\?|\\\^|\\\_|\\\`|\\\{|\\\||\\\}|\\\~|\\'//g; # ' <-- here to terminate the first one!
1046
1047
$addy1 =~ s/\.//g;
1048
$addy2 =~ s/[a-z]//ig;
1049
$addy2 =~ s/[0-9]//ig;
1050
$addy2 =~ s/\.//g;
1051
$addy2 =~ s/-//g;
1052
1053
# now, we see if we got empty strings or not
1054
if ($addy1) { $valid = -38; }
1055
if ($addy2) { $valid = -39; }
1056
}
1057
}
1058
}
1059
1060
if ($valid < 0) {
1061
#$valid =~ s/-/\#/g;
1062
$debug_rv .= "stats check err $valid\n";
1063
}
1064
1065
if ($DEBUG_THIS) { $valid = $debug_rv; $valid =~ s/\n/<br>\n/g;}
1066
1067
return $valid; # 0 when the provided stats are invalid or 1 if they're ok
1068
#usage: if (check_user_stats(\%stats)) { print "stats are good to go"; } else { print "stats are totally fubar"; }
1069
}
1070
1071
##########################
1072
##########################
1073
##########################
1074
##########################
1075
##########################
1076
##########################
1077
##########################
1078
1079
##########################
1080
sub isUser($) {
1081
#*
1082
# determines if a user is a user or not
1083
# a redundancy for <a href='?pm=sql#user_exists'>user_exists($$)</a>
1084
#*
1085
my ($uid) = @_; # a uid
1086
1087
return Bc_sql::user_exists($uid); # whatever <a href='?pm=sql#user_exists'>user_exists($$)</a> returns
1088
#usage: if (isUser($uid)) { ... }
1089
}
1090
1091
##########################
1092
sub isUserAdmin(;$$$) {
1093
#*
1094
# determines if a user is an admin or not
1095
#*
1096
my ($uid, $table_name, $table_column) = @_; # a uid (optional, default is $Bc_sql::LOGGEDIN user) && table name && column name
1097
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1098
if (not $uid) { $uid = ""; }
1099
my $rv = 0;
1100
1101
if (isUser($uid)) {
1102
my %ustats;
1103
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
1104
{ %ustats = %$USER_DATA; } else
1105
{ %ustats = get_user_stats($uid); }
1106
1107
if ($ustats{"security"} eq Bc_sql::get_security("Administrator", $table_name, $table_column) or
1108
$ustats{"security"} eq Bc_sql::get_security("SuperAdministrator", $table_name, $table_column) or
1109
$ustats{"security"} eq Bc_sql::get_security("SuperAdmin", $table_name, $table_column)) { $rv = 1; }
1110
}
1111
1112
return $rv; # a scalar
1113
#usage: if (isUserAdmin()) { ... }
1114
}
1115
1116
##########################
1117
sub isUserBeta(;$) {
1118
#*
1119
# determines if a user is a beta tester or not
1120
#*
1121
my ($uid) = @_; # a uid (optional, default=$Bc_sql::LOGGEDIN)
1122
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1123
if (not $uid) { $uid = ""; }
1124
my $rv = 0;
1125
1126
if (isUserAdmin($uid) or isUserSuperAdmin($uid)) {
1127
$rv = 1;
1128
} else {
1129
if (Bc_sql::user_exists($uid)) {
1130
my $sql = "select UID from beta_users where UID=" . $Bc_sql::DB->quote($uid);
1131
my $results = Bc_sql::sql_execute($sql, "is user beta");
1132
if (ref $results eq "HASH") { $rv = 1; }
1133
}
1134
#else {
1135
# delete UID from beta table?
1136
# my $sql = "delete from beta_users where UID=" . $Bc_sql::DB->quote($uid);
1137
# my $result = Bc_sql::sql_execute($sql, "is user beta");
1138
# if ($result) { $rv = -1; }
1139
#}
1140
}
1141
1142
return $rv; # a scalar
1143
#usage: if (isUserBeta()) { ... }
1144
}
1145
1146
##########################
1147
sub isUserSuperAdmin(;$) {
1148
#*
1149
# determines if a user is a super admin or not
1150
#*
1151
my ($uid) = @_; # a uid (optional, default=$Bc_sql::LOGGEDIN)
1152
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1153
if (not $uid) { $uid = ""; }
1154
my $rv = 0;
1155
1156
if (Bc_sql::user_exists($uid)) {
1157
my %ustats;
1158
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
1159
{ %ustats = %$USER_DATA; } else
1160
{ %ustats = get_user_stats($uid); }
1161
1162
if ($ustats{"security"} == Bc_sql::get_security("SuperAdmin")) { $rv = 1; }
1163
}
1164
1165
return $rv; # a scalar
1166
#usage: if (isUserSuperAdmin($uid)) { ... }
1167
}
1168
1169
##########################
1170
sub isUserBday(;$) {
1171
#*
1172
# is today user's bday??
1173
#*
1174
my ($uid) = @_; # a uid (optional, default=$Bc_sql::LOGGEDIN)
1175
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1176
if (not $uid) { $uid = ""; }
1177
my $rv = 0;
1178
1179
if (Bc_sql::user_exists($uid)) {
1180
my %ustats;
1181
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
1182
{ %ustats = %$USER_DATA; } else
1183
{ %ustats = get_user_stats($uid); }
1184
1185
if ($ustats{dob_day} eq Date::get_today('d', 0) and
1186
$ustats{dob_mon} eq Date::get_today('m', 0)) {
1187
$rv = 1; # 1 for yes it is their bday
1188
}
1189
}
1190
1191
return $rv; # 1 if it's the user's bday, or 0 if not
1192
#usage: if (isUserBday($uid)) { ... }
1193
}
1194
1195
##########################
1196
sub isUserModerator(;$) {
1197
#*
1198
# determines if a user is a moderator (or higher) or not
1199
#*
1200
my ($uid) = @_; # a uid (optional, default=$Bc_sql::LOGGEDIN)
1201
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1202
if (not $uid) { $uid = ""; }
1203
my $rv = 0;
1204
1205
if (Bc_sql::user_exists($uid)) {
1206
my %ustats;
1207
1208
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
1209
{ %ustats = %$USER_DATA; } else
1210
{ %ustats = get_user_stats($uid); }
1211
1212
if ($ustats{"security"} eq Bc_sql::get_security("Moderator") or
1213
$ustats{"security"} eq Bc_sql::get_security("Administrator") or
1214
$ustats{"security"} eq Bc_sql::get_security("SuperAdministrator")) { $rv = 1; }
1215
}
1216
1217
return $rv; # 1 if user is a moderator, or 0 if not
1218
#usage: if (isUserModerator($uid)) { ... }
1219
}
1220
1221
##########################
1222
sub isUserSubscriber(;$) {
1223
#*
1224
# determines subscription status
1225
#*
1226
my ($uid) = @_; # a uid (optional, default=$Bc_sql::LOGGEDIN)
1227
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1228
if (not $uid) { $uid = ""; }
1229
my $rv = 0;
1230
1231
if (Bc_sql::user_exists($uid)) {
1232
my %ustats;
1233
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
1234
{ %ustats = %$USER_DATA; } else
1235
{ %ustats = get_user_stats($uid); }
1236
1237
if ($ustats{subscriber} ne "1") {
1238
$rv = 1; # 1 when uid is a subscriber
1239
}
1240
}
1241
1242
return $rv; # 1 if user is a subscriber, or 0 if not
1243
#usage: if (isUserSubscriber($uid)) { ... }
1244
}
1245
1246
##########################
1247
sub isFriend($;$) {
1248
#*
1249
# determines if $fid is on $uid's friend's list
1250
#*
1251
my ($fid, $uid) = @_; # uid of friend && list owner (optional, default=$Bc_sql::LOGGEDIN)
1252
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1253
if (not $uid) { $uid = ""; }
1254
my $rv = 0;
1255
1256
my @friends = get_user_friends($uid); # Bc_sql::LOGGEDIN user, usually
1257
if (@friends) {
1258
foreach my $friend (@friends) {
1259
if ($fid eq $friend) {
1260
#if ($uid eq $Bc_sql::LOGGEDIN)
1261
# { $rv = isFriend($uid, $fid); } else
1262
{ $rv = 1; }
1263
# end if $fid eq $friend
1264
}
1265
# end foreach @friends
1266
}
1267
# end if @friends
1268
}
1269
1270
return $rv; # 1 if they are friends or 0 if not
1271
#usage: if (isFriend($fid)) { ... }
1272
}
1273
1274
##########################
1275
sub isFriendRequestIgnored($;$) {
1276
#*
1277
# returns true if $uid sent an ignored friend request to $fid
1278
#*
1279
my ($fid, $uid) = @_; # a uid - the "friend" && uid of list owner (optional, default = $Bc_sql::LOGGEDIN)
1280
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1281
if (not $uid) { $uid = ""; }
1282
my $rv = 0;
1283
my $sql = "select * from friends where UID=" . $Bc_sql::DB->quote($fid) . " and FID=" . $Bc_sql::DB->quote($uid) . " and declined='2'";
1284
my $p = Bc_sql::sql_execute($sql, "is friend request ignored");
1285
if (ref $p eq "HASH") { $rv = $p; }
1286
1287
return $rv; # 1 or 0
1288
#usage: if (isFriendRequestIgnored($Bc_sql::LOGGEDIN, $fid)) { ... }
1289
}
1290
1291
##########################
1292
sub isFriendRequestPending($;$) {
1293
#*
1294
# returns true if $uid sent an unanswered friend request to $fid
1295
#*
1296
my ($fid, $uid) = @_; # a uid - the "friend" && uid of list owner (optional, default=\$Bc_sql::LOGGEDIN)
1297
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1298
if (not $uid) { $uid = ""; }
1299
my $rv = 0;
1300
my $sql = "select * from friends where UID=" . $Bc_sql::DB->quote($fid) . " and FID=" . $Bc_sql::DB->quote($uid) . " and not declined='3'";
1301
my $p = Bc_sql::sql_execute($sql, "is friend request pending");
1302
if (ref $p eq "HASH") { $rv = $p; }
1303
1304
return $rv; # 1 or 0
1305
#usage: if (isFriendRequestPending($Bc_sql::LOGGEDIN, $fid)) { ... }
1306
}
1307
1308
##########################
1309
sub isThemePurchased($;$) {
1310
#*
1311
# determines if a theme has been
1312
# purchased by the user
1313
#*
1314
my ($tid, $uid) = @_; # a tid - the "theme" && uid of user (optional, default = $Bc_sql::LOGGEDIN)
1315
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1316
if (not $uid) { $uid = ""; }
1317
my $rv = 0;
1318
my $theme = theme_exists($tid);
1319
1320
if ($theme) {
1321
# is it a premium theme?
1322
if ($theme->{premium} == '2') {
1323
my @purchases = get_theme_purchases();
1324
foreach my $ptid (@purchases) {
1325
if ($tid eq $ptid) { $rv = 1; last; }
1326
}
1327
} else {
1328
$rv = 1; # all non-premium themes are considered "purchased" themes
1329
}
1330
}
1331
1332
return $rv; # 1 if purhcased or 0 if not
1333
#usage: if (isThemePurchased($tid)) { ... }
1334
}
1335
1336
##########################
1337
##########################
1338
##########################
1339
##########################
1340
##########################
1341
##########################
1342
##########################
1343
1344
##########################
1345
sub blockedUser($;$) {
1346
#*
1347
# to determine if a uid is blocked by $Bc_sql::LOGGEDIN
1348
# or, for <i>debug.pl</i> purposes mainly, you can optionally
1349
# supply a uid to override the default $Bc_sql::LOGGEDIN
1350
#*
1351
my ($buid, $uid) = @_; # a blocked uid candidate && a uid to check (optional, debugging/admin purposes, normally)
1352
if ($Bc_sql::LOGGEDIN and not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1353
if (not $uid) { $uid = ""; }
1354
1355
my @blocked = get_user_blocked_users($uid);
1356
foreach my $thisbuid (@blocked) {
1357
if ($thisbuid eq $buid) {
1358
return 1; # 1 if $uid is blocked
1359
}
1360
}
1361
1362
return 0; # 0 if $uid is not blocked
1363
#usage: if (blockedUser($uid, $buid)) { print "$buid is blocked!"; }
1364
}
1365
1366
##########################
1367
sub user_paid_expired($) {
1368
#*
1369
# determines subscription expiration status
1370
#*
1371
my ($uid) = @_; # a uid
1372
1373
my $EXPIRED = 1;
1374
my %ustats;
1375
if ($uid eq $Bc_sql::LOGGEDIN and ref $USER_DATA eq "HASH")
1376
{ %ustats = %$USER_DATA; } else
1377
{ %ustats = get_user_stats($uid); }
1378
1379
my $status = 0;
1380
1381
if (Bc_sql::user_exists($uid)) {
1382
my $this_day = Date::get_today('d', 0); # 14
1383
my $this_month = Date::get_today('m', 0); # 7
1384
my $this_year = Date::get_today('y', 0); # 2015
1385
my %uStats = get_user_stats($uid);
1386
my @subData = split(';', $uStats{paid});
1387
1388
if ($subData[0] eq 'no') { $status = $EXPIRED; }
1389
1390
my @sub_date = split('-', $subData[1]); # day, month, year: 19-1-1976
1391
my $sub_day = $sub_date[0];
1392
my $sub_month = $sub_date[1];
1393
my $sub_year = $sub_date[2];
1394
1395
if ($this_year > $sub_year) {
1396
$status = $EXPIRED;
1397
} else {
1398
if ($this_month > $sub_month and $this_year eq $sub_year) {
1399
$status = $EXPIRED;
1400
} else {
1401
if ($this_day > $sub_day and $this_month eq $sub_month) {
1402
$status = $EXPIRED;
1403
}
1404
}
1405
}
1406
}
1407
1408
return $status; # a 1 or 0
1409
#usage: if (user_paid_expired($uid)) { .. update stats? redir from paid area?.. }
1410
}
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
########################
1431
sub get_user_friends(;$) {
1432
#*
1433
# gets the Bc_sql::LOGGEDIN user's friends list
1434
# will NOT include deleted, blocked, or Security::banned users
1435
# it will only include 'accepted' friends (where declined=3)
1436
#
1437
# note: you may provide an ID to override the default
1438
# friends list owner ID ($Bc_sql::LOGGEDIN if excluded) in the
1439
# <a href="#isFriend">isFriend(...)</a> subroutine
1440
#
1441
#*
1442
my ($uid) = @_; # overrides owner ID of friends list (optional, debugging/admin tasks)
1443
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1444
if (not $uid) { $uid = ""; }
1445
my @friends = ();
1446
1447
my $ref = Bc_sql::sql_execute("select * from friends where UID=" . $Bc_sql::DB->quote($uid) . " and declined='3'", "User.pm - get user friends"); # will be a reference to an array or a hash
1448
if (ref $ref eq "HASH") {
1449
if (
1450
Bc_sql::user_exists($ref->{FID})
1451
and not blockedUser($ref->{FID}, $uid)
1452
and not Security::banned($ref->{FID})
1453
and $ref->{declined} eq 3
1454
) {
1455
push @friends, $ref->{FID};
1456
}
1457
} elsif (ref $ref eq "ARRAY") {
1458
foreach my $fidref (@$ref) {
1459
if (
1460
Bc_sql::user_exists($fidref->{FID})
1461
and not blockedUser($fidref->{FID}, $uid)
1462
and not Security::banned($fidref->{FID})
1463
and $fidref->{declined} eq 3
1464
) {
1465
push @friends, $fidref->{FID};
1466
}
1467
}
1468
}
1469
1470
return @friends; # an array of uid's (can be empty)
1471
#usage: my @f = get_user_friends();
1472
}
1473
1474
##########################
1475
sub nickname_in_use($) {
1476
#*
1477
# determines if the nickname provided is in use or not
1478
#*
1479
my ($nn) = @_; # a nickname
1480
1481
my @names = get_users_nicknames();
1482
foreach my $name (@names) {
1483
if ($nn =~ /^$name$/i) {
1484
return get_uid_byNickname($name); # uid when nickname supplied already exists
1485
}
1486
}
1487
1488
return 0; # 0 when nickname supplied does not yet exist!
1489
#usage: my $validNN = valid_nickname($nn);
1490
}
1491
1492
##########################
1493
sub valid_email($) {
1494
#*
1495
# determines if the email address provided is in use or not
1496
# and if it conforms to proper email address format
1497
#*
1498
my ($e) = @_; # an email address
1499
1500
my $usable = 1; # assume the email address is valid, even if it isn't
1501
# as well go through the process, $usuable will be changed to 0 if we
1502
# encounter a problem with the email address being unique and/or valid
1503
1504
my @emails = get_users_emails();
1505
foreach my $email (@emails) {
1506
if ($e =~ /^$email$/i) {
1507
$usable = 0; # 0 if email address supplied already exists in database
1508
}
1509
}
1510
1511
if ($usable) {
1512
my @addy = split(/\@/, $e);
1513
# it should only be two pieces
1514
if (@addy != 2) {
1515
$usable = -1;
1516
} else {
1517
# okay, so it's got two bits.
1518
# now check for double . and leading/trailing dots in both parts of addy
1519
if ($addy[0] =~ /\.(\.)+/ or $addy[1] =~ /\.(\.)+/ or
1520
$addy[0] =~ /^\./ or $addy[1] =~ /^\./ or
1521
$addy[0] =~ /\.$/ or $addy[1] =~ /\.$/ or
1522
$addy[1] !~ /\./) {
1523
$usable = -2;
1524
} else {
1525
# now, we gotta make sure only valid characters
1526
# are in both parts
1527
# first, we'll start with the stuff before @
1528
# and then work on the stuff after
1529
1530
# let's do this differently.
1531
# remove all valid characters from the email address.
1532
# whatever's left over is invalid, unless it's blank!
1533
my $addy1 = $addy[0];
1534
my $addy2 = $addy[1];
1535
$addy1 =~ s/[a-z]//ig;
1536
$addy1 =~ s/[0-9]//ig;
1537
1538
# remove `~!#$%^&*-_=+/?{}'
1539
$addy1 =~ s/\!|\#|\$|\%|\&|\*|\+|\-|\/|\=|\?|\^|\_|\`|\{|\||\}|\~|\'//g;
1540
1541
$addy1 =~ s/\.//g;
1542
$addy2 =~ s/[a-z]//ig;
1543
$addy2 =~ s/[0-9]//ig;
1544
$addy2 =~ s/\.//g;
1545
$addy2 =~ s/-//g;
1546
1547
if ($addy1) { $usable = -3; }
1548
if ($addy2) { $usable = -4; }
1549
}
1550
}
1551
# end if (not $usable)
1552
}
1553
1554
return $usable; # 1 if usable, or 0 if not
1555
#usage: my $validEmail = valid_email("bobs@yerun.cle");
1556
}
1557
1558
##########################
1559
sub get_user_messages(;$$) {
1560
#*
1561
# gets a list of msg ID's of read and
1562
# unread msgs for the given $uid
1563
#*
1564
my ($uid, $include_chat) = @_; # a UID (optional, default=$Bc_sql::LOGGEDIN) && include chat msgs (optional)
1565
if (not $uid) { $uid = $Bc_sql::LOGGEDIN; }
1566
if (not $uid) { $uid = ""; }
1567
1568
my @msgsList = ();
1569
my $query = "select * from messages where deled='1' and to_ID=" . $Bc_sql::DB->quote($uid);
1570
my $results = Bc_sql::sql_execute($query, "User.pm - get user messages", 1);
1571
1572
if (ref $results eq "ARRAY" and @$results) {
1573
foreach my $msgHashRef (@$results) {
1574
if ($include_chat)
1575
{ push @msgsList, $msgHashRef->{ID}; } else
1576
{ if ($msgHashRef->{subject} ne "chatbox msg") { push @msgsList, $msgHashRef->{ID}; } }
1577
}
1578
}
1579
1580
return @msgsList; # a list of msg ID's (excluding deleted; can be an empty list)
1581
#usage: my @msgs = get_user_messages($uid, 1);
1582
}
1583
1584
##########################
1585
sub get_user_message($) {
1586
#*
1587
# gets a specified message ID's data
1588
#*
1589
my ($msgID) = @_; # a msg ID
1590
my $rv = 0;
1591
1592
my $query = "select * from messages where ID=" . $Bc_sql::DB->quote($msgID);
1593
my $results = Bc_sql::sql_execute($query, "User.pm - get user message"); # should give back a hash reference
1594
if (ref $results eq "HASH") {
1595
$rv = $results;
1596
}
1597
1598
return $rv; # the message as a hash reference or 0 on failure
1599
#usage: my $msg = get_user_message($uid, $msgID);
1600
}
1601
1602
########################
1603
sub get_user_unread_messages($) {
1604
#*
1605
# gets a list of unread messages
1606
# this could return an array, in which case
1607
# each element is a hash reference to message data
1608
# the array could be zero or 2+ in size. NEVER one.
1609
# or it could return single hash reference
1610
#*
1611
my ($uid) = @_; # the uid to look up
1612
my $msgs = 0;
1613
if (Bc_sql::user_exists($uid)) {
1614
$msgs = Bc_sql::sql_execute("select * from messages where to_ID = " . $Bc_sql::DB->quote($uid) . " and seen='1' and subject <> 'chatbox msg'", "User.pm - get user unread messages");
1615
}
1616
1617
return $msgs; # a list of unread messages
1618
#usage: my @unreadmsgs = get_user_unread_messages($uid);
1619
}
1620
1621
##########################
1622
sub get_user_theme(;$) {
1623
my ($col) = @_;
1624
if (not $col) { $col = "TID"; }
1625
my $rv = 0;
1626
1627
if (ref $Bc_sql::LOGGEDIN eq "HASH")
1628
{ $rv = $Bc_sql::LOGGEDIN->{$col}; } else
1629
{ $rv = Bc_sql::get_default_theme(); }
1630
1631
return $rv;
1632
}
1633
1634
##########################
1635
##########################
1636
##########################
1637
##########################
1638
##########################
1639
##########################
1640
##########################
1641
##########################
1642
##########################
1643
##########################
1644
##########################
1645
##########################
1646
##########################
1647
##########################
1648
##########################
1649
##########################
1650
##########################
1651
##########################
1652
##########################
1653
1654
##########################
1655
sub _tests(;$) {
1656
#*
1657
# to test all <i>Pm::user</i> functions
1658
#*
1659
my ($extended) = @_; # show extended data (optional)
1660
my $rv = "";
1661
my $test = "";
1662
my $test2 = "";
1663
my $test3 = "";
1664
my @test = ();
1665
my @test2 = ();
1666
my %test;
1667
1668
if ($Bc_sql::DB) {
1669
$test = "4FB1E88BC3";
1670
#$rv .= Html::display_debug_one("get_user_points(\"$test\")", get_user_points($test));
1671
$test2 = $Bc_sql::LOGGEDIN;
1672
#$rv .= Html::display_debug_one("blockedUser(\"$test\", \"$test2\")", blockedUser($test, $test2));
1673
#$rv .= Html::display_debug_one("check_user_stats(\\\%test)", check_user_stats(\%test));
1674
$test = $Bc_sql::LOGGEDIN;
1675
$test2 = get_uid_byNickname($test);
1676
$rv .= Html::display_debug_one("get_uid_byNickname(\"$test\")", get_uid_byNickname($test));
1677
$test = "jarett\@night-stand.ca";
1678
$rv .= Html::display_debug_one("get_uid_byEmail(\"$test\")", get_uid_byEmail($test));
1679
$rv .= Html::display_debug_one("get_user_age(\"$test2\")", get_user_age($test2));
1680
#@test = get_user_blocked_users($test2);
1681
#$rv .= Html::display_debug_many("get_user_blocked_users(\"$test2\")", \@test);
1682
#$rv .= Html::display_debug_one("get_user_city(\"$test2\")", get_user_city($test2));
1683
#$rv .= Html::display_debug_one("get_user_country(\"$test2\")", get_user_country($test2));
1684
#$rv .= Html::display_debug_one("get_user_dp(\"$test2\")", get_user_dp($test2));
1685
$test2 = "CEC68E7124";
1686
#$rv .= Html::display_debug_one("isFriend(\"$test2\")", isFriend($test2));
1687
$test2 = "CEC68E7124";
1688
#$rv .= Html::display_debug_one("isFriendRequestPending(\"$test2\")", isFriendRequestPending($test2));
1689
$test2 = "CEC68E7124";
1690
#$rv .= Html::display_debug_one("isFriendRequestIgnored(\"$test2\")", isFriendRequestIgnored($test2));
1691
#$test2 = $Bc_sql::LOGGEDIN;
1692
$test2 = "";
1693
#@test = get_user_friend_requests($test2);
1694
#if ($test2 eq "")
1695
# { $rv .= Html::display_debug_many("get_user_friend_requests()", \@test); } else
1696
# { $rv .= Html::display_debug_many("get_user_friend_requests(\"$test2\")", \@test); }
1697
#if ($test2 eq "")
1698
# { @test = get_user_friends(); } else
1699
# { @test = get_user_friends("66377849E7"); }
1700
#$rv .= Html::display_debug_many("get_user_friends()", \@test, ", ");
1701
$test3 = 1;
1702
#$rv .= Html::display_debug_one("get_user_fuck_alert_count(\"$test2\", $test3)", get_user_fuck_alert_count($test2, $test3));
1703
$test2 = "9489E5D837";
1704
#my $test3 = get_user_message($test2);
1705
#$rv .= Html::display_debug_many("get_user_message(\"$test2\")", $test3);
1706
$test = "182FAC2414";
1707
#my @test = get_user_messages($test);
1708
#$rv .= Html::display_debug_many("get_user_messages($test)", \@test);
1709
1710
1711
1712
# this one left for last because it requires just a couple lines of code
1713
# keep it separated from the rest, too
1714
@test = ();
1715
$test = $Bc_sql::LOGGEDIN;
1716
$test2 = get_uid_byNickname($test);
1717
%test = get_user_stats($test2);
1718
push @test, \%test;
1719
$rv .= Html::display_debug_large("get_user_stats(\"$test2\")", \@test);
1720
1721
$test = 'jarett@night-stand.ca';
1722
$rv .= Html::display_debug_one("valid_email(\"$test\")", valid_email($test));
1723
1724
$test = $Bc_sql::LOGGEDIN;
1725
$rv .= Html::display_debug_one("isUserModerator(\"$test\")", isUserModerator($test));
1726
$rv .= Html::display_debug_one("isUserAdmin(\"$test\")", isUserAdmin($test));
1727
$rv .= Html::display_debug_one("isUserSuperAdmin(\"$test\")", isUserSuperAdmin($test));
1728
} else {
1729
$rv .= "DB connection error!<br>\n";
1730
}
1731
1732
$rv .= Html::display_debug_hash("\$THEME_DATA", $THEME_DATA);
1733
$rv .= Html::display_debug_hash("get_user_theme_data(\$USER_DATA->{TID}, 1)", get_user_theme_data($USER_DATA->{TID}, 1));
1734
$rv .= Html::display_debug_one("get_user_stat(\$Bc_sql::LOGGEDIN, \"TID\")", get_user_stat($Bc_sql::LOGGEDIN, "TID"));
1735
1736
return $rv; # a scalar of the results of all tests
1737
#usage: print _tests(1);
1738
}
1739
1740
1;