Talk:Environments

From PS3 Developer wiki
Revision as of 14:58, 20 July 2014 by Euss (talk | contribs) (→‎get_datasheet.cgi)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search

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

http://pastebin.com/pdBgSBBD

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

http://pastebin.com/6BG4k1vk

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

http://pastebin.com/H9XRfQbD

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)
     ||
Retrieved from "http://www.psdevwiki.com/ps3/index.php?title=Talk:Environments&oldid=29202"