Once You Know, You Newegg

Some Perl Code Reference

I NEED WORK!
Anyone needing a coding, SEO, database, WordPress or related EXPERT please contact me via my contact form here.

Here is a little sub I wrote that checks a flatfile for a banned email. Needed as I am sending through my servers WELL over 200,000 emails daily for my job and I write my own list management scripts. The flatfiles that this sub searches are created / appended on the fly by the blacklist script which creates directories and files based on the first two characters of the email address. This keeps the files both smaller and directs the script to the file where the email lives instead of searching a document appx 702 times larger (so over 702 times faster?) . Pretty basic but, gets the job done. Notice first I grab the first two characters even if they are invalid for email use. This is because I allow invalid addresses to be blacklisted in the blacklist script and are located in the “other” directory. So, this sub does in fact allow invalid email address formats intentionally. This “beta” test sub is clunky, verbose and has much room for improvement but, again, gets the job done for showing one of thousands of ways to perform this task without mySQL. Makes it quite portable. Could combine several lines for the first two character test into a one line regular expression but, makes it difficult to explain the mechanics to beginners. I must write several Perl subs a day all year long for various clients or personal stuff and at times I stick with what works in testing instead of going nuts on saving a few milliseconds in execution time. Should the project go live in a real world environment, I then streamline the code. Keep in mind my security is always on the way in so, no baddie query/data can get to the subs but, should that ever happen, there is also mega security on whatever that sub touches.

sub CheckBlacklist {
### this chacks the blacklist files and pushes email into array if not in blacklist then returns new array
chomp;
$toarray = shift;
@ToArray = split /\r?\n/, $toarray;
foreach $DecodedEmailAddress(@ToArray) {
$DecodedEmailAddress = lc($DecodedEmailAddress);
$EncodedEmailAddress = encode_entities($DecodedEmailAddress);

$FirstCharacter = substr($EncodedEmailAddress,0,1);
$FirstAndSecondCharacter = substr($DecodedEmailAddress,0,2);
$SecondCharacter = substr($DecodedEmailAddress, 1, 1);
unless (($FirstCharacter =~ /\pL/) || ($FirstCharacter =~ /[0-9]/)){
$FirstCharacter = ‘failed';
}
unless ((($SecondCharacter =~ /^[.]+$/) || ($SecondCharacter =~ /^[-]+$/) || ($SecondCharacter =~ /^[_]+$/))){
unless (($SecondCharacter =~ /\pL/) || ($SecondCharacter =~ /[0-9]/)){
$SecondCharacter = ‘failed';
}
}
if (($FirstCharacter ne ‘failed’) && ($SecondCharacter ne ‘failed’)){
if($SecondCharacter =~ /^[.]+$/){
$FirstAndSecondCharacter = $FirstCharacter.’dot';
}
if($SecondCharacter =~ /^[-]+$/){
$FirstAndSecondCharacter = $FirstCharacter.’dash';
}
if($SecondCharacter =~ /^[_]+$/){
$FirstAndSecondCharacter = $FirstCharacter.’under';
}
$PathAndFile = join ‘/’, $Path, $FirstCharacter, $FirstAndSecondCharacter, $FirstAndSecondCharacter . ‘.txt';
###
} ## END if (($FirstCharacter ne ‘failed’) && ($SecondCharacter ne ‘failed’)){
else {
$PathAndFile = $Path.’/others/others.txt';
}
###
unless (-e $PathAndFile){
$Found=’0′;
}
if (-e $PathAndFile){
open $READ, ‘<', "$PathAndFile" or die $!; while (<$READ>) {
chomp;
$EmailAddress = $_;
if ($EmailAddress eq $EncodedEmailAddress){
$Found = ‘1’;
last;
}
else { $Found = ‘0’; }
}##end While
close $READ;
}
if ($Found != ‘1’) {
push(@NotBlacklisted,$EncodedEmailAddress);
}
}
return (“@NotBlacklisted”);
}
##End

————————————————————
Perl remove all alpha and return digits.

my $string = ‘test12345′;
my ($digits) = $string =~ /(\d+)/;
print $digits;

#And to get all numbers, add the ‘g’ modifier to the regex:

my $string = “TEX12900\nUH8900\nFloNumber899090\nYB28999″;
my @numbers = $string =~ /(\d+)/g;
print @numbers; # Equals “12900 8900 899090 28999″
—————————————————————–
Printing Arrays

@food = (“apples”, “pears”, “eels”);

print array $f = “@food”; # print the array food with spaces between
#so:
print @food; # By itself
print “@food”; # Embedded in double quotes
print @food.””; # In a scalar context

($a, @somefood) = @food; # $a is the first item of @food

push(@food, “eggs”, “lard”);
push(@food, (“eggs”, “lard”));
push(@food, @morefood);

#The push function returns the length of the new list.

#To remove the last item from a list and return it use the pop function. From our original list the pop function returns eels and @food now has two elements:

$grub = pop(@food); # Now $grub = “eels”

——————————————————————

open my $in, ‘<', $file or die "Can't read old file: $!"; open my $out, '>‘, “$file.new” or die “Can’t write new file: $!”;
print $out “# Add this line to the top\n”;
while( <$in> )
{
s/\b(perl)\b/Perl/g;
print $out $_;
}
close $out;
————————————————————————–
get all tables.

my $tables = $dbh->selectcol_arrayref(“SHOW_TABLES”) or die $DBI::errstr;

my @compare2;
my $compare2;
#my $cityb = cleanme($citya);
my $cityb = $citya;
print qq~cityb $cityb~;
my ($db,$user,$pass) = sookup();
my $checkexist2 = $sookup->prepare(qq{SELECT `city`,`pages`,`category`,`minprice`,`maxprice` FROM `statesettings` WHERE `city` LIKE “%$cityb%”});
$checkexist2->execute() or die “Did not execute 1″;
while(@compare2 = $checkexist2->fetchrow_array()) {
$city=$compare2[0];
$pages=$compare2[1];
$category=$compare2[2];
$minprice=$compare2[3];
$maxprice=$compare2[4];
print qq~
———- citya $citya compare2 0 $compare2[0] city $city ——————
~;
}

############################### get lines into individual arrays ###################################
#This approach stores the results of a SQL call in an array. In this example,
#the query is calling for rows with three columns of data, and printing each
#row

use DBI;

$dbh = DBI->connect(‘DBI:mysql:[DATABASE]’, ‘[USER]’, ‘[PASSWORD]’)
|| die “ERROR: $DBI::errstr”;

$query = “[SQL QUERY GOES HERE]”;

$sth = $dbh->prepare($query);

$sth->execute();

$data = $sth->fetchall_arrayref();
$sth->finish;

foreach $data ( @$data) {

($variable1, $variable2, $variable3) = @$data;

print “$variable1\n”;
print “$variable2\n”;
print “$variable3\n”;

}

$dbh->disconnect();

#############################################################