Talk:Environments: Difference between revisions
Jump to navigation
Jump to search
No edit summary |
|||
(3 intermediate revisions by 2 users not shown) | |||
Line 1: | Line 1: | ||
== Possible more Environments ? == | |||
Note: if confirmed, move to main page, use this as scratchpad/notes only (saves the need to write it double, keeps it manageable on a single page) | |||
{| class="wikitable sortable" | |||
|- | |||
! Environment !! Remarks | |||
|- | |||
| C1 || | |||
|- | |||
| C2 || | |||
|- | |||
| C3 || | |||
|- | |||
| C1-PMGMT || | |||
|- | |||
| C1-PQA || | |||
|- | |||
| C1-SPINT || | |||
|- | |||
| C2-NP || | |||
|- | |||
| C2-PMGMT || | |||
|- | |||
| C2-PMGMT || | |||
|- | |||
| C3-PQA || | |||
|- | |||
| C3-SPINT || | |||
|- | |||
| C2-SPINT || | |||
|- | |||
| C3-NP || | |||
|- | |||
| Q1 || | |||
|- | |||
| Q2 || | |||
|- | |||
| Q3 || | |||
|- | |||
| Q3-PQA || | |||
|- | |||
| Q3-SPINT || | |||
|- | |||
| Q2-PMGMT || | |||
|- | |||
| Q3-NP || | |||
|- | |||
| D1 || | |||
|- | |||
| D2 || | |||
|- | |||
| D3 || | |||
|- | |||
| EI || | |||
|- | |||
| H || | |||
|- | |||
| EI (1\2\3); H,HF (1\2\3) || | |||
|- | |||
| ..... || | |||
|- | |||
|} | |||
===Name acronyms=== | |||
*NP could be a derivate from the acronym NPMT ('''Network Program''' Management Tools) used internally to publish digital contents, as explained here: [http://www.postjobfree.com/resume/ywgvjm/cardinal-robohelp-technical-san-diego-ca-92130|Link] ''"The Network Program Management Tool (NPMT) is a tool used by Sony and other third party video game developers to add their products to the Sony PlayStation Network."'' | |||
*Or '''Network Platform''', as seen in the certificate details when accessing https://a0.ww.np.dl.playstation.net/ servers (Sony Computers Entertainment Inc. - Network Platform Service Dept.). See: [[Online_Connections#Game_Updating_Procedure|Game Updating Procedure]] links and read the details of the certificate when accessing the example links | |||
== get_datasheet.cgi == | == get_datasheet.cgi == | ||
<syntaxhighlight lang="perl"> | |||
< | # !/usr/local/bin/perl | ||
# http://products.sel.sony.com/cgi-bin/semi/get_datasheet.cgi | # http://products.sel.sony.com/cgi-bin/semi/get_datasheet.cgi | ||
Line 211: | Line 278: | ||
# end | # end | ||
</ | </syntaxhighlight> | ||
http://pastie.org/private/a10xmqhjufcfvvrtmuns7w | |||
http://pastebin.com/pdBgSBBD | http://pastebin.com/pdBgSBBD | ||
Line 1,044: | Line 1,114: | ||
$_LISTS{$w} = "" if $_LISTS{$w} eq " # "; | $_LISTS{$w} = "" if $_LISTS{$w} eq " # "; | ||
} | } | ||
dbmclose(%_LISTS); | error("minor", "can't create minor database"); | ||
$MINOR{$form{'email'}} = $form{'age'}; | |||
li>Missing City /li>" unless dbmclose(%MINOR); | |||
dbmclose(%_LISTS); | |||
} | } | ||
sub setCookie { | sub setCookie { | ||
my($q, $_id) = @_; | my($q, $_id)deleteList($query, $user, $form{'list'}); | ||
pit($_data{'password'}); | |||
$error .= " = @_; | |||
my $cookie = $q->cookie(-name=>'wishlistID', | my $cookie = $q->cookie(-name=>'wishlistID', | ||
-value=>$_id, | -value=>$_id, | ||
Line 1,057: | Line 1,132: | ||
sub login { | sub login { | ||
my($q, $_id, $_pw) = @_; | my($q, $_id, $_pw) = @_; | ||
recordSweepStake(%form) if $form{'sweepstake'}; | |||
my(%_U); | |||
if(-e "${dbPath}.accounts") { | if(-e "${dbPath}.accounts") { | ||
dbmopen(%_U, "${dbPath}.accounts", undef) | dbmopen(%_U, "${dbPath}.accounts", undef) | ||
|| &error("login", $q, "Can't read golbal accounts database\n"); | || &error("login", $q, "Can't read golbal accounts database\n"); | ||
} else { | } else 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'} .= "{ | |||
dbmopen(%_U, "${dbPath}.accounts", 0664) | dbmopen(%_U, "${dbPath}.accounts", 0664) | ||
|| &error("login", $q, "Can't read golbal accounts database\n"); | || &error("login", $q, "Can't read golbal accounts database\n"); | ||
Line 1,369: | Line 1,449: | ||
---- | ---- | ||
dbmclose(%_LISTS); | |||
} | |||
sub setCookie { | |||
my($q, $_id)deleteList($query, $user, $form{'list'}); | |||
pit($_data{'password'}); | |||
$error .= " = @_; | |||
my $cookie = $q->cookie(-name=>'wishlistID', | |||
-value=>$_id, | |||
-secure=>0); | |||
print $q->header(-cookie=>$cookie); | |||
} | |||
sub login { | |||
my($q, $_id, $_pw) = @_; | |||
recordSweepStake(%form) if $form{'sweepstake'}; | |||
my(%_U); | |||
if(-e "${dbPath}.accounts") { | |||
dbmopen(%_U, "${dbPath}.accounts", undef) | |||
|| | |||
/li>"; | |||
} | |||
return $error; | |||
} | |||
sub createAccount { | |||
my($q, %_info) = @_; | |||
my(%_ACCTS); | |||
dbmopen(%_ACCTS, "${dbPath}.accounts", 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) | |||
|| |
Latest revision as of 13:58, 20 July 2014
Possible more Environments ?[edit source]
Note: if confirmed, move to main page, use this as scratchpad/notes only (saves the need to write it double, keeps it manageable on a single page)
Environment | Remarks |
---|---|
C1 | |
C2 | |
C3 | |
C1-PMGMT | |
C1-PQA | |
C1-SPINT | |
C2-NP | |
C2-PMGMT | |
C2-PMGMT | |
C3-PQA | |
C3-SPINT | |
C2-SPINT | |
C3-NP | |
Q1 | |
Q2 | |
Q3 | |
Q3-PQA | |
Q3-SPINT | |
Q2-PMGMT | |
Q3-NP | |
D1 | |
D2 | |
D3 | |
EI | |
H | |
EI (1\2\3); H,HF (1\2\3) | |
..... |
Name acronyms[edit source]
- NP could be a derivate from the acronym NPMT (Network Program Management Tools) used internally to publish digital contents, as explained here: [1] "The Network Program Management Tool (NPMT) is a tool used by Sony and other third party video game developers to add their products to the Sony PlayStation Network."
- Or Network Platform, as seen in the certificate details when accessing https://a0.ww.np.dl.playstation.net/ servers (Sony Computers Entertainment Inc. - Network Platform Service Dept.). See: Game Updating Procedure links and read the details of the certificate when accessing the example links
get_datasheet.cgi[edit source]
# !/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[edit source]
# !/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[edit source]
# !/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 " # "; } error("minor", "can't create minor database"); $MINOR{$form{'email'}} = $form{'age'}; li>Missing City /li>" unless dbmclose(%MINOR); dbmclose(%_LISTS); } sub setCookie { my($q, $_id)deleteList($query, $user, $form{'list'}); pit($_data{'password'}); $error .= " = @_; my $cookie = $q->cookie(-name=>'wishlistID', -value=>$_id, -secure=>0); print $q->header(-cookie=>$cookie); } sub login { my($q, $_id, $_pw) = @_; recordSweepStake(%form) if $form{'sweepstake'}; my(%_U); if(-e "${dbPath}.accounts") { dbmopen(%_U, "${dbPath}.accounts", undef) || &error("login", $q, "Can't read golbal accounts database\n"); } else 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'} .= "{ 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
dbmclose(%_LISTS); }
sub setCookie {
my($q, $_id)deleteList($query, $user, $form{'list'}); pit($_data{'password'}); $error .= " = @_; my $cookie = $q->cookie(-name=>'wishlistID', -value=>$_id, -secure=>0); print $q->header(-cookie=>$cookie);
}
sub login {
my($q, $_id, $_pw) = @_; recordSweepStake(%form) if $form{'sweepstake'};
my(%_U);
if(-e "${dbPath}.accounts") {
dbmopen(%_U, "${dbPath}.accounts", undef) || /li>";
}
return $error;
}
sub createAccount {
my($q, %_info) = @_; my(%_ACCTS); dbmopen(%_ACCTS, "${dbPath}.accounts", 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) ||