Talk:Environments
Jump to navigation
Jump to search
get_datasheet.cgi
sourcetweet: <CrashSerious> : GOOGLE FUN: found a cached copy of Sony's PERL cgi page's source from the latest hack --> http://is.gd/ZIgISa
# !/usr/local/bin/perl
# http://products.sel.sony.com/cgi-bin/semi/get_datasheet.cgi
eval {
#########################################################
# Read in the string from the form
#########################################################
if ($ENV{'REQUEST_METHOD'} eq "GET") {
$FORM_DATA = $ENV{'QUERY_STRING'};
} else {
$LENGTH = $ENV{'CONTENT_LENGTH'};
while ($LENGTH) {
$FORM_DATA .= getc(STDIN);
$LENGTH--;
}
}
#########################################################
# Split the input string into individual variables
#########################################################
foreach (split(/&/, $FORM_DATA)) {
($NAME, $VALUE) = split(/=/, $_);
$NAME =~ s/\+/ /g;
$NAME =~ s/%([0-9|A-F]{2})/pack(C,hex($1))/eg;
$VALUE =~ s/\+/ /g;
$VALUE =~ s/%([0-9|A-F]{2})/pack(C,hex($1))/eg;
# find a unique name for select boxes
$NUM ="0";
while ($FORMDATA{$NAME} ne "") {
$NUM++;
$NAME =~ s/\.([0-9]+$)|$/\.$NUM/;
}
$FORMDATA{$NAME} = $VALUE;
}
$product = $FORMDATA{"product"};
$product =~ tr/a-z/A-Z/;
$docdirname = "/ws/w1/htmldocs/shared/semi/PDF/";
$docext = "pdf";
$docurlbase = "/semi/PDF/";
$filename = "$docdirname$product.$docext";
$default = "$product.$docext";
local(@matched, @ids, $re);
# get a list of the product ids
opendir(DOCDIR, $docdirname) || die($ENV{'SCRIPT_NAME'}||$0. ": opendir(): can't open directory \"$docdirname\": $!\n");
@ids = readdir(DOCDIR);
closedir(DOCDIR);
@ids = grep(/\.$docext$/i && s/\.$docext$//i, @ids);
if(@matched == 0) {
# make a regexp of possible $product matches
$re = $product;
# look for match
@matched = grep(/$re/i, @ids);
}
if(@matched == 0) {
# make a regexp of possible $product matches
$re = join("|", omit_list(+1, $product),
omit_list(-1, $product),
miss_list(-1, $product),
transpose_list($product));
$re = '^(?:'.$re.')$';
# look for match
@matched = grep(/$re/i, @ids);
}
# sort @matched
sub sortsub {
my $ta, $tb;
($ta = $a) =~ tr/A-Z/a-z/;
($tb = $b) =~ tr/A-Z/a-z/;
$ta cmp $tb;
}
@matched = sort sortsub @matched;
# if((! -r $filename) && (@matched != 1))) {
if(@matched == 1) {
$errmsg = "<p>The product code you entered, $product, is similar to this product: ".
join("", map("<a href=\"$docurlbase$_.$docext\">$_</a>", @matched)).
". If this is not what you wanted, you can try another product code, or go to a product category, by selecting it below.";
} elsif(@matched > 1) {
$errmsg = "<p>The product code you entered, $product, is similar to these products: <ul>".
join("", map("<li><a href=\"$docurlbase$_.$docext\">$_</a>", @matched)).
"</ul> <p>If none of these are what you wanted, you can try another product code, or go to a product category, by selecting it below.";
} else {
$errmsg = "<p><center><H2>Sorry, the product code you entered does not exist. Please try another product code, or go to a product category by selecting it below.</H2></center>";
}
};
###
###
$error_file = "/ws/w1/htmldocs/shared/semi/searcherror.html";
$errmsg_spot_re = "<!--%ERRGOESHERE%-->";
if($errmsg || $@) {
$errmsg = $errmsg || "the script encountered a serious problem and couldn't complete your request: $@";
print("Content-type: text/html\n\n");
open(ERROR, $error_file);
$e = join("", (<ERROR>));
close(ERROR);
if($e ne '') {
$e =~ s/$errmsg_spot_re/$errmsg/g;
} else {
$e = "Serious error: $!, and $errmsg";
}
$e .= "\n";
print($e);
}
# package alink::oneoff;
sub uniq { my %H = (); grep(!$H{$_}++, @_); }
sub nonuniq { my %H = (); grep($H{$_}++ == 1, @_); }
sub omit_list {
my $e_len = shift;
my @R = ();
my $g;
foreach $g (@_) {
my $g_len = length($g);
if($e_len > 0) {
push(@R, uniq(omit_list($e_len-1, map(substr($g,0,$_).".".substr($g,$_), (0..$g_len)))));
} elsif($e_len < 0) {
push(@R, uniq(omit_list($e_len+1, map(substr($g,0,$_).substr($g,$_+1), (0..$g_len-1)))));
} else {
push(@R, $g);
}
}
@R;
}
sub miss_list {
my $e_len = shift;
my @R = ();
my $g;
foreach $g (@_) {
my $g_len = length($g);
if($e_len < 0) {
push(@R, uniq(miss_list($e_len+1, map(substr($g,0,$_).".".substr($g,$_+1), (0..$g_len-1)))));
} else {
push(@R, $g);
}
}
@R;
}
sub transpose_list {
my @R = ();
my $g;
foreach $g (@_) {
my $g_len = length($g);
push(@R, uniq(map(substr($g,0,$_-1).substr($g,$_,1).substr($g,$_-1,1).substr($g,$_+1), (1..$g_len-1))));
}
@R;
}
## examples
## fetch some words
#chop(@l = (<>));
## regexps for if one letter was omitted
#print(map($_."\n", omit_list(+1, @l)));
## regexps for if one extra letter was added
#print(map($_."\n", omit_list(-1, @l)));
## regexps for if one letter was screwed up
#print(map($_."\n", miss_list(-1, @l)));
## regexps for if two letters were transposed
#print(map($_."\n", transpose_list(@l)));
## possible matches if one letter were omitted
#print(map($_."\n", omit_list(-1, @l)));
## possible matches if two letters were transposed
#print(map($_."\n", transpose_list(@l)));
## check for possible collisions if one letter were omitted
#print(map($_."\n", nonuniq(omit_list(-1, @l))), "\n");
## check for possible collisions if two letters were transposed
#print(map($_."\n", nonuniq(transpose_list(@l))), "\n");
# end
http://pastie.org/private/a10xmqhjufcfvvrtmuns7w
wishlist
# !/usr/bin/perl
# http://products.sel.sony.com/cgi-bin/wishlist
umask(02);
use CGI;
# Setting Security for the script
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
# Setting Global Variables
$| = 1;
$dbPath = "/w1/htmldocs/shared/santa/dbs/";
$templatePath = "/w1/htmldocs/shared/santa/templates/";
$mailprog = "/usr/lib/sendmail";
$wishlistHome ="/santa/";
#print "Content-type: text/html\n\n";
$query = new CGI;
%form = $query->Vars;
$action = $query->url_param('action');
$form{'model'} = $form{'model'} || $query->url_param('model');
$form{'list'} = $form{'list'} || $query->url_param('list');
if($action eq "login") {
if(&login($query, $form{email}, $form{password})) {
&setCookie($query, $form{email});
&selectList($query, $form{'email'}, "", $form{'model'});
} else {
$form{'error'} = 1;
&showPage("${templatePath}login.html", $query, "content", %form);
}
} elsif($action eq "register") {
if($form{'error'} = &validateForm($query, %form)) {
&showPage("${templatePath}register.html", $query, "content", %form);
} else {
if($form{'age'} > 13) {
&createAccount($query, %form);
&recordSweepStake(%form) if $form{'sweepstake'};
&setCookie($query, $form{'email'});
&selectList($query, $form{'email'}, "", $form{'model'});
} else {
dbmopen(%MINOR, "${dbPath}.minor", 0664)
|| &error("minor", "can't create minor database");
$MINOR{$form{'email'}} = $form{'age'};
dbmclose(%MINOR);
&showPage("${templatePath}minor.html", $query, "content", %form);
}
}
} elsif($action eq "showreg") {
&showPage("${templatePath}register.html", $query, "content", %form);
} elsif($action eq "santa") {
&showSanta($query, $form{'u'}, $form{'l'}, $form{'s'});
} elsif($action eq "buy") {
$products = join("~", ($form{'id1'}, $form{'id2'}, $form{'id3'}, $form{'id4'}, $form{'id5'}, $form{'id6'}, $form{'id7'}, $form{'id8'}, $form{'id9'}, $form{'id10'}));
$products =~ s/~+/~/g;
$products =~ s/~$//g;
print "Status: 302\n";
print "Location: http://sh1.yahoo.com/rmi/http://www.sonystyle.com/rmi-product-url/http://www.sonystyle.com/compass.santa.html?prodids=$products\n\n";
} else {
$user = $query->cookie('wishlistID');
if($user) {
my(%_U);
dbmopen(%_U, "${dbPath}.accounts", undef)
|| &error("other", $q, "Can't read golbal accounts database\n");
unless(defined($_U{$user})) {
dbmclose(%_U);
&setCookie($query, "", "now");
&showPage("${templatePath}login.html", $query, "", %form);
exit 0;
}
dbmclose(%_U);
} else {
&showPage("${templatePath}login.html", $query, "content", %form);
exit 0;
}
if($action eq "add") {
if($form{'choose.x'}) {
&add($query, $user, $form{'model'}, $form{'list'}) if $form{'model'};
&showListContent($query, $user, $form{'list'}, "content");
} elsif($form{'delete.x'}) {
&deleteList($query, $user, $form{'list'});
&selectList($query, $user, "", $form{'model'}, "content");
} else {
print "Status: 302\n";
print "LOCATION: $wishlistHome\n\n";
}
} elsif($action eq "create") {
my(%LISTS, $list, $count);
dbmopen(%LISTS, "$dbPath$user.lists", 0664)
|| &error("create list", $query, "Can't write to lists for $user");
$LISTS{$form{'wishlist'}} = $LISTS{$form{'wishlist'}};
$count = 0;
foreach $list (keys(%LISTS)) {
$count ++;
last if $count > 1;
}
dbmclose(%LISTS);
if($form{'model'} and $count == 1) {
&add($query, $user, $form{'model'}, $form{'wishlist'});
&showListContent($query, $user, $form{'wishlist'}, "content");
} else {
&selectList($query, $user, $form{'wishlist'}, $form{'model'}, "content");
}
} elsif($action eq "selectlist") {
my(%LISTS, $list, $count);
dbmopen(%LISTS, "$dbPath$user.lists", 0664)
|| &error("select list", $query, "Can't read lists for $user");
$count = 0;
foreach $key (keys(%LISTS)) {
$count ++;
$list = $key;
last if $count > 1;
}
dbmclose(%LISTS);
if($form{'model'} and $count == 1) {
&add($query, $user, $form{'model'}, $list);
&showListContent($query, $user, $list, "content");
} else {
&selectList($query, $user, "", $form{'model'}, "content");
}
} elsif($action eq "deleteitem") {
&deleteItem($query, $user, $form{'model'}, $form{'list'});
&showListContent($query, $user, $list, "content");
} elsif($action eq "mail") {
&mailSanta($query, $user, %form);
&showPage("${templatePath}thankyou.html", $query, "content");
} else {
&showListContent($query, $user, $form{'list'}, "content");
}
}
#&debug();
sub debug {
my $user = $query->cookie('wishlistID');
print "<h2>Action is $action and user is $user</h2>\n";
foreach $key (keys(%form)) {
print "form $key has val $form{$key}<br>\n";
}
print "<hr>\n";
foreach $key (keys(%ENV)) {
print "$key has val $ENV{$key}<br>\n";
}
}
sub showListContent {
my($q, $u, $l, $head) = @_;
my(%LISTS, %d, $list, $content, @products, %PRODUCTS);
if(-e "$dbPath$u.lists.dir") {
dbmopen(%LISTS, "$dbPath$u.lists", undef)
|| &error("showListContent", $q, "Can't read from lists for $u");
foreach $list (sort keys(%LISTS)) {
$l = $list unless $l;
if($l eq $list) {
$d{'lists'} .= "<option value=\"$list\" selected>$list</option>";
$content = $LISTS{$l};
} else {
$d{'lists'} .= "<option value=\"$list\">$list</option>";
}
}
$d{'list'} = $l;
dbmclose(%LISTS);
&showPage("${templatePath}wishlist.head.html", $q, $head, %d);
dbmopen(%PRODUCTS, "${dbPath}.products", undef)
|| &error("showListContent", $q, "Can't read product lists");
@products = split(/ # /, $content);
foreach $content (@products) {
$d{'img'} = $d{'model'} = $content;
($d{'id'}, $d{'price'}, $d{'name'}, $d{'link'}) = split(/ # /, $PRODUCTS{$content});
$d{'price'} = "\$$d{'price'}";
$d{'img'} =~ s/\///g;
&showPage("${templatePath}wishlist.loop.html", $q, "", %d);
}
dbmclose(%PRODUCTS);
&showPage("${templatePath}wishlist.foot.html", $q, "", %d);
} else {
&selectList($q, $u, $l, "", $head);
}
}
sub deleteList {
my($q, $user, $mylist) = @_;
my(%_LISTS);
dbmopen(%_LISTS, "${dbPath}$user.lists", 0664)
|| &error("add", $q, "Can't add $i to list $w for $u");
delete($_LISTS{$mylist});
dbmclose(%_LISTS);
}
sub selectList {
my($q, $user, $mylist, $item, $content) = @_;
my(%d);
$d{'model'} = $item;
if(-e "$dbPath$user.lists.dir") {
my(%LISTS, $list);
dbmopen(%LISTS, "$dbPath$user.lists", undef)
|| &error("selectlist", $q, "Can't read from lists for $user");
foreach $list (sort keys(%LISTS)) {
if($mylist eq $list) {
$d{'lists'} .= "<option value=\"$list\" selected>$list</option>";
} else {
$d{'lists'} .= "<option value=\"$list\">$list</option>";
}
}
dbmclose(%LISTS);
&showPage("${templatePath}selectlist.head.html", $q, $content, %d);
if($d{'lists'}) {
&showPage("${templatePath}selectlist.havelist.html", $q, "", %d);
} else {
&showPage("${templatePath}selectlist.blank.html", $q, "", %d);
}
} else {
&showPage("${templatePath}selectlist.head.html", $q, $content, %d);
&showPage("${templatePath}selectlist.blank.html", $q, "", %d);
}
&showPage("${templatePath}selectlist.foot.html", $q);
}
sub add {
my($q, $u, $i, $wishlist) = @_;
my(%_LISTS);
dbmopen(%_LISTS, "${dbPath}$u.lists", 0664)
|| &error("add", $q, "Can't add $i to list $wishlist for $u");
if($_LISTS{$wishlist} !~ /$i/) {
$_LISTS{$wishlist} = join(" # ", (split(/ # /, $_LISTS{$wishlist}), $i));
}
dbmclose(%_LISTS);
}
sub deleteItem {
my($q, $u, $i, $w) = @_;
my(%_LISTS);
dbmopen(%_LISTS, "${dbPath}$u.lists", 0664)
|| &error("add", $q, "Can't add $i to list $w for $u");
if($_LISTS{$w} =~ /$i/) {
$_LISTS{$w} =~ s/$i//g;
$_LISTS{$w} =~ s/( # )+/$1/g;
$_LISTS{$w} =~ s/^ # //g;
$_LISTS{$w} = "" if $_LISTS{$w} eq " # ";
}
dbmclose(%_LISTS);
}
sub setCookie {
my($q, $_id) = @_;
my $cookie = $q->cookie(-name=>'wishlistID',
-value=>$_id,
-secure=>0);
print $q->header(-cookie=>$cookie);
}
sub login {
my($q, $_id, $_pw) = @_;
my(%_U);
if(-e "${dbPath}.accounts") {
dbmopen(%_U, "${dbPath}.accounts", undef)
|| &error("login", $q, "Can't read golbal accounts database\n");
} else {
dbmopen(%_U, "${dbPath}.accounts", 0664)
|| &error("login", $q, "Can't read golbal accounts database\n");
}
if(defined($_U{"\L$_id"}) and ($_U{"\L$_id"} eq $_pw)) {
dbmclose(%_U);
return 1;
} else {
dbmclose(%_U);
return 0;
}
}
sub validateForm {
my($q, %_data) = @_;
my($error) = "";
my($_ACCTS);
# Check for error
$error = "";
if(-e "${dbPath}.minor") {
dbmopen(%_ACCTS, "${dbPath}.minor", undef)
|| &error("validateForm", $q, "Can't read minor database");
} else {
dbmopen(%_ACCTS, "${dbPath}.minor", 0664)
|| &error("validateForm", $q, "Can't create minor database");
}
if(defined($_ACCTS{$_data{'email'}})) {
&showPage("${templatePath}minor.html", $query, "content", %form);
exit 0;
}
dbmclose(%_ACCTS);
if(-e "${dbPath}.accounts") {
dbmopen(%_ACCTS, "${dbPath}.accounts", undef)
|| &error("validateForm", $q, "Can't read accounts database");
} else {
dbmopen(%_ACCTS, "${dbPath}.accounts", 0664)
|| &error("validateForm", $q, "Can't create accounts database");
}
if(defined($_ACCTS{$_data{'email'}})) {
$error .= "<li>Account with email address $_data{'email'} already exits</li>";
}
dbmclose(%_ACCTS);
if(&pit($_data{'email'})) {
$error .= "<li>Invalid Email Address</li>"
if $_data{'email'} !~ m/\@.+\./;
} else {
$error .= "<li>Missing email address</li>";
}
$error .= "<li>Missing Password</li>" unless &pit($_data{'password'});
$error .= "<li>Missing Confirmation Password</li>" unless &pit($_data{'confirmpassword'});
if($_data{'password'} ne $_data{'confirmpassword'}) {
$error .= "<li>Two passwords are different</li>";
}
$error .= "<li>Missing First Name</li>" unless &pit($_data{'firstname'});
$error .= "<li>Missing Last Name</li>" unless &pit($_data{'lastname'});
$error .= "<li>Missing Address</li>" unless &pit($_data{'address'});
$error .= "<li>Missing City</li>" unless &pit($_data{'city'});
$error .= "<li>Missing State</li>" unless &pit($_data{'state'});
if(&pit($_data{'state'})) {
$error .= "<li>Invalid State</li>" if $_data{'state'} !~ m/^[a-zA-Z]{2}/;
}
if(&pit($_data{'zip'})) {
$error .= "<li>Invalid Zip</li>" if $_data{'zip'} !~ m/^\d{5,}/;
} else {
$error .= "<li>Missing Zip</li>";
}
return $error;
}
sub createAccount {
my($q, %_info) = @_;
my(%_ACCTS);
dbmopen(%_ACCTS, "${dbPath}.accounts", 0664)
|| &error("createAccount", $q, "Can't modify accounts database");
$_ACCTS{"\L$_info{'email'}"} = $_info{'password'};
dbmclose(%_ACCTS);
dbmopen(%_ACCTS, "${dbPath}$_info{'email'}", 0664)
|| &error("createAccount", $q, "Can't create account database for $_infp{'email'}");
$_ACCTS{'firstname'} = $_info{'firstname'};
$_ACCTS{'lastname'} = $_info{'lastname'};
$_ACCTS{'address'} = $_info{'address'};
$_ACCTS{'address2'} = $_info{'address2'};
$_ACCTS{'city'} = $_info{'city'};
$_ACCTS{'state'} = $_info{'state'};
$_ACCTS{'zip'} = $_info{'zip'};
$_ACCTS{'sweepstake'} = $_info{'sweepstake'};
$_ACCTS{'info'} = $_info{'info'};
$_ACCTS{'age'} = $_info{'age'};
dbmclose(%_ACCTS);
}
sub recordSweepStake {
my(%_info) = @_;
my($dataFile) = "${dbPath}sweepstake.xls";
if(-e $dataFile) {
open(OUTPUT, ">>$dataFile") || die "can't append to file $dataFile\n";
} else {
open(OUTPUT, ">$dataFile") || die "can't append to file $dataFile\n";
print OUTPUT "First Name\tLast Name\tAddress\tAddress 2\tCity\tState\tZip\tE-mail\tGet Info\n";
}
print OUTPUT "$_info{firstname}\t$_info{lastname}\t$_info{address1}\t$_info{address2}\t$_info{city}\t$_info{state}\t$_info{zip}\t$_info{info}\n";
close(OUTPUT);
return;
}
sub mailSanta {
my($q, $u, %d) = @_;
my(%U, %PRODUCTS, @products, %LISTS, $p, $fname);
dbmopen(%U, "$dbPath$u", undef)
|| &error("mailSanta", $q, "Can't read user info for $u");
$fname = $U{'firstname'};
dbmclose(%U);
open(MAIL, "|$mailprog -t -f$u") || die "cannot send email\n";
print MAIL "To: $d{'email'}\n";
print MAIL "Subject: YOU'RE SOMEBODY'S SPECIAL SANTA\n\n";
print MAIL "YOU'RE SOMEBODY'S SPECIAL SANTA\n\n";
print MAIL "Hey $d{'santa'}, $fname has chosen YOU as a special Santa this year.\n\n";
print MAIL "\"That's great\", you might be saying, \"but I don't know what to get!\" Well, $fname has made it easy by creating a Sony Wishlist for you to choose from. It's filled with cool Sony stuff $fname would love to find under the tree.\n\n";
$d{'list'} =~ s/ /%20/g;
$d{'santa'} =~ s/ /%20/g;
print MAIL "Ready to see the list $fname created? Just click below:\n\n";
print MAIL "http://63.224.30.26$ENV{'SCRIPT_NAME'}?action=santa&u=$u&l=$d{'list'}&s=$d{'santa'}\n\n";
print MAIL "GET A FREE GIFT FROM SONYSTYLE.COM\n";
print MAIL "We at Sonystyle.com are doing our part to make your holiday shopping easy, too! When you spend \$300 on items found on the Wishlist, you'll get a free thank you gift from Sony.\n\n";
print MAIL "To get your free gift, click below to download a special coupon:\n";
print MAIL "http://promo.iq.com/common/e.jsp?vgid=22927&p=DI&e=1&ref=IQREPLACETEXT\n\n";
print MAIL "So make $fname happy, and you'll receive a free thank you gift from Sony for being such a good Santa.\n\n";
print MAIL "Happy Holidays from $fname, Sony, and Sonystyle.com!\n\n";
close(MAIL);
open(MSG, ">$dbPath$u.$d{'list'}$d{'santa'}.txt")
|| &error("mailSanta", $q, "Can't save message to $d{'santa'} from $u with list $d{'list'}");
$d{'message'} =~ s/\n/<br>/g;
print MSG "$d{'message'}\n";
close(MSG);
#print MAIL "------------------------------------------------------------\n";
#dbmopen(%LISTS, "$dbPath$u.lists", undef)
#|| &error("mailSanta", $q, "Can't read from lists for $u");
#@products = split(/ # /, $LISTS{$d{'list'}});
#dbmclose(%LISTS);
#dbmopen(%PRODUCTS, "${dbPath}.products", undef)
#|| &error("mailSanta", $q, "Can't read product lists");
#foreach $p (@products) {
#my($price, $name) = split(/ # /, $PRODUCTS{$p});
#print MAIL "$p\t\t\$$price\t\t$name\n";
#}
#dbmclose(%PRODUCTS);
#print MAIL "------------------------------------------------------------\n";
}
sub error {
my($q, $_where, $_msg) = @_;
my(%d);
$d{'where'} = $_where;
$d{'msg'} = $_msg;
&showPage("${templatePath}error.html", $q, "", "content", %d);
exit 0;
}
sub showSanta {
my($q, $u, $l, $s) = @_;
my(%detail, %L, %U, @products);
$detail{'message'} = "Dear $s:<br><br>";
$l =~ s/ /%20/g;
$s =~ s/ /%20/g;
open(MSG, "$dbPath$u.$l$s.txt")
|| &error("showSanta", $q, "Can't read message to $s from $u with list $l");
while(<MSG>) {
$detail{'message'} .= $_
}
close(MSG);
dbmopen(%U, "$dbPath$u", undef) || &error("showSanta", $q, "can't read user information for $u");
$detail{'message'} .= "<br><br>From $U{'firstname'} $U{'lastname'}";
dbmclose(%U);
&showPage("${templatePath}santa.head.html", $q, "content", %detail);
$l =~ s/%20/ /g;
dbmopen(%L, "$dbPath$u.lists", undef) || &error("showSanta", $q, "can't read list content for $u");
@products = split(/ # /, $L{$l});
dbmclose(%L);
dbmopen(%L, "${dbPath}.products", undef) || &error("showSanta", $q, "can't read products");
$detail{i} = 1;
foreach $content (@products) {
$detail{'img'} = $detail{'model'} = $content;
($detail{'id'}, $detail{'price'}, $detail{'name'}, $detail{'link'}) = split(/ # /, $L{$content});
$detail{'price'} = "\$$detail{'price'}";
if($detail{'link'} =~ /\/(\w+)\.html/) {
$detail{'link'} = "$`/productinfo/${1}2.html";
}
$detail{'img'} =~ s/\///g;
&showPage("${templatePath}santa.loop.html", $q, "", %detail);
$detail{i}++;
}
dbmclose(%L);
&showPage("${templatePath}santa.foot.html", $q, "", %detail);
}
sub showPage {
my($template, $q, $content, %Form) = @_;
my(@input, $i);
local(*_MYINPUT);
if($content) {
print "Content-type: text/html\n\n";
}
open(_MYINPUT, $template) || die "can't read from $template\n";
while(<_MYINPUT>) {
$input[$i] = $_;
$i++;
}
close(_MYINPUT);
for($i=0; $i<@input; $i++) {
&processLine($input[$i], %Form);
}
}
sub processLine {
my($inputline, %Form) = @_;
my($condition, $then, $else, $line);
my($begin, $end, $pitline);
$inputline =~ s/REPLACEME/$wishlistHome/g;
if ($inputline =~ m/<!--%(.+)%-->/) {
$begin = $`;
$end = $';
$pitline = $1;
if ($pitline =~ /\? (.*)::/) {
$condition = $`;
$then = $1;
$else = $';
} elsif ($pitline =~ /\? /) {
$condition = $`;
$then = $';
}
if ($condition) {
$condition = &pit($condition);
$then = &pit($then);
$else = &pit($else) if $else;
if (&evalCond($condition, %Form)) {
$line = $then;
} elsif ($else) {
$line = $else;
}
$line =~ s/\$((\w|\d|-)+)/$Form{$1}/g;
print "$begin$line$end";
} else {
$pitline = &pit($pitline);
$pitline =~ s/\$((\w|\d|-)+)/$Form{$1}/g;
print "$begin$pitline$end";
}
} else {
print $inputline;
}
}
sub evalCond {
my($condition, %Form) = @_;
my(@temp, $index);
@temp = split(/ /, $condition);
for($index=0; $temp[$index]; $index++) {
$temp[$index] =~ s/\$((\w|\d|-)+)/\$Form{'$1'}/g;
}
$condition = join(" ", @temp);
return eval $condition;
}
sub pit {
local($pit) = @_;
$pit =~ s/^\s*(.*?)\s*$/$1/;
return $pit;
}
http://pastie.org/private/ze67cma7zbw5itd0nkopw
sweepstake.xls
# !/usr/bin/perl
# http://products.sel.sony.com/shared/santa/dbs/sweepstake.xls
umask(02);
use CGI;
# Setting Security for the script
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
# Setting Global Variables
$| = 1;
$dbPath = "/w1/htmldocs/shared/santa/dbs/";
$templatePath = "/w1/htmldocs/shared/santa/templates/";
$mailprog = "/usr/lib/sendmail";
$wishlistHome ="/santa/";
#print "Content-type: text/html\n\n";
$query = new CGI;
%form = $query->Vars;
$action = $query->url_param('action');
$form{'model'} = $form{'model'} || $query->url_param('model');
$form{'list'} = $form{'list'} || $query->url_param('list');
if($action eq "login") {
if(&login($query, $form{email}, $form{password})) {
&setCookie($query, $form{email});
&selectList($query, $form{'email'}, "", $form{'model'});
} else {
$form{'error'} = 1;
&showPage("${templatePath}login.html", $query, "content", %form);
}
} elsif($action eq "register") {
if($form{'error'} = &validateForm($query, %form)) {
&showPage("${templatePath}register.html", $query, "content", %form);
} else {
if($form{'age'} > 13) {
&createAccount($query, %form);
&recordSweepStake(%form) if $form{'sweepstake'};
&setCookie($query, $form{'email'});
&selectList($query, $form{'email'}, "", $form{'model'});
} else {
dbmopen(%MINOR, "${dbPath}.minor", 0664)
|| &error("minor", "can't create minor database");
$MINOR{$form{'email'}} = $form{'age'};
dbmclose(%MINOR);
&showPage("${templatePath}minor.html", $query, "content", %form);
}
}
} elsif($action eq "showreg") {
&showPage("${templatePath}register.html", $query, "content", %form);
} elsif($action eq "santa") {
&showSanta($query, $form{'u'}, $form{'l'}, $form{'s'});
} elsif($action eq "buy") {
$products = join("~", ($form{'id1'}, $form{'id2'}, $form{'id3'}, $form{'id4'}, $form{'id5'}, $form{'id6'}, $form{'id7'}, $form{'id8'}, $form{'id9'}, $form{'id10'}));
$products =~ s/~+/~/g;
$products =~ s/~$//g;
print "Status: 302\n";
print "Location: http://sh1.yahoo.com/rmi/http://www.sonystyle.com/rmi-product-url/http://www.sonystyle.com/compass.santa.html?prodids=$products\n\n";
} else {
$user = $query->cookie('wishlistID');
if($user) {
my(%_U);
dbmopen(%_U, "${dbPath}.accounts", undef)
|| &error("other", $q, "Can't read golbal accounts database\n");
unless(defined($_U{$user})) {
dbmclose(%_U);
&setCookie($query, "", "now");
&showPage("${templatePath}login.html", $query, "", %form);
exit 0;
}
dbmclose(%_U);
} else {
&showPage("${templatePath}login.html", $query, "content", %form);
exit 0;
}
if($action eq "add") {
if($form{'choose.x'}) {
&add($query, $user, $form{'model'}, $form{'list'}) if $form{'model'};
&showListContent($query, $user, $form{'list'}, "content");
} elsif($form{'delete.x'}) {
&deleteList($query, $user, $form{'list'});
&selectList($query, $user, "", $form{'model'}, "content");
} else {
print "Status: 302\n";
print "LOCATION: $wishlistHome\n\n";
}
} elsif($action eq "create") {
my(%LISTS, $list, $count);
dbmopen(%LISTS, "$dbPath$user.lists", 0664)
|| &error("create list", $query, "Can't write to lists for $user");
$LISTS{$form{'wishlist'}} = $LISTS{$form{'wishlist'}};
$count = 0;
foreach $list (keys(%LISTS)) {
$count ++;
last if $count > 1;
}
dbmclose(%LISTS);
if($form{'model'} and $count == 1) {
&add($query, $user, $form{'model'}, $form{'wishlist'});
&showListContent($query, $user, $form{'wishlist'}, "content");
} else {
&selectList($query, $user, $form{'wishlist'}, $form{'model'}, "content");
}
} elsif($action eq "selectlist") {
my(%LISTS, $list, $count);
dbmopen(%LISTS, "$dbPath$user.lists", 0664)
|| &error("select list", $query, "Can't read lists for $user");
$count = 0;
foreach $key (keys(%LISTS)) {
$count ++;
$list = $key;
last if $count > 1;
}
dbmclose(%LISTS);
if($form{'model'} and $count == 1) {
&add($query, $user, $form{'model'}, $list);
&showListContent($query, $user, $list, "content");
} else {
&selectList($query, $user, "", $form{'model'}, "content");
}
} elsif($action eq "deleteitem") {
&deleteItem($query, $user, $form{'model'}, $form{'list'});
&showListContent($query, $user, $list, "content");
} elsif($action eq "mail") {
&mailSanta($query, $user, %form);
&showPage("${templatePath}thankyou.html", $query, "content");
} else {
&showListContent($query, $user, $form{'list'}, "content");
}
}
#&debug();
sub debug {
my $user = $query->cookie('wishlistID');
print "<h2>Action is $action and user is $user</h2>\n";
foreach $key (keys(%form)) {
print "form $key has val $form{$key}<br>\n";
}
print "<hr>\n";
foreach $key (keys(%ENV)) {
print "$key has val $ENV{$key}<br>\n";
}
}
sub showListContent {
my($q, $u, $l, $head) = @_;
my(%LISTS, %d, $list, $content, @products, %PRODUCTS);
if(-e "$dbPath$u.lists.dir") {
dbmopen(%LISTS, "$dbPath$u.lists", undef)
|| &error("showListContent", $q, "Can't read from lists for $u");
foreach $list (sort keys(%LISTS)) {
$l = $list unless $l;
if($l eq $list) {
$d{'lists'} .= "<option value=\"$list\" selected>$list</option>";
$content = $LISTS{$l};
} else {
$d{'lists'} .= "<option value=\"$list\">$list</option>";
}
}
$d{'list'} = $l;
dbmclose(%LISTS);
&showPage("${templatePath}wishlist.head.html", $q, $head, %d);
dbmopen(%PRODUCTS, "${dbPath}.products", undef)
|| &error("showListContent", $q, "Can't read product lists");
@products = split(/ # /, $content);
foreach $content (@products) {
$d{'img'} = $d{'model'} = $content;
($d{'id'}, $d{'price'}, $d{'name'}, $d{'link'}) = split(/ # /, $PRODUCTS{$content});
$d{'price'} = "\$$d{'price'}";
$d{'img'} =~ s/\///g;
&showPage("${templatePath}wishlist.loop.html", $q, "", %d);
}
dbmclose(%PRODUCTS);
&showPage("${templatePath}wishlist.foot.html", $q, "", %d);
} else {
&selectList($q, $u, $l, "", $head);
}
}
sub deleteList {
my($q, $user, $mylist) = @_;
my(%_LISTS);
dbmopen(%_LISTS, "${dbPath}$user.lists", 0664)
|| &error("add", $q, "Can't add $i to list $w for $u");
delete($_LISTS{$mylist});
dbmclose(%_LISTS);
}
sub selectList {
my($q, $user, $mylist, $item, $content) = @_;
my(%d);
$d{'model'} = $item;
if(-e "$dbPath$user.lists.dir") {
my(%LISTS, $list);
dbmopen(%LISTS, "$dbPath$user.lists", undef)
|| &error("selectlist", $q, "Can't read from lists for $user");
foreach $list (sort keys(%LISTS)) {
if($mylist eq $list) {
$d{'lists'} .= "<option value=\"$list\" selected>$list</option>";
} else {
$d{'lists'} .= "<option value=\"$list\">$list</option>";
}
}
dbmclose(%LISTS);
&showPage("${templatePath}selectlist.head.html", $q, $content, %d);
if($d{'lists'}) {
&showPage("${templatePath}selectlist.havelist.html", $q, "", %d);
} else {
&showPage("${templatePath}selectlist.blank.html", $q, "", %d);
}
} else {
&showPage("${templatePath}selectlist.head.html", $q, $content, %d);
&showPage("${templatePath}selectlist.blank.html", $q, "", %d);
}
&showPage("${templatePath}selectlist.foot.html", $q);
}
sub add {
my($q, $u, $i, $wishlist) = @_;
my(%_LISTS);
dbmopen(%_LISTS, "${dbPath}$u.lists", 0664)
|| &error("add", $q, "Can't add $i to list $wishlist for $u");
if($_LISTS{$wishlist} !~ /$i/) {
$_LISTS{$wishlist} = join(" # ", (split(/ # /, $_LISTS{$wishlist}), $i));
}
dbmclose(%_LISTS);
}
sub deleteItem {
my($q, $u, $i, $w) = @_;
my(%_LISTS);
dbmopen(%_LISTS, "${dbPath}$u.lists", 0664)
|| &error("add", $q, "Can't add $i to list $w for $u");
if($_LISTS{$w} =~ /$i/) {
$_LISTS{$w} =~ s/$i//g;
$_LISTS{$w} =~ s/( # )+/$1/g;
$_LISTS{$w} =~ s/^ # //g;
$_LISTS{$w} = "" if $_LISTS{$w} eq " # ";
}
dbmclose(%_LISTS);
}
sub setCookie {
my($q, $_id) = @_;
my $cookie = $q->cookie(-name=>'wishlistID',
-value=>$_id,
-secure=>0);
print $q->header(-cookie=>$cookie);
}
sub login {
my($q, $_id, $_pw) = @_;
my(%_U);
if(-e "${dbPath}.accounts") {
dbmopen(%_U, "${dbPath}.accounts", undef)
|| &error("login", $q, "Can't read golbal accounts database\n");
} else {
dbmopen(%_U, "${dbPath}.accounts", 0664)
|| &error("login", $q, "Can't read golbal accounts database\n");
}
if(defined($_U{"\L$_id"}) and ($_U{"\L$_id"} eq $_pw)) {
dbmclose(%_U);
return 1;
} else {
dbmclose(%_U);
return 0;
}
}
sub validateForm {
my($q, %_data) = @_;
my($error) = "";
my($_ACCTS);
# Check for error
$error = "";
if(-e "${dbPath}.minor") {
dbmopen(%_ACCTS, "${dbPath}.minor", undef)
|| &error("validateForm", $q, "Can't read minor database");
} else {
dbmopen(%_ACCTS, "${dbPath}.minor", 0664)
|| &error("validateForm", $q, "Can't create minor database");
}
if(defined($_ACCTS{$_data{'email'}})) {
&showPage("${templatePath}minor.html", $query, "content", %form);
exit 0;
}
dbmclose(%_ACCTS);
if(-e "${dbPath}.accounts") {
dbmopen(%_ACCTS, "${dbPath}.accounts", undef)
|| &error("validateForm", $q, "Can't read accounts database");
} else {
dbmopen(%_ACCTS, "${dbPath}.accounts", 0664)
|| &error("validateForm", $q, "Can't create accounts database");
}
if(defined($_ACCTS{$_data{'email'}})) {
$error .= "<li>Account with email address $_data{'email'} already exits</li>";
}
dbmclose(%_ACCTS);
if(&pit($_data{'email'})) {
$error .= "<li>Invalid Email Address</li>"
if $_data{'email'} !~ m/\@.+\./;
} else {
$error .= "<li>Missing email address</li>";
}
$error .= "<li>Missing Password</li>" unless &pit($_data{'password'});
$error .= "<li>Missing Confirmation Password</li>" unless &pit($_data{'confirmpassword'});
if($_data{'password'} ne $_data{'confirmpassword'}) {
$error .= "<li>Two passwords are different</li>";
}
$error .= "<li>Missing First Name</li>" unless &pit($_data{'firstname'});
$error .= "<li>Missing Last Name</li>" unless &pit($_data{'lastname'});
$error .= "<li>Missing Address</li>" unless &pit($_data{'address'});
$error .= "<li>Missing City</li>" unless &pit($_data{'city'});
$error .= "<li>Missing State</li>" unless &pit($_data{'state'});
if(&pit($_data{'state'})) {
$error .= "<li>Invalid State</li>" if $_data{'state'} !~ m/^[a-zA-Z]{2}/;
}
if(&pit($_data{'zip'})) {
$error .= "<li>Invalid Zip</li>" if $_data{'zip'} !~ m/^\d{5,}/;
} else {
$error .= "<li>Missing Zip</li>";
}
return $error;
}
sub createAccount {
my($q, %_info) = @_;
my(%_ACCTS);
dbmopen(%_ACCTS, "${dbPath}.accounts", 0664)
|| &error("createAccount", $q, "Can't modify accounts database");
$_ACCTS{"\L$_info{'email'}"} = $_info{'password'};
dbmclose(%_ACCTS);
dbmopen(%_ACCTS, "${dbPath}$_info{'email'}", 0664)
|| &error("createAccount", $q, "Can't create account database for $_infp{'email'}");
$_ACCTS{'firstname'} = $_info{'firstname'};
$_ACCTS{'lastname'} = $_info{'lastname'};
$_ACCTS{'address'} = $_info{'address'};
$_ACCTS{'address2'} = $_info{'address2'};
$_ACCTS{'city'} = $_info{'city'};
$_ACCTS{'state'} = $_info{'state'};
$_ACCTS{'zip'} = $_info{'zip'};
$_ACCTS{'sweepstake'} = $_info{'sweepstake'};
$_ACCTS{'info'} = $_info{'info'};
$_ACCTS{'age'} = $_info{'age'};
dbmclose(%_ACCTS);
}
sub recordSweepStake {
my(%_info) = @_;
my($dataFile) = "${dbPath}sweepstake.xls";
if(-e $dataFile) {
open(OUTPUT, ">>$dataFile") || die "can't append to file $dataFile\n";
} else {
open(OUTPUT, ">$dataFile") || die "can't append to file $dataFile\n";
print OUTPUT "First Name\tLast Name\tAddress\tAddress 2\tCity\tState\tZip\tE-mail\tGet Info\n";
}
print OUTPUT "$_info{firstname}\t$_info{lastname}\t$_info{address1}\t$_info{address2}\t$_info{city}\t$_info{state}\t$_info{zip}\t$_info{info}\n";
close(OUTPUT);
return;
}
sub mailSanta {
my($q, $u, %d) = @_;
my(%U, %PRODUCTS, @products, %LISTS, $p, $fname);
dbmopen(%U, "$dbPath$u", undef)
|| &error("mailSanta", $q, "Can't read user info for $u");
$fname = $U{'firstname'};
dbmclose(%U);
open(MAIL, "|$mailprog -t -f$u") || die "cannot send email\n";
print MAIL "To: $d{'email'}\n";
print MAIL "Subject: YOU'RE SOMEBODY'S SPECIAL SANTA\n\n";
print MAIL "YOU'RE SOMEBODY'S SPECIAL SANTA\n\n";
print MAIL "Hey $d{'santa'}, $fname has chosen YOU as a special Santa this year.\n\n";
print MAIL "\"That's great\", you might be saying, \"but I don't know what to get!\" Well, $fname has made it easy by creating a Sony Wishlist for you to choose from. It's filled with cool Sony stuff $fname would love to find under the tree.\n\n";
$d{'list'} =~ s/ /%20/g;
$d{'santa'} =~ s/ /%20/g;
print MAIL "Ready to see the list $fname created? Just click below:\n\n";
print MAIL "http://63.224.30.26$ENV{'SCRIPT_NAME'}?action=santa&u=$u&l=$d{'list'}&s=$d{'santa'}\n\n";
print MAIL "GET A FREE GIFT FROM SONYSTYLE.COM\n";
print MAIL "We at Sonystyle.com are doing our part to make your holiday shopping easy, too! When you spend \$300 on items found on the Wishlist, you'll get a free thank you gift from Sony.\n\n";
print MAIL "To get your free gift, click below to download a special coupon:\n";
print MAIL "http://promo.iq.com/common/e.jsp?vgid=22927&p=DI&e=1&ref=IQREPLACETEXT\n\n";
print MAIL "So make $fname happy, and you'll receive a free thank you gift from Sony for being such a good Santa.\n\n";
print MAIL "Happy Holidays from $fname, Sony, and Sonystyle.com!\n\n";
close(MAIL);
open(MSG, ">$dbPath$u.$d{'list'}$d{'santa'}.txt")
|| &error("mailSanta", $q, "Can't save message to $d{'santa'} from $u with list $d{'list'}");
$d{'message'} =~ s/\n/<br>/g;
print MSG "$d{'message'}\n";
close(MSG);
#print MAIL "------------------------------------------------------------\n";
#dbmopen(%LISTS, "$dbPath$u.lists", undef)
#|| &error("mailSanta", $q, "Can't read from lists for $u");
#@products = split(/ # /, $LISTS{$d{'list'}});
#dbmclose(%LISTS);
#dbmopen(%PRODUCTS, "${dbPath}.products", undef)
#|| &error("mailSanta", $q, "Can't read product lists");
#foreach $p (@products) {
#my($price, $name) = split(/ # /, $PRODUCTS{$p});
#print MAIL "$p\t\t\$$price\t\t$name\n";
#}
#dbmclose(%PRODUCTS);
#print MAIL "------------------------------------------------------------\n";
}
sub error {
my($q, $_where, $_msg) = @_;
my(%d);
$d{'where'} = $_where;
$d{'msg'} = $_msg;
&showPage("${templatePath}error.html", $q, "", "content", %d);
exit 0;
}
sub showSanta {
my($q, $u, $l, $s) = @_;
my(%detail, %L, %U, @products);
$detail{'message'} = "Dear $s:<br><br>";
$l =~ s/ /%20/g;
$s =~ s/ /%20/g;
open(MSG, "$dbPath$u.$l$s.txt")
|| &error("showSanta", $q, "Can't read message to $s from $u with list $l");
while(<MSG>) {
$detail{'message'} .= $_
}
close(MSG);
dbmopen(%U, "$dbPath$u", undef) || &error("showSanta", $q, "can't read user information for $u");
$detail{'message'} .= "<br><br>From $U{'firstname'} $U{'lastname'}";
dbmclose(%U);
&showPage("${templatePath}santa.head.html", $q, "content", %detail);
$l =~ s/%20/ /g;
dbmopen(%L, "$dbPath$u.lists", undef) || &error("showSanta", $q, "can't read list content for $u");
@products = split(/ # /, $L{$l});
dbmclose(%L);
dbmopen(%L, "${dbPath}.products", undef) || &error("showSanta", $q, "can't read products");
$detail{i} = 1;
foreach $content (@products) {
$detail{'img'} = $detail{'model'} = $content;
($detail{'id'}, $detail{'price'}, $detail{'name'}, $detail{'link'}) = split(/ # /, $L{$content});
$detail{'price'} = "\$$detail{'price'}";
if($detail{'link'} =~ /\/(\w+)\.html/) {
$detail{'link'} = "$`/productinfo/${1}2.html";
}
$detail{'img'} =~ s/\///g;
&showPage("${templatePath}santa.loop.html", $q, "", %detail);
$detail{i}++;
}
dbmclose(%L);
&showPage("${templatePath}santa.foot.html", $q, "", %detail);
}
sub showPage {
my($template, $q, $content, %Form) = @_;
my(@input, $i);
local(*_MYINPUT);
if($content) {
print "Content-type: text/html\n\n";
}
open(_MYINPUT, $template) || die "can't read from $template\n";
while(<_MYINPUT>) {
$input[$i] = $_;
$i++;
}
close(_MYINPUT);
for($i=0; $i<@input; $i++) {
&processLine($input[$i], %Form);
}
}
sub processLine {
my($inputline, %Form) = @_;
my($condition, $then, $else, $line);
my($begin, $end, $pitline);
$inputline =~ s/REPLACEME/$wishlistHome/g;
if ($inputline =~ m/<!--%(.+)%-->/) {
$begin = $`;
$end = $';
$pitline = $1;
if ($pitline =~ /\? (.*)::/) {
$condition = $`;
$then = $1;
$else = $';
} elsif ($pitline =~ /\? /) {
$condition = $`;
$then = $';
}
if ($condition) {
$condition = &pit($condition);
$then = &pit($then);
$else = &pit($else) if $else;
if (&evalCond($condition, %Form)) {
$line = $then;
} elsif ($else) {
$line = $else;
}
$line =~ s/\$((\w|\d|-)+)/$Form{$1}/g;
print "$begin$line$end";
} else {
$pitline = &pit($pitline);
$pitline =~ s/\$((\w|\d|-)+)/$Form{$1}/g;
print "$begin$pitline$end";
}
} else {
print $inputline;
}
}
sub evalCond {
my($condition, %Form) = @_;
my(@temp, $index);
@temp = split(/ /, $condition);
for($index=0; $temp[$index]; $index++) {
$temp[$index] =~ s/\$((\w|\d|-)+)/\$Form{'$1'}/g;
}
$condition = join(" ", @temp);
return eval $condition;
}
sub pit {
local($pit) = @_;
$pit =~ s/^\s*(.*?)\s*$/$1/;
return $pit;
}
http://pastie.org/private/0yuek1juechzkcxqq5g