Software error:
Undefined subroutine &pm::security::banned called at pm/user.pm line 136
####
##########################
package pm::user;
##########################
#/
# Encapsulates all user related functions
# these routines do NOT require a DBH
# the DB is connected to automagically!
#/
##########################
use strict;
use CGI::Carp qw(fatalsToBrowser);
use URI::Escape;
use Exporter;
use vars qw($VERSION @ISA @EXPORT);
##########################
##########################
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = qw(
_tests
blockedUser
check_user_stats
get_uid_byNickname
get_user_age
get_user_blocked_users
get_user_city
get_user_country
get_user_dp
get_user_friend_requests
get_user_friends
get_user_fuck_alert_count
get_user_message
get_user_messages
get_user_pic
get_user_pics
get_user_stat
get_user_stats
get_user_stats_asIcons
get_user_subscription_type
get_user_theme_data
get_user_unread_messages
get_users_emails
get_users_nicknames
isUser
isUserAdmin
isUserBday
isUserModerator
isUserSubscriber
isFriend
set_user_stats
user_paid_expired
nickname_in_use
email_in_use
);
##########################
##########################
my $loggedin = pm::bc_chef::cookie_get("loggedin");
my $db = pm::bc_sql::sql_connect("ns.db");
##########################
# this is just one sub. as you can see there are TONS of subs...
##########################
sub get_user_blocked_users($) {
#*
# gets a list of blocked users for the specified user
# can return an empty array
#*
my ($uid) = @_; # a uid
my @blocks = ();
my $results = pm::bc_sql::sql_execute($db, "select BID from blocks where UID = " . $db->quote($uid)); # could be a single hash ref, or a ref to an array
if (ref $results eq "HASH") {
if (pm::bc_sql::user_exists($db, $results->{BID}) and not pm::security::banned($db, $results->{BID})) { push @blocks, $results->{BID}; }
} elsif (ref $results eq "ARRAY") {
foreach my $ref (@$results) {
if (pm::bc_sql::user_exists($db, $ref->{BID}) and not pm::security::banned($db, $ref->{BID})) { push @blocks, $ref->{BID}; }
}
} else {
return undef;
}
return @blocks; # an array of blocked uid's
#usage: my @blocked_users = get_user_blocked_users($uid);
}
#...
1;
####
package pm::bc_sql;
#/
# a module for manipulating an SQLite DB on
# Apache in a Windows 10 environment
#/
########################
use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT);
use CGI::Carp qw(fatalsToBrowser);
########################
use DBI;
########################
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = qw(
_tests
sql_connect
sql_create_perchie
sql_create_random_user
sql_db_user_reset
sql_db_valid
sql_disconnect
sql_execute
sql_execute_bound
get_about_page
get_body_asWord
get_cities
get_city_id
get_city_name
get_config
get_constant
get_constants
get_country_cities
get_country_id
get_country_id_byName
get_country_name
get_countries
get_default_theme
get_errors
get_eye_clr_asWord
get_gender_asWord
get_hair_clr_asWord
get_height_asWord
get_help_page
get_home_page
get_location
get_navbar
get_orientation_asWord
get_phrase
get_profile_views_count
get_race_asWord
get_security
get_security_asWord
get_seeking_asWord
get_site_name
get_theme_data
get_themes
get_users
get_weight_asWord
get_zodiacs
set_config
set_constant
is_friend
is_admin
is_subscriber
is_moderator
ban_exists
ccid_exists
fma_exists
ipn_exists
msg_exists
msgs_exist
theme_exists
user_exists
sql_get_user_stat
in_maint
new_uid
new_tid
new_ccid
read_text
validate_new_user_data
valid_id
valid_ip
valid_date
valid_config
);
########################
########################
sub sql_execute($$) {
#*
# runs an SQL statement on the supplied db.
# must be connected, and must sql_disconnect to commit changes.
# a reference to an array of hash references can be returned
# if only one item is in the array, then we give a hash ref instead
# of a one element array reference
# (which is a hash reference in and of itself)
# three different return values: scalar, array ref, or hash ref
# - dependent on # of results, or kind of sql statement (insert, create, update,
# select, delete, etc)
# !this function does not and will NOT "sanitize" your query - that's your job!
# for instance: my $sql = "select * from users where ID = " . $db->quote($uid);
# note: this function should only have one return statement at its end...not
# several strewn throughout the code like it is here. this will be updated
#*
my ($db, $sql) = @_; # the dbh && the SQL statement
my $prept = $db->prepare($sql);
if ($sql =~ /^insert |update |delete /i) {
my $rv = $db->do($sql) or die $db->errstr;
if ($rv eq undef) { $rv = 0; }
if ($rv eq "0E0") { $rv = 0; } # yes. a failure. insert update and delete ought to affect at least one row.
return $rv; # 0 on failure, 1 on success
} elsif ($prept) {
$prept->execute();
# now, grab all the results from the query, and dump them into an array as hash references to each "hit"
my @arr = ();
while (my $row = $prept->fetchrow_hashref) { push @arr, $row; }
if (@arr eq 1 and $arr[0]) {
# if the array has only one element, then, it's kinda pointless to give a ref to the array
# so instead, let's just give back that hash reference
my $hashRef = $arr[0]; # this ought to be a hash reference, no?
return $hashRef; # a hash reference when there is only one array element
}
if (@arr eq 1 and ref $arr[0] ne "HASH") {
# if the array has only one element, and it's not a hash reference (meaning $arr[0] =~ /0e0/i)
# then ...
@arr = (); # clear the array
}
return \@arr; # an array reference (can be a zero element array), or
} else {
return \(); # a reference to an empty array when no results, or query failed
}
#usage: my $rv = sql_execute($db, $sql);
}
########################
sub user_exists($$) {
#*
# determines if a user exists or not
#*
my ($db, $uid) = @_; # a DBH && a user ID
my $sql = "select ID from users where ID = " . $db->quote($uid);
my $uref = sql_execute($db, $sql);
if (ref $uref eq "HASH") {
return 1; # 1 when user exists
} else {
return 0; # 0 when user does not exist
}
#usage: if (user_exists($uid)) { print "$uid exists"; }
}
# ...
1;
####
package pm::security;
#/
# a module to encapsulate security-related functions
#/
use strict;
use Exporter;
use vars qw($VERSION @ISA @EXPORT);
use CGI;
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT = qw(
_tests
banned
bounced
get_salt
password_correct
password_set
get_client_IP
login
logout
);
################################################################################################
################################################################################################
################################################################################################
########################
sub banned($$) {
#*
# gets the banned status of a uid
# !this function requires updating
# the code in this function needs to
# conform to a more basic format
# there should only be one return!
#*
my ($db, $uid) = @_; # a DBH && a uid
my $query = "select banned from users where ID = " . $db->quote($uid);
my $result = pm::bc_sql::sql_execute($db, $query); # should result in a 0 or a hash with one key: a UID
# $result is a hash reference
if (ref $result eq "HASH") {
if ($result->{banned} eq 2) {
return 1; # 1 when the user is banned
}
}
return 0; # 0 when the user is not banned
#usage: if (banned($db, $uid)) { print "yer banned, bitch"; }
}