Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/usr/bin/perl
- 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;
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement