in reply to Re: Perl Modules in thread Perl Modules
alright. i'll post some code. the relevant stuff. it'll be large, i'm sure...that's why i didn't post code in the first place. i'm seeking general information - problem is i can't articulate into words what I'm having difficulty with. with that said, it is imperative i figure this out, so i'll do exactly what you guys need to help me, and i will pay great attention. oh! let me just say this - jargon often escapes me. simple jargon doesn't, but if the jargon starts getting real technical, jamroll tends to get lost...so i adhere to the KISS principle like flies on ... stuff.
i may redact some areas of the code for security purposes.
i'll point out that i don't use caps very often, as you can see. i don't much care to hit shift that much. i recognize the convention is to upcase the first char of a module (Security instead of security, for example) - but is that just a convention, or a hardcoded rule?
all of the modules in pm:: are my own creation! the modules are stored in D:/Apache24/htdocs/pm/
i try to avoid having to use other's packages (that requires learning their way, and since i'm so very deep into this project, incorporating something new would be an entirely grandiose endeavor - no, i'm kinda stuck with the structure i'm laying out here)
so, firstly, this is the error message i get (happens everywhere, too - not JUST with this example):
Software error:
Undefined subroutine &pm::security::banned called at pm/user.pm line 1
+36
so here's the ALL of the code that is generating this error (like i said, this could be big)
user.pm - d:/apache24/htdocs/pm/user.pm
##########################
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 w
+here 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::secu
+rity::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::securi
+ty::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;
and related code for the function calls within the above module's sub. which are:
sql_execute, user_exists, and banned
pm::bc_sql::sql_execute(...) is my own flavor of the execute command (and i'm certain, nay, i know it's is badly done) - but it works! so, it stays as is for now
bc_sql.pm - d:/apache24/htdocs/pm/bc_sql.pm
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 <b>must</b> <a href='#sql_disconnect'>sql_d
+isconnect</a> 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, c
+reate, 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->q
+uote($uid);
# note: this function should only have one return statement at its e
+nd...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 a
+nd 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 referen
+ce (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 qu
+ery 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;
security.pm - d:/apache24/htdocs/pm/security.pm
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 i
+n 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"; }
}
i think that covers the meat of it...
i have removed all use pm::xxx; statements in the actual code, and just copied it to here. i have also tried removing pm::xxx:: before my function calls when the corresponding module has "use pm::xxx;" in it. i get the same error as what's above in other places (not just ::banned does exist - but sometimes sql_execute doesn't exist). it's all very very confusing to me. i don't understand even why the error message appears...and sorry it took so long to reply. had to make sure i covered my bases, dotted my T's and crossed my eyes!
Re^3: Perl Modules
by poj (Abbot) on Jun 20, 2017 at 19:40 UTC
|
package pm::mytest;
sub message {
return 'Hello from pm:mytest';
}
1;
and a script that uses it
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use CGI::Carp 'fatalsToBrowser';
use lib 'd:/apache24/htdocs';
use pm::mytest;
my $msg = pm::mytest::message();
my $q = CGI->new;
print $q->header,$q->start_html,
$q->h1($msg),$q->end_html;
poj
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
your code is good. and i understand this much very well. i'll point out, that d:/apache24/htdocs/ is my 'working' directory - thus, .pl files are stored there, and .pm files are stored in ./pm
and, i noticed i forgot to post my main code, which may be relevant (or critical even?) to my module confusion
debug.pl - d:/apache24/htdocs/debug.pl
#!/perl/bin/perl.exe
###########################
##
## this is a debug script to simply test each module's abilities
##
## if a new subroutine has been added to any module within
## the pm folder AND it requires testing, search THIS
## document for
## "# [modulename] TESTS"
## where [modulename] is the name of a module. eg: "bc_sql"
## add the new test in the same way as other tests found in this sc
+ript
##
###########################
# must have's!
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use URI::Escape;
use pm::bc_chef;
use pm::bc_misc;
use pm::bc_sql;
use pm::subdesc;
use pm::redir;
use pm::search;
use pm::security;
my $BORDER = 0;
my $navheight = 20;
my $navcontainerheight = $navheight + 20;
my $loggedin = pm::bc_chef::cookie_get("loggedin");
my $db = sql_connect("ns.db");
if ($loggedin !~ /^A6DE0E8077|7EE22A4BBF$/i) {
if (not isUserAdmin($loggedin)) {
print error_redir("/", "Access Denied");
exit 1;
}
}
######################################################################
+############
######################################################################
+############
######################################################################
+############
######################################################################
+############
######################################################################
+############
# much of the code is redacted here, and only what you need is include
+d
# things like "display_debug_one" and related are redacted, since they
+ just
# display things and have no real affect / effect on the data at all
my $COOL_DOT = "<font size=4> • </font>";
my $rv = "cache-control: no-store\n";
$rv .= "content-type: text/html\n\n";
$rv .= "<html>\n";
$rv .= "<head>\n";
$rv .= " <title>NS Debug Page</title>\n";
$rv .= " <link rel=stylesheet href='css.pl?debugger=1'>\n";
$rv .= "</head>\n";
$rv .= "<body>\n";
# a paramater to capture the selected PM with
my $debug_page = get_constant($db, "QUERY_DEBUG_PAGE");
my $pm = lc(get_param($debug_page));
if (not $pm) {
# this part redacted, since it simply displays a menu...
# end if (not $pm)
} else { # if $pm contains a value
if ($pm eq "chef") {
################################
# bc_chef TESTS
$rv .= display_module("bc_chef", "Chef");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Cookie Tests </td></tr></table></center><hr><
+br><br>\n";
$rv .= pm::bc_chef::_tests();
} elsif ($pm eq "date") {
############
# date TESTS
$rv .= display_module("date", "Date");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Date Tests </td></tr></table></center><hr><br
+><br>\n";
$rv .= pm::date::_tests();
} elsif ($pm eq "dir") {
############
# bc_dir TESTS
$rv .= display_module("bc_dir", "Directory");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Dir Tests </td></tr></table></center><hr><br>
+<br>\n";
$rv .= pm::bc_dir::_tests();
} elsif ($pm eq "misc") {
############
# bc_misc TESTS
$rv .= display_module("bc_misc", "Miscellaneous");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Misc Tests </td></tr></table></center><hr><br
+><br>\n";
$rv .= pm::bc_misc::_tests();
} elsif ($pm eq "sql") {
############
# bc_sql TESTS
$rv .= display_module("bc_sql", "SQL");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> SQL Tests </td></tr></table></center><hr><br>
+<br>\n";
$rv .= pm::bc_sql::_tests();
} elsif ($pm eq "user") {
############
# user TESTS
$rv .= display_module("user", "User");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> User Tests </td></tr></table></center><hr><br
+><br>\n";
$rv .= pm::user::_tests();
} elsif ($pm eq "html") {
############
# html TESTS
$rv .= display_module("html", "HTML");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> HTML Tests </td></tr></table></center><hr><br
+><br>\n";
$rv .= pm::html::_tests();
} elsif ($pm eq "redir") {
############
# redir TESTS
$rv .= display_module("redir", "Redirection");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Redirection Tests </td></tr></table></center>
+<hr><br><br>\n";
$rv .= pm::redir::_tests();
} elsif ($pm eq "search") {
############
# search TESTS
$rv .= display_module("search", "Search");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Search Tests </td></tr></table></center><hr><
+br><br>\n";
$rv .= pm::search::_tests();
} elsif ($pm eq "security") {
############
# security TESTS
$rv .= display_module("security", "Security");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Security Tests </td></tr></table></center><hr
+><br><br>\n";
$rv .= pm::security::_tests();
} elsif ($pm eq "subdesc") {
############
# subdesc TESTS
$rv .= display_module("subdesc", "SubDesc");
$rv .= "<br><a name=subtests class=anchor></a><br><hr><center><tab
+le border=$BORDER cellpadding=0 cellspacing=0 class=subnavbar><tr><td
+ class=title> Security Tests </td></tr></table></center><hr
+><br><br>\n";
# no tests needed. "debug.pl" uses the subdesc module EVERYWHERE,
+ so it is tested and if it fails, you'll know...
#$rv .= pm::subdesc::_tests();
$rv .= "no tests performed here: debug.pl is the test!<br>\n";
} elsif ($pm eq "faq") {
$rv .= display_faq();
# no associated debugging output
} elsif ($pm eq "howto") {
$rv .= display_howto();
# no associated debugging output
} elsif ($pm eq "notes") {
$rv .= display_notes();
# no associated debugging output
} elsif ($pm eq "ppdebug") {
$rv .= display_paypal_debugger();
# no additional debugging output
} else {
$rv .= "Unrecognized module selected: $pm<br>\n";
}
# end else of if (not $pm)
}
oh! and i guess you could use a _test() function, too for the example i'm showing. hopefully i've covered it all finally...if i missed something, do let me know, i'll post it. but i gotta get this solved.
i totally get how to use a single pm. i'm wondering why i get these silly errors....
security.pm - d:/apache24/htdocs/pm/security.pm
########################
sub _tests(;$) {
#*
# to test all <i>pm::security</i> functions
#*
my ($extended) = @_; # show extended data (optional)
my $rv = "";
my $loggedin = pm::bc_chef::cookie_get("loggedin");
my $test = "";
my $test2 = "";
my $test3 = "";
my @atest = ();
my %htest = {};
my $db = sql_connect("ns.db");
if ($db) {
$rv .= pm::html::display_debug_code("get_phrase(\$db)", get_phrase
+($db));
$rv .= pm::html::display_debug_code("get_about_page(\$db)", get_ab
+out_page($db));
$rv .= pm::html::display_debug_code("get_home_page(\$db, \"\")", g
+et_home_page($db, ""));
$test = "SITE_NAME";
$rv .= pm::html::display_debug_one("get_constant(\$db, \"$test\")"
+, get_constant($db, $test));
$test = pm::bc_chef::cookie_get("loggedin");
$rv .= pm::html::display_debug_one("user_exists(\$db, \"$test\")",
+ user_exists($db, $test));
$test = "991B146AEC";
$rv .= pm::html::display_debug_one("msg_exists(\$db, \"$test\")",
+user_exists($db, $test));
$test = "31-1";
$rv .= pm::html::display_debug_one("get_city_name(\$db, \"$test\")
+", get_city_name($db, $test));
$rv .= pm::html::display_debug_one("get_country_name(\$db, \"$test
+\")", get_country_name($db, $test));
$test2 = "6132F16686";
#$test3 = "7EE22A4BBF";
$test3 = "1237EE22A4BBF";
@atest = (); push @atest, ($test2, $test3);
$test = "select * from 'ccinfo' where ID = ? and UID = ?";
$rv .= pm::html::display_debug_one("sql_execute_bound(\$db, \"$tes
+t\", \\\@values)", sql_execute_bound($db, $test, \@atest));
$test = "Canada";
$rv .= pm::html::display_debug_one("get_country_id_byName(\$db, \"
+$test\")", get_country_id_byName($db, $test));
$rv .= pm::html::display_debug_one("get_profile_views_count(\$db,
+$loggedin)", get_profile_views_count($db, $loggedin));
$rv .= pm::html::display_debug_one("ipn_exists(\$db, \"$test\")",
+ipn_exists($db, $test));
$rv .= pm::html::display_debug_one("ban_exists(\$db, \"$test\")",
+ban_exists($test));
$rv .= pm::html::display_debug_one("ccid_exists(\$db, \"$test\")",
+ ccid_exists($test));
$test = "index.pl";
$rv .= pm::html::display_debug_one("file_exists(\"$test\")", file_
+exists($test));
$test = "C8E0B9312F";
$rv .= pm::html::display_debug_one("fma_exists(\$db, \"$loggedin\"
+, \"$test\")", fma_exists($db, $loggedin, $test));
$test = 3;
$rv .= pm::html::display_debug_one("get_body_asWord(\$db, $test)",
+ get_body_asWord($db, $test));
$test = "31-20";
$rv .= pm::html::display_debug_one("get_city_id(\"$test\")", get_c
+ity_id($test));
$rv .= pm::html::display_debug_one("get_city_name(\$db, \"$test\")
+", get_city_name($db, $test));
$test = "31-20";
$rv .= pm::html::display_debug_one("get_country_id(\"$test\")", ge
+t_country_id($test));
%htest = pm::user::get_user_stats($loggedin);
$rv .= pm::html::display_debug_one("theme_exists(\$db, \"$htest{TI
+D}\")", theme_exists($db, $htest{TID}));
$rv .= pm::html::display_debug_one("get_default_theme()", get_defa
+ult_theme());
$test = 1;
$rv .= pm::html::display_debug_one("get_eye_clr_asWord(\$db, \"$te
+st\")", get_eye_clr_asWord($db, $test));
$test++;
$rv .= pm::html::display_debug_one("get_hair_clr_asWord(\$db, \"$t
+est\")", get_hair_clr_asWord($db, $test));
$test++;
$rv .= pm::html::display_debug_one("get_gender_asWord(\$db, \"$tes
+t\")", get_gender_asWord($db, $test));
$test++;
$rv .= pm::html::display_debug_one("get_height_asWord(\$db, \"$tes
+t\")", get_height_asWord($db, $test));
$test++;
$rv .= pm::html::display_debug_one("get_weight_asWord(\$db, \"$tes
+t\")", get_weight_asWord($db, $test));
$test++;
$rv .= pm::html::display_debug_one("get_orientation_asWord(\$db, \
+"$test\")", get_orientation_asWord($db, $test));
$test = "31-20";
$rv .= pm::html::display_debug_one("get_location(\$db, \"$test\")"
+, get_location($db, $test));
$rv .= pm::html::display_debug_one("get_profile_views_count(\$db,
+\"$loggedin\")", get_profile_views_count($db, $loggedin));
$test = "genders";
@atest = get_config($db, $test);
$rv .= pm::html::display_debug_many("get_config(\$db, \"$test\")",
+ \@atest, "<br>");
@atest = get_cities($db);
$rv .= pm::html::display_debug_many("get_cities(\$db)", \@atest, "
+, ", 1);
@atest = get_country_cities($db, "31");
$rv .= pm::html::display_debug_many("get_country_cities(\$db)", \@
+atest, ", ", 1);
@atest = get_zodiacs($db);
$rv .= pm::html::display_debug_many("get_zodiacs(\$db)", \@atest,
+", ", 0);
@atest = (); for (my $z = 1; $z <= 12; $z++) { push @atest, get_zo
+diac_icon($z); }
$rv .= pm::html::display_debug_many("get_zodiac_icon([1..12])", \@
+atest, "", 0);
$test = "203537B0FF";
$rv .= pm::html::display_debug_many("get_theme_data(\$db, \"$test\
+")", get_theme_data($db, $test), "<br>", 0);
$test = "select value from 'zodiacs' order by ID";
$rv .= pm::html::display_debug_many("sql_execute(\$db, \"$test\")"
+, sql_execute($db, $test), ", ");
$test = "zodiacs";
@atest = get_config($db, $test);
$rv .= pm::html::display_debug_many("get_config(\$db, \"$test\")",
+ \@atest, ", ");
@atest = get_countries($db);
$rv .= pm::html::display_debug_many("get_countries(\$db)", \@atest
+, ", ", 1);
@atest = get_errors($db);
#push @atest, $test;
#push @atest, \@atest;
$rv .= pm::html::display_debug_large("get_errors(\$db)", \@atest,
+1);
@atest = get_constants($db);
$rv .= pm::html::display_debug_large("get_constants(\$db)", \@ates
+t, 1);
sql_disconnect($db);
} else {
$rv .= "DB connection error!<br>\n";
}
return $rv; # a scalar of the results of all tests
#usage: print _tests();
}
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
It looks like you are using pm::html routines in pm::security::_tests. So where is the use pm::html statement in pm::security ?
Is it debug.pl that is giving the errors. Is so, post the exact error messages that you are getting
poj
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
Re^3: Perl Modules
by thanos1983 (Parson) on Jun 20, 2017 at 20:49 UTC
|
Hello again jamroll,
Let's take the question one at a time. Why you should use Package name as first letter capital? Read the perlman:perlstyle:
From the link above regarding the packages:
Package names are sometimes an exception to this rule. Perl informally
+ reserves lowercase module names for ``pragma'' modules like integer
+and strict. Other modules should begin with a capital letter and use
+mixed case, but probably without underscores due to limitations in pr
+imitive file systems' representations of module names as files that m
+ust fit into a few sparse bytes.
Having said that I would recommend renaming the directory to Pm/Security the same applies to the rest of the modules that you are using. Let's move on to the next problem, calling the module.
You are saying that you have a main.pl script that gives you the error:
Undefined subroutine &pm::security::banned called at pm/user.pm line 1
+36
Let's try to replicate the problem. I am creating the directories as you say d:/apache24/htdocs/pm/user.pm
I would modify a bit your module so I would recommend to do the same on the rest of your modules. First of all I use also use warnings; for many reasons make your code more safe. Second from the Perl documentation Exporter/Selecting What to Export:
Do not export anything else by default without a good reason!
Exports pollute the namespace of the module user. If you must export t
+ry to use @EXPORT_OK in preference to @EXPORT and avoid short or comm
+on symbol names to reduce the risk of name clashes.
Having said that I modify your Export to Export_OK. On your modules you need to close them with 1;. Why? Read the perlmod/Making your module threadsafe:
If it returns a true value, then no objects of that class will be clon
+ed; or rather, they will be copied as unblessed, undef values.
If this is not enough also read Perl Module ending without 1;. Having said that I add also 1; at the end of your module.
Sample of your module based on the modifications that I propose Security.pm in the directory of my local PC /home/tinyos/apache24/htdocs.
package Pm::Security;
#/
# a module to encapsulate security-related functions
#/
use CGI;
use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT_OK = 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 resu
+lt 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 reversed @_; # 0 when the user is not banned
#usage: if (banned($db, $uid)) { print "yer banned, bitch"; }
}
1;
Now that we have defined and applied minor modification to your module let's try to call it for execution from our main.pl:
Sample of main.pl script, remember the path is relevant to my local PC but it should work for your PC with minor modifications:
#!usr/bin/perl
use say;
use strict;
use warnings;
use lib '/home/tinyos/apache24/htdocs';
use Pm::Security qw( banned );
my @list = qw (First ~ Second);
say banned(@list);
__END__
$ perl main.pl
Second~First
A minor detail to add here I call the script from a different directory where the dir Pm is located. I manage to do that by using the lib module. If I comment out this line # use lib '/home/tinyos/apache24/htdocs'; I get the following expected error:
$ perl main.pl
Can't locate Pm/Security.pm in @INC (you may need to install the Pm::S
+ecurity module) (@INC contains: /home/tinyos/perl5/lib/perl5/5.24.1/x
+86_64-linux-gnu-thread-multi /home/tinyos/perl5/lib/perl5/5.24.1 /hom
+e/tinyos/perl5/lib/perl5/x86_64-linux-gnu-thread-multi /home/tinyos/p
+erl5/lib/perl5 /etc/perl /usr/local/lib/x86_64-linux-gnu/perl/5.24.1
+/usr/local/share/perl/5.24.1 /usr/lib/x86_64-linux-gnu/perl5/5.24 /us
+r/share/perl5 /usr/lib/x86_64-linux-gnu/perl/5.24 /usr/share/perl/5.2
+4 /usr/local/lib/site_perl /usr/lib/x86_64-linux-gnu/perl-base) at ma
+in.pl line 7.
BEGIN failed--compilation aborted at main.pl line 7.
Of course it is because Perl is not aware of my Pm::Security module that I have defined in my directory.
One last question, why you are calling your function as sub banned($$) I was looking online regarding this because I never used it before and I found perlvar/General Variables:
LinuxThreads is now obsolete on Linux, and caching getpid() like this
+made embedding perl unnecessarily complex (since you'd have to manual
+ly update the value of $$), so now $$ and getppid() will always retur
+n the same values as the underlying C library.
If this is the case why don't you call getppid instead of $$. Maybe I am wrong regarding this point so another Monk could share some knowledge.
Hope this provides you enough information to resolve all of your module(s) problems.
Seeking for Perl wisdom...on the process of learning...not there...yet!
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
yes. seems everything is working most excellently. i have no clue how to thank you enough! so, i extend glorious amounts of thanks to you, and everyone else who replied - it's been a giant help. i even book marked that ebook that was linked to by another monk.
the module Pm::Bc_chef doesn't like having use Pm::User; in it. Well, it actually causes Pm::User to throw the "subroutine not defined" error message (because use Pm::Bc_chef; is in the module Pm::User. so, if chef needs to refer to a user module subroutine, i can't put use Pm::User; in Bc_chef.pm. baffling, but it's working.
so grateful
JamRoll
Btw - is my coding awful? i've always wondered, and hoped you folks might be willing to grade it without killing my itty bitty ego too much... ;)
is there more of my code you would like to see? i can let you peek under the hood, so to speak, to get a better feel for how i go about doing things. i'd really like some constructive input on it, too....i know it's way off topic here, so perhaps PM me...I'll be on and off fairly often, doing my (re)search(es).
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
... everything is working most excellently. i have no clue how to thank you enough!
Hint, hint: the Offering Plate.
... is my coding awful? i've always wondered ... i can let you peek under the hood ... i'd really like some constructive input on it ...
As a registered user, you have a public scratchpad (see your personal node). You could post code there and solicit comments in the Chatterbox. The scratchpad is limited to 64K, but nobody is going to read anywhere near that much code (not for free, anyway), so don't go crazy. I would post code examples that are complete (or as complete as reasonably possible).
Update:
... hoped you folks might be willing to grade it without killing my itty bitty ego too much ...
I've seen the code you've posted in this thread. Constructive criticism, offered bluntly, can be pretty bruising. Please don't ask for something you aren't willing to receive.
Give a man a fish: <%-{-{-{-<
| [reply] [Watch: Dir/Any] [d/l] |
|
nope! things don't seem to be meshing nicely....
and oh no! @INC will no longer include .! That's inconvenient. But, not impossible to move my modules to a folder in @INC
Pm::Redir is claiming pre_html_header() isn't defined - this routine is found in Pm::Html
the subs Pm::Redir::redir and Pm::Redir::redir3 both call Pm::Html::pre_html_header()
now granted, Pm::Html does use a bunch of other modules i've created. i haven't checked those modules to see if they include Pm::Redir, but would it matter if Pm::Html uses a module which then includes Pm::Redir??
here's the code:
just the header to ./Pm::Html
package Pm::Html;
#/
# functions for displaying HTML elements
#/
my $DEBUGGER = 0;
my $TABLE_BORDER = "0";
########################
use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
use URI::Escape;
########################
use Pm::Bc_chef qw(cookie_get);
use Pm::Bc_sql qw(get_race_asWord
get_zodiacs get_themes
get_constant
get_theme_data
get_config
get_cities
get_countries
sql_execute
get_users
get_site_name
get_home_page
user_exists
get_location
get_phrase
);
use Pm::Bc_misc qw(get_param
add_numeric_suffix
shorten_str
);
use Pm::Date qw(expand_date
determine_zodiac
get_today
get_month
);
use Pm::Search qw(search_terms);
use Pm::User qw(get_user_stats
get_user_friend_requests
get_user_blocked_users
get_user_unread_messages
get_user_stat
get_user_fuck_alert_count
get_user_pic
get_user_dp
get_user_stats_asIcons
get_user_friends
);
########################
our $VERSION = 1.00;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
_tests
pre_html_header
header
footer
table
fieldset
fieldset_constricted
div
tdata
trow
radio
checkbox
textarea
unordered_list
ordered_list
li
href
img
dropdown
input
display_404_page
display_about_page
display_chat
display_city_names
display_city_names_asDropdown
display_country_names
display_country_names_asDropdown
display_forgot_page
display_blocked
display_friends
display_fuck_me_alerts
display_homepage
display_mail
display_navbar
display_pay_page
display_photos_page
display_searchbar
display_signup_page
display_stats_page
display_theme_names
display_theme_names_asDropdown
display_titlebar
display_todays_birthdays
display_user_card
display_user_card_mini
display_user_list
display_admin_page
display_admin_ustats_editor
display_admin_uphotos_editor
display_admin_uflags_editor
display_admin_umsgs_editor
display_years_forDropdowns
display_users_forDropdowns
display_config_forDropdowns
display_zodiac_icon
display_debug_one
display_debug_many
display_debug_code
display_debug_large
get_config_forDropdowns
:debug
);
%EXPORT_TAGS = (
debug => [qw(display_debug_one display_debug_many disp
+lay_debug_code display_debug_large _tests)],
);
########################
and the Pm::Redir code:
package Pm::Redir;
#/
# Client Redirections
#/
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use URI::Escape;
use Exporter;
use vars qw($VERSION @ISA @EXPORT_OK);
use Pm::Bc_chef qw(cookie_set);
use Pm::Html qw(display_debug_one
display_debug_many
display_debug_code
display_debug_large
pre_html_header
); # i'm not using :debug cuz that don't work either!
$VERSION = 1.00;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
_tests
redir
redir3
error_redir
notice_redir
);
##############################
sub redir($$) {
#*
# redirects a client browser to a specified URL (may include a msg)
#*
my ($url, $msg) = @_; # a url to redirect to && a msg
my $html = pre_html_header();
$html =~ s/content-type\: text\/html\n\n//i;
if ($msg)
{ $html .= "status: 302 $msg\n"; } else
{ $html .= "status: 302 redir ok\n"; }
$html .= "location: $url\n\n";
return $html; # a scalar
#usage print redir("/", "invalid page");
}
##############################
sub redir3($$$) {
#*
# redirects a client browser to a specified URL (may include a msg)
# can add a cookie to the redirect (for errors or msgs or other thin
+gs you deem necessary)
# this is NOT version 3 of the redir command. it's a 3 param comman
+d!
#*
my ($url, $msg, $type) = @_; # a url to redirect to && a msg && a ms
+g type ('e' or 'n', or whatever else you like)
my $html = "";
if ($type) { $html = cookie_set($type, $msg, 0); }
my $html .= pre_html_header();
$html =~ s/content-type\: text\/html\n\n//i;
$msg = uri_escape($msg);
$html .= "status: 302 $msg\n";
$html .= "location: $url\n\n";
return $html; # a scalar
#usage: print redir3("/", "Access Denied by redir3", 'e')
}
##############################
sub error_redir($$) {
#*
# redirects a client browser to a specified URL (may include a msg)
# adds an 'error' cookie to the redirect
#*
my ($url, $msg) = @_; # a url to redirect to && a msg
my $html = redir3($url, $msg . " by?", 'e');
return $html; # a scalar
#usage: print error_redir("/subscribe.pl", "you must subscribe to ac
+cess this area");
}
##############################
sub notice_redir($$) {
#*
# redirects a client browser to a specified URL (may include a msg)
# adds a 'notice' cookie to the redirect
#*
my ($url, $msg) = @_; # a url to redirect to && a msg
my $html = redir3($url, $msg, 'n');
return $html; # a scalar
#usage: print notice_redir("/', "file updated!");
}
##############################
sub _tests(;$) {
#*
# to test all <i>Pm::Redir</i> functions
#*
my ($extended) = @_; # show extended data (optional)
my $rv = "";
my $loggedin = cookie_get("loggedin");
my $test = "";
my $test2 = "";
my $test3 = "";
my $db = sql_connect("ns.db");
if ($db) {
$test = "/index.pl";
$test2 = "Test Redirection";
$test3 = "n";
$rv .= display_debug_code("error_redir(\"$test\", \"$test2\")", er
+ror_redir($test, $test2));
$rv .= display_debug_code("notice_redir(\"$test\", \"$test2\")", n
+otice_redir($test, $test2));
$rv .= display_debug_code("redir(\"$test\", \"$test2\")", redir($t
+est, $test2));
$rv .= display_debug_code("redir3(\"$test\", \"$test2\", \"$test3\
+")", redir3($test, $test2, $test3));
} else {
$rv .= "DB connection error!<br>\n";
}
return $rv; # a scalar of the results of all tests
#usage: print _tests();
}
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
##############################
1;
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|
need to talk about that lib thing, too. do i need to include that? @INC already includes the current working folder (the folder where the script resides, by default anyway, and i usually just go with that). so that when i write use Pm::Security;, the system knows to look in "./pm/" (which the ./ in my case is my web server's document root D:/Apache24/htdocs/) without me having to include use lib "...." in my code. um, what else was there about that....drawing a blank. anyway - i'll continue the modifications to my code. when i have completed the updates, and ran a test, i'll come back.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
ok. your modification suggestions seem to be working gloriously! i'm continuing to update the modules and scripts to the changes. so far so good. so, i give you my most sincere gratitude in your help, and believe me you will get a kudos on the site's about page when I'm done. My promise on that. I'll report back when I have completed the update. Again, thank you so much for your help.
| [reply] [Watch: Dir/Any] |
|
|