#
# BANMAN - The BANNERMATIC Manager
# Displays, edits and E-Mails your banner data.
# REQUIRES BannerMatic version 1, 2 or 3.
#
# Filename: banman.pl
# Copyright: 1997-2006 by Joe DePasquale
# Last revised: September 15, 2006
# E-Mail: crypt@getcruising.com
# Website: http://www.getcruising.com
#
########################################################################
# #
# This script and accompanying files may be distributed freely #
# and modified, provided this header with my name, E-Mail address and #
# this notice remain intact. Ownership rights remain with me. You may #
# not sell this script without my approval. #
# #
# This script comes with no guarantee or warranty except for my good #
# intentions. By using this code you agree to indemnify me from any #
# liability that might arise from it's use. #
# #
# There is NO TECHNICAL SUPPORT for this script. Writing Perl is a #
# hobby and my limited time does not permit replying to most E-Mail. #
# #
########################################################################
# Setup stuff and get form input
sub banman {
read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@cgiPairs = split(/&/,$buffer);
foreach $cgiPair (@cgiPairs)
{
($name, $value) = split(/=/,$cgiPair);
$value =~ s/\+/ /g;
$value =~ s/%(..)/pack("c",hex($1))/ge;
$Form{$name} .= "\0" if (defined($Form{$name}));
$Form{$name} .= "$value";
}
undef $name; undef $value;
print qq|Content-type: text/html\n\n|;
print qq|<html>\n<head><title>$headTitle</title>\n|;
print qq|<link rel="stylesheet" href="$styleUrl" type="text/css"></head>\n|;
print qq|$bodyTag\n$bodyTitle<p>\n|;
######################################################################
# Case: Add a new banner record
if ($Form{'addban'})
{
&passtest ($BANPWD);
print <<__ADDBAN;
<form action="$scriptUrl" method=POST>
<input type=hidden name=password value="$Form{'password'}">
<table border=1>
<tr><td>URL</a></td><td><input type=text name=url value="http://" size=70></td></tr>
<tr><td>Image (gif/jpg)</td><td><input type=text name=img value="http://" size=70></td></tr>
<tr><td>Click-thrus</td><td><input type=text name=urlttl value="0" size=70 maxlength=70></td></tr>
<tr><td>Impressions</td><td><input type=text name=imgttl value="0" size=70 maxlength=70></td></tr>
<tr><td>Groups</td><td><input type=text name=groups size=60 maxlength=70></td></tr>
<tr><td>Start Date</td><td><input type=text name=startdate value="$dateStamp" size=70 maxlength=70></td></tr>
<tr><td>E-Mail</td><td><input type=text name=email size=70></td></tr>
</table><br>
<input type=submit name=saveban value=" SAVE "> <input type=submit value="IGNORE"></form>
<p>
</body></html>
__ADDBAN
} # end case addban
######################################################################
# Case: Edit a banner record
elsif ($Form{'editban'})
{
&passtest ($BANPWD);
if (defined $Form{'bannbr'})
{ print qq|<form action="$scriptUrl" method=POST>\n|;
print qq|<input type=hidden name=password value="$Form{'password'}">\n|;
$banNbr = $Form{'bannbr'}+0;
print qq|<input type=hidden name=bannbr value="$Form{'bannbr'}">\n|;
open (BANDAT,"<$BANDAT") || &endMan ("Read: $BANDAT");
flock (BANDAT,1);
seek (BANDAT,0,0);
@banFile = <BANDAT>;
close (BANDAT);
@banLine = split (/\|/,$banFile[$banNbr]);
if ($banLine[2] >0)
{ $ratio = "1<b>:</b>".sprintf ("%d",($banLine[3]/$banLine[2]));
} else
{ $ratio = "0";
}
print <<__EDITBAN;
<table border=1>
<tr><td>Banner #<br>$banNbr</td><td><a href="$banLine[0]"><img src="$banLine[1]" border=1></a></td></tr>
<tr><td><a href="$banLine[0]">URL</a></td><td><input type=text name=url value="$banLine[0]" size=70></td></tr>
<tr><td><a href="$banLine[1]">Image</a></td><td><input type=text name=img value="$banLine[1]" size=70></td></tr>
<tr><td>Click-thrus</td><td><input type=text name=urlttl value="$banLine[2]" size=70></td></tr>
<tr><td>Impressions</td><td><input type=text name=imgttl value="$banLine[3]" size=70></td></tr>
<tr><td>Ratio</td><td>$ratio</td></tr>
<tr><td>Groups</td><td><input type=text name=groups value="$banLine[4]" size=70></td></tr>
<tr><td>Start Date</td><td><input type=text name=startdate value="$banLine[5]" size=70></td></tr>
<tr><td><a href="mailto:$banLine[6]">E-Mail</a></td><td><input type=text name=email value="$banLine[6]" size=70></td></tr>
</table><br>
<input type=submit name=saveban value=" SAVE "> <input type=submit value="IGNORE"></form>
<p>
</body></html>
__EDITBAN
} else
{ print "<b>ERROR</b>: No Banners to Edit.\n<p>\n";
&bantbl;
}
} # end case editban
######################################################################
# Case: Delete banner data
elsif ($Form{'delban'})
{
&passtest ($BANPWD);
if (defined $Form{'bannbr'})
{
open (LOCK,">$BANFLK") || &endMan ("Write: $BANFLK");
if (!flock (LOCK,2)) { &endMan ("Lock: $BANFLK"); }
open (BANDAT,"+<$BANDAT") || &endMan ("Read\/Write: $BANDAT");
flock (BANDAT,2);
seek (BANDAT,0,0);
@banFile = <BANDAT>;
open (UNDO,">$BANUNDO") || &endMan ("Write: $BANUNDO");
flock (UNDO,2);
seek (UNDO,0,0);
print (UNDO @banFile);
truncate (UNDO, tell (UNDO)); close (UNDO);
$banNbr = $Form{'bannbr'}+0;
splice (@banFile,$banNbr,1);
seek (BANDAT,0,0);
print (BANDAT @banFile);
truncate (BANDAT,tell (BANDAT)); close (BANDAT);
close (LOCK);
print "Banner <b>#$banNbr</b> DELETED.\n<p>\n";
} else
{ print "<b>ERROR</b>: No Banners to Delete.\n<p>\n";
}
&bantbl;
} # end case delban
######################################################################
# Case: Save add/edit banner data
elsif ($Form{'saveban'})
{
&passtest ($BANPWD);
if ($Form{'urlttl'}) {$urlTtl = $Form{'urlttl'};} else {$urlTtl = 0;}
if ($Form{'imgttl'}) {$imgTtl = $Form{'imgttl'};} else {$imgTtl = 0;}
$newLine = join ("\|",$Form{'url'},$Form{'img'},$urlTtl,$imgTtl,$Form{'groups'},$Form{'startdate'},$Form{'email'});
$newLine =~ s/\s//g; # delete whitespace
$newLine .= "\|\n";
if ($newLine =~ /http:\/\/.+?\..+?\|.+?\|\d+\|\d+\|.*\|\d{8}\|\S+?\@\S+?(\.\S+)+\|\n$/)
{ open (LOCK,">$BANFLK") || &endMan ("Write: $BANFLK");
if (!flock (LOCK,2)) { &endMan ("Lock: $BANFLK"); }
open (BANDAT,"+<$BANDAT") || &endMan ("Read\/Write: $BANDAT");
flock (BANDAT,2);
seek (BANDAT,0,0);
@banFile = <BANDAT>;
open (UNDO,">$BANUNDO") || &endMan ("Write: $BANUNDO");
flock (UNDO,2);
seek (UNDO,0,0);
print (UNDO @banFile);
truncate (UNDO,tell(UNDO)); close (UNDO);
if (defined $Form{'bannbr'})
{ $banNbr = $Form{'bannbr'}+0;
$banFile[$banNbr] = $newLine;
} else # new banner
{ push (@banFile,$newLine);
}
seek (BANDAT,0,0);
print (BANDAT @banFile);
truncate (BANDAT,tell(BANDAT)); close (BANDAT);
close (LOCK);
print "New banner data accepted for: $Form{'url'}.\n<p>\n";
} else
{ print "<b>ERROR</b>: Bad format prevented saving input.\n<p>$newLine\n<p>\n";
}
&bantbl;
} # end saveban
######################################################################
# Case: Restore banner dat file
elsif ($Form{'undoban'})
{
&passtest ($BANPWD);
if (-s $BANUNDO)
{
open (LOCK,">$BANFLK") || &endMan ("Write: $BANFLK");
if (!flock (LOCK,2)) { &endMan ("Lock: $BANFLK"); }
open (UNDO,"<$BANUNDO") || &endMan ("Read: $BANUNDO");
flock (UNDO,1); seek (UNDO,0,0);
@banFile = <UNDO>;
close (UNDO);
open (BANDAT,">$BANDAT") || &endMan ("Write: $BANDAT");
flock (BANDAT,2); seek (BANDAT,0,0);
print (BANDAT @banFile);
truncate (BANDAT,tell(BANDAT)); close (BANDAT);
close (LOCK);
print "Last change(s) to banner file undone.\n<p>\n";
} else
{ print "<b>ERROR</b>: Unable to restore.\n<p>\n";
}
&bantbl;
} # end undoban
######################################################################
# Case: Output stats for selected banner(s)
elsif ($Form{'banstats'})
{
if ($Form{'email'} =~ /\S+?\@\S+?(\.\S+)+/)
{ $email = $Form{'email'};
open (BANDAT,"<$BANDAT") || &endMan ("Read: $BANDAT");
flock (BANDAT,1); seek (BANDAT,0,0);
@banFile = <BANDAT>;
close (BANDAT);
open (MAIL,"|$mailCmd -t") || &endMan ("Open $mailCmd: $email");
print MAIL "To: $email\nFrom: $myMail\n";
print MAIL "Subject: Banner Statistics Report\n\n";
print MAIL "Requested from $headTitle\nfor The Above E-Mail Address:\n\n";
$banNbr =0; $urlTtl =0; $imgTtl =0; $ratio =0; $foundCnt =0;
while ($banNbr <= $#banFile)
{ @banLine = split (/\|/,$banFile[$banNbr]);
if ($banLine[6] =~ /$email/i)
{ if ($banLine[2] >0)
{ $ratio = "1:".sprintf ("%d",($banLine[3]/$banLine[2]));
} else
{ $ratio = "0";
}
$urlTtl += $banLine[2];
$imgTtl += $banLine[3];
print MAIL "Activity for Banner #$banNbr since $banLine[5]:\r\n";
print MAIL "URL: $banLine[0]\r\nBanner Image: $banLine[1]\r\n";
print MAIL " Click-thru's: $banLine[2]\r\n Impressions: $banLine[3]\r\n";
print MAIL " Ratio: $ratio\r\n Groups: $banLine[4]\r\n\r\n";
$foundCnt++;
}
$banNbr++;
}
if ($foundCnt > 0)
{ if ($urlTtl >0)
{ $ratio = "1:".sprintf ("%d",($imgTtl/$urlTtl));
} else
{ $ratio = "0";
}
print MAIL "- - - - - - - - - - - - - - - - - - - - - - - - -\r\n";
print MAIL "SUMMARY For E-Mail: $email:\r\n";
print MAIL " Total Click-thru's: $urlTtl\r\n Total Impressions: $imgTtl\r\n";
print MAIL " Average Click/Impression Ratio: $ratio\r\n\r\n";
print MAIL "End report for $foundCnt banners on $timeStamp.\r\n\r\n";
} else
{ print MAIL "No banners were found for $email.\r\n\r\n";
}
if (open (SIG,"<$MYSIG"))
{ @mySig = <SIG>;
foreach $sig (@mySig)
{ chomp $sig;
print MAIL "$sig\r\n";
}
close (SIG);
} else
{ print MAIL "$myName <$myMail>\r\n$homeUrl\r\n";
}
close (MAIL);
print qq|<b>Your requested report has been E-Mailed to $email.</b>\n|;
print qq|<p><i><b>BANNERMATIC</b> is one of <a href="http://www.getcruising.com/crypt" target="_top">Joe's CGI Scripts From The Crypt!</a></i>\n|;
print qq|<p></body></html>\n|;
} else
{ &endMan ("Invalid E-Mail Format.");
}
} # end case banstats
######################################################################
# Default case: View banner table
else
{ &passtest ($BANPWD);
&bantbl
} # end default
} # end banman
######################################################################
sub bantbl # view banner table
{
open (BANDAT,"<$BANDAT") || &endMan ("Read: $BANDAT");
flock (BANDAT,1);
seek (BANDAT,0,0);
@banFile = <BANDAT>;
close (BANDAT);
print qq|<form action="$scriptUrl" method=POST>\n|;
print qq|<input type=hidden name=password value="$Form{'password'}">\n|;
print qq|<p><table border=1><tr>\n|;
print qq|<th width=5%>Select<br>Banner</th><th width=15%>URL</th><th width=15%>IMG</th><th width=10%>URL<br>total</th><th width=10%>IMG<br>total</th><th width=10%>Ratio</th><th width=10%>Groups</th><th width=5%>Start<br>Date</th><th width=20%>E-Mail</th>\n|;
$banNbr =0; $urlTtl =0; $imgTtl =0; $ratio =0;
while ($banNbr <= $#banFile)
{ print "\n</tr><tr>\n";
@banLine = split (/\|/,$banFile[$banNbr]);
if ($banLine[2] >0)
{ $ratio = "1<b>:</b>".sprintf ("%d",($banLine[3]/$banLine[2]));
} else
{ $ratio = "0";
}
print qq|<td align=right><input type=radio name=bannbr value="$banNbr"> $banNbr</td><td><a href="$banLine[0]">$banLine[0]</a></td>\n|;
print qq|<td><a href="$banLine[1]">$banLine[1]</a></td><td align=right>$banLine[2]</td><td align=right>$banLine[3]</td>\n|;
print qq|<td align=right>$ratio</td><td>$banLine[4]</td><td>$banLine[5]</td><td><a href="mailto:$banLine[6]">$banLine[6]</a></td>\n|;
$urlTtl = $urlTtl + $banLine[2];
$imgTtl = $imgTtl + $banLine[3];
$banNbr++;
}
if ($urlTtl >0)
{ $ratio = "1<b>:</b>".sprintf ("%d",($imgTtl/$urlTtl));
} else
{ $ratio = "0";
}
print <<__VIEWBAN;
</tr><tr align=right>
<th colspan=3><nobr>Total for $banNbr banners on $timeStamp</nobr></th>
<th>$urlTtl</th><th>$imgTtl</th><th>$ratio</th><td colspan=3> </td>
</tr></table><p>
<input type=submit name="addban" value=" ADD "> <input type=submit name="editban" value=" EDIT ">
<input type=submit name="delban" value="DELETE"> <input type=submit name="undoban" value=" UNDO ">
<input type=reset value="CLEAR"></form>
<p><a href="$exitUrl">Exit $headTitle</a>
<p><i><b>BANNERMATIC</b> is one of <a href="http://www.getcruising.com/crypt" target="_top">Joe's CGI Scripts From The Crypt!</a></i>
<p>
</body>
</html>
__VIEWBAN
} # end bantbl
sub passtest # Password routines
{
$PASSFILE = $_[0];
if (-s $PASSFILE)
{ if ($Form{'password'})
{ open (PASS,"<$PASSFILE");
$passcode = <PASS>;
close (PASS);
chop ($passcode) if $passcode =~ /\n$/;
$lp = length $Form{'password'};
$salt = substr($Form{'password'},$lp-2,1).substr($Form{'password'},1,1);
if ($passcode eq crypt ($Form{'password'},$salt))
{ if ($Form{'newpassword'})
{ $lp = length $Form{'newpassword'};
if ($Form{'newpassword'} =~ /^\w{$lp}\b/)
{ $Form{'password'} = $Form{'newpassword'};
$salt = substr($Form{'password'},$lp-2,1).substr($Form{'password'},1,1);
$passcode = crypt ($Form{'password'},$salt);
open (PASS,">$PASSFILE");
print PASS "$passcode";
close (PASS);
} else
{ &passbox ("Bad choice, Creep!!");
}
}
} else
{ &passbox ("Wrong, Creep!!");
}
} else
{ &passbox ("What's the Password, Creep?");
}
} else
{ &endMan ("Password File $PASSFILE Not Found");
}
}
sub passbox
{
print <<__PASSBOX;
<form action="$scriptUrl" method="POST">
<table border=4>
<tr><th colspan=2><font color="#FF0000"><b><blink>$_[0]</blink></b></font></th></tr>
<tr><th>Enter Password:</td><th><input type=password name=password size=12 maxlength=12></th></tr>
<tr><th>Change Password:</td><th><input type=text name=newpassword size=12 maxlength=12></th></tr>
<th colspan=2><input type=submit value=" DO IT! "><input type=reset value=" CLEAR "></th></tr>
</table><br>
Password must be 4 to 12 alpha-numeric characters.</form>\n<p>
__PASSBOX
exit;
}
sub endMan # Error handling for manager scripts
{
print qq|<font color="#FF0000"><b>ERROR:</font><br>$_[0]</b>\n<p>|;
if ($!) { print "Server made a Boo-Boo! $!\n"; }
else { print "Use your browser's [BACK] button and try again.\n"; }
print "<p>\n</body>\n</html>\n";
exit;
} # end endMan
1; # return true