To think, I quit that job a month ago.
If I never build another online shopping cart,
one that takes 2 months of my life to complete,
so some fat, lazy, antisocial bastard can buy a book,
without leaving his house,
or interacting with a live human being,
I will be O.K.
#!/usr/bin/perl -w package PRODUCT; require Exporter; use lib '.'; use CONFIG; use ANYDB_HELP; use FREQUENT; use CGI qw(:standard :html3); @ISA = qw(Exporter); @EXPORT = qw( make_add_form write_group_nav write_company_nav write_groups_nav write_companies_nav write_product_index ); use strict; use Carp; my %fields = ( key => 'text', id => 'text', name => 'text', group => 'text', company => 'text', price => 'text', description => 'textarea', image_name => 'image', size => 'text', color => 'text', linkto => 'text', visibility => 'text', ); my @array_fields = qw( key id name group company price description image_name size color linkto visibility ); my $delimiter = ":"; ### Creates a new PRODUCT object and initializes the member fields. sub new { my $class = shift; my ($key, $id, $name, $group, $company, $price, $description, $image_name, $size, $color, $linkto, $visibility) = @_; my $self = {}; bless $self => $class; ### If we only have one argument, assume we have a string ### containing all the field values in $id and unpack it if ( @_ == 1 ) { $self->unpack( $key ); } else { $self->{key} = $key; $self->{id} = $id; $self->{name} = $name;$self->{group} = $group; $self->{company} = $company; $self->{price} = $price; $self->{description} = $description; $self->{image_name} = $image_name; $self->{size} = $size; $self->{color} = $color; $self->{linkto} = $linkto; $self->{visibility} = $visibility;} return $self; } ### Packs the current field values into a colon delimited record ### and returns it sub pack { my ( $self ) = @_; my $record = join($delimiter, $self->{key}, $self->{id},$self->{name}, $self->{group}, $self->{company}, $self->{price}, $self->{description}, $self->{image_name}, $self->{size}, $self->{color}, $self->{linkto}, $self->{visibility}); ### Simple check that fields don't contain any colons #croak "Record field contains ':' delimiter character" # if $record =~ tr/:/:/ != 4; return $record; } ### Unpacks the given string into the member fields sub unpack { my ( $self, $packedString ) = @_; ### Naive split...Assumes no inter-field delimiters my ($key, $id, $name, $group, $company, $price, $description, $image_name, $size, $color, $linkto, $visibility) = split($delimiter, $packedString); $self->{key} = $key; $self->{id} = $id; $self->{name} = $name; $self->{group} = $group; $self->{company} = $company; $self->{price} = $price;$self->{description} = $description; $self->{image_name} = $image_name; $self->{size} = $size; $self->{color} = $color; $self->{linkto} = $linkto; $self->{visibility} = $visibility; } ### Displays the PRODUCT data sub dump_product { my ( $self ) = @_; print "id: $self->{key}\n"; print "id: $self->{id}\n"; print "name: $self->{name} \n"; print "group: $self->{group}\n"; print "company: $self->{company}\n"; print "price: $self->{price}\n"; print "Description: $self->{description}\n"; print "Image Name: $self->{image_name}\n"; print "Size: $self->{size}\n"; print "Color: $self->{color}\n"; print "Linkto: $self->{linkto}\n\n"; print "Visibilty: $self->{visibility}\n\n"; } sub dump_html { my ( $self ) = @_; print "<table><tr><td>label</td><td>value</td></tr>\n"; print "<tr><td>key</td><td> $self->{key}</td></tr>\n"; print "<tr><td>id</td><td> $self->{id}</td></tr>\n"; print "<tr><td>name</td><td> $self->{name}</td></tr> \n"; print "<tr><td>group</td><td> $self->{group}</td></tr>\n"; print "<tr><td>company</td><td> $self->{company}</td></tr>\n"; print "<tr><td>price</td><td> $self->{price}</td></tr>\n"; print "<tr><td>Description</td><td> $self->{description}</td></tr>\n"; print "<tr><td>Image name</td><td> $self->{image_name}</td></tr>\n"; print "<tr><td>Size</td><td> $self->{size}</td></tr>\n"; print "<tr><td>Color</td><td> $self->{color}</td></tr>\n"; print "<tr><td>Linkto</td><td> $self->{linkto}</td></tr>\n"; print "<tr><td>Visibilty</td><td> $self->{visibilty}</td></tr>\n"; print "</table>"; } sub print_admin_index{ my ( $self ) = @_; print <<EOF <tr> <td bgcolor=FFFFFF> <form action=edit.cgi> <input type=hidden name=key value=$self->{key}> <input type=submit value=EDIT> </form> </td> <td bgcolor=FFFFFF>$self->{id}</td> <td bgcolor=FFFFFF>$self->{name}</td> <td bgcolor=FFFFFF>$self->{group}</td> <td bgcolor=FFFFFF>$self->{company}</td> <td bgcolor=FFFFFF>$self->{price}</td> <td bgcolor=FFFFFF>$self->{description}</td> <td bgcolor=FFFFFF>$self->{image_name}</td> <td bgcolor=FFFFFF>$self->{size}</td> <td bgcolor=FFFFFF>$self->{color}</td> <td bgcolor=FFFFFF>$self->{linkto}</td> <td bgcolor=FFFFFF>$self->{visibility}</td> <td bgcolor=FFFFFF> <form action=delete.cgi> <input type=hidden name=key value=$self->{key}> <input type=submit value=DELETE> </form> </td> </tr> EOF ; } sub print_trunc_admin_index{ my ( $self ) = @_; my $description = $self->{description}; my $description_snippet = substr($description, 0, 50); print <<EOF <tr> <td bgcolor=FFFFFF> <form action=edit.cgi> <input type=hidden name=key value=$self->{key}> <input type=submit value=EDIT> </form> </td> <td bgcolor=FFFFFF>$self->{id}</td> <td bgcolor=FFFFFF><a href="$prod_url/$self->{key}.shtml" target=out>$self->{name}</a></td> <!-- <td bgcolor=FFFFFF>$self->{group}</td> <td bgcolor=FFFFFF>$self->{company}</td> --> <td bgcolor=FFFFFF>$self->{price}</td> <td bgcolor=FFFFFF>$description_snippet ...</td> <!-- <td bgcolor=FFFFFF>$self->{image_name}</td> <td bgcolor=FFFFFF>$self->{size}</td> <td bgcolor=FFFFFF>$self->{color}</td> <td bgcolor=FFFFFF>$self->{linkto}</td> --> <td bgcolor=FFFFFF>$self->{visibility}</td> <td bgcolor=FFFFFF> <form action=delete.cgi> <input type=hidden name=key value=$self->{key}> <input type=submit value=DELETE> </form> </td> </tr> EOF ; } sub write_product_index { # yeah yeah, screwing the 00 shit, i'm in a rush, and this works really well my $key; my $value; my $db = "products"; my %DATABASE = open_data($db); my $this_company; my @this_product_list; my @product_pulldown; my $blank_template = get_template($blank_template_path); $blank_template =~ s/\[company\]//g; my $keywords = 'ski clothing snowboard kombi jackets long underwear obermeyer waterproof snow pants clothes suits winter coats sorel boots jacket goggles down helmets kids apparel hats toddler coat snowboarding buy red feather wear suit boot bibs hat sledding parkas crazy companies specialty childrens stores outerwear online north face skiing helly hansen spyder mental snowshoes fleece sleds briko'; my $description = 'Winter, ski and snow apparel and gear for kids and teens. Northface, Spyder, Obermeyer, Helly Hanson, Columbia, Brinko Helmets, Boeri sleds, Smith goggles, Kombi gloves, Turtle fur, Wigwam socks, Mental hats, Sorel boots, Redfeather'; $blank_template =~ s/\[keywords\]/$keywords/g; $blank_template =~ s/\[description\]/$description/g; $blank_template =~ s/\[title\]/Winter jackets, clothing, boots, helmets, goggles. Best gear, best prices./g; $blank_template = <<EOF <base href="$base_url/"> $blank_template EOF ; my ($header, $footer) = split('\[content\]', $blank_template); =pod open(INDEX,">$base_path/index.shtml") or die "$!"; print INDEX $header; print INDEX <<EOF <p>Welcome back to another year of winter fun! You might remember us from last year. Well, we've grown and gotten a new look all to better serve you! Worley's WinterKids catalog offers only the finest in winter apparel and accesories for kids and Teens! We have studied closely the "in" colors and styles for the 2002 to keep your family looking great this winter! Thank you for your continued support throughout the years! We look forward to hearing from you.</p> EOF ; print INDEX '<p><b><i>Same Day Shipping Available!</i></b></p>'; print INDEX '<p><b>Featured Products:</b></p>'; print INDEX "<!--\#exec cgi =\"cgi-local/cart/random_product.cgi\" -->"; print INDEX "<!--\#exec cgi =\"cgi-local/cart/random_product.cgi\" -->"; print INDEX "<!--\#exec cgi =\"cgi-local/cart/random_product.cgi\" -->"; #hidden, shhhh print INDEX '<a href="dh-winter_apparel.htm"><img border="0" src="reports/hiddenimage.gif" width="25" height="25"></a>'; print INDEX $footer; close(INDEX); =cut =pod # $header =~ s/\[keywords\]/boom/g; $header = "$header <div align=center>"; #this'll have all product entries # zooom. my @entire_page; my @companies_in_order = qw( Spyder Obermeyer North_Face Helly_Hanson Columbia Briko_Helmets Boeri_Sleds Smith_Goggles Kombi_Gloves Turtle_Fur Wigwam_Socks Mental_Hats Sorel_Boots Redfeather ); foreach $this_company( @companies_in_order ) { my $pretty_company = $this_company; $pretty_company =~ s/_/ /g; #my $company_table = "<h2>$pretty_company</h2>\n"; my $company_table = <<EOF <!-- <p><img src=$logo_url/$this_company.gif></p> --> <p><b>$pretty_company</b></p> <table border="0" cellpadding="1" cellspacing="0" bgcolor="#000000" width=400> <tr> <td bgcolor=#000000> <table border="0" cellspacing="1" cellpadding=3 width=398 bgcolor=#FFFFFF> <tr> <td><p><b>Name</b></p></td> <td><p><b>Description</b></p></td> <td><p><b>Price</b></p></td> EOF ; my $template = $blank_template; #dynamically make some keywords $template =~ s/\[keywords\]/$Meta_Tags->{$this_company}->{-Keywords}/g; $template =~ s/\[description\]/$Meta_Tags->{$this_company}->{-Description}/g; $template =~ s/\[title\]/$Meta_Tags->{$this_company}->{-Title}/g; my $pretty_company = pretty($this_company); my @keys = sort { $a <=> $b } (keys %DATABASE); foreach $key (@keys) {############################ $value = $DATABASE{$key}; my ($key, $id, $name, $group, $company, $price, $description, $image_name, $size, $color, $linkto, $visibility) = split(':', $value); unless($visibility eq "no") { ################################## if ($company eq $this_company) { ############################### my $description_snippet = substr($description, 0, 75); my $product_row = <<EOF <tr> <td> <p><a href=$prod_url/$key.shtml>$name</a></p> </td> <td> <p>$description_snippet ... <a href=$prod_url/$key.shtml>(more)</a> </td> <td> <p>$price</p> </td> </tr> EOF ; #push(@this_product_list, $product_row); #push(@product_pulldown, "<option value=$key.shtml>$name</option>"); $company_table .= "\n$product_row\n"; }#### }### # } ### # no more $company_table .= "</table></td></tr></table>"; # no more push(@entire_page, $company_table); $company_table = ""; } $footer =~ s/<\/body>/$secret_image<\/body>/; open(INDEX,">$base_path/index.shtml") or die "$!"; print INDEX "$header\n"; foreach(@entire_page){ ################# print INDEX "$_\n"; }### print INDEX "</div>\n\n$footer"; close(INDEX); =cut } sub write_group_nav { @groups = sort(@groups); open(SSI, ">$include_path/group_nav.shtml"); print SSI "<hr><p><b>Groups:</b><br>"; foreach(@groups){ print SSI "<a href=$_.shtml>$_</a><br>"; } print SSI "</p><hr>"; close(SSI); } sub write_company_nav { @companies = sort(@companies); open(SSI, ">$include_path/company_nav.shtml"); print SSI "<hr><p><b>Companies:</b><br>"; foreach(@companies){ print SSI "<a href=$_.shtml>$_</a><br>"; } print SSI "</p><hr>"; close(SSI); } sub write_static_pages { my ( $self ) = @_; #only write the pages out if we're supposed to if ($self->{visibility} eq "yes"){ my $key = $self->{key}; ############################################################ # make the "add theis product to yoru cart" code my $color_list = $self->{color}; my @colors = split(',',$color_list); my $size_list = $self->{size}; my @sizes = split(',', $size_list); my @amount = (1..100); my $i; my $add_form_code = <<EOF <center> <form action="$cart_cgi_url/add_product.cgi" method=POST> <input type=hidden name=key value=[key]> <table style="border: 1px solid #CCCCCC" cellpadding=5> <tr> <td><p><b>Purchase</b> $self->{name} <br> <b>Price:</b> \$$self->{price}</p> </td> </tr> <tr> <td><p>Available Sizes:</p></td></tr> <tr> <td><p> EOF ; $add_form_code .= "<select name=size>"; for($i=0;$i<=$#sizes;$i++){$add_form_code.= "<option value=$i>$sizes[$i]</option>\n"; } $add_form_code .= "</select>"; $i=0; $add_form_code .= "</p></td></tr><tr><td><p>Available Colors</p></td></tr><tr><td><p>"; $add_form_code .= "<select name=color>"; for($i=0;$i<=$#colors;$i++){$add_form_code .= "<option value=$i>$colors[$i]</option>\n"; } $add_form_code .= "</select>"; $i=0; $add_form_code .= "</p></td></tr><tr><td><p>Amount:</p></td></tr><tr><td><p>"; $add_form_code .= popup_menu('quantity', [@amount]); $add_form_code .= "</p></td></tr><tr><td><input type=submit value=\" Add to Shopping Cart \" style='font-size: 15px; font-family:arial,verdana, sans-serif; background-color: #99CC99; color: #000000; font-weight:bold'></td></tr></table></form> "; ####################################################### #get a fresh template copy my $template = get_template($template_path); # pretty the company name up my $company = $self->{company}; my $pretty_company = pretty($company); #make a bread crumb trail on the top my $bread_crumb = "<font face=arial size=2><a href=$base_url>$website_name</a> :: <a href=$prod_url/$company.shtml>$pretty_company</a> :: $self->{name}</font>"; $template =~ s/\[bread_crumbs\]/$bread_crumb/g; #put a <base href> tag at the top of the template so this template is abit more flexibel $template = <<EOF <base href="$base_url/"> $template EOF ; my $this_group = $self->{group}; my $pretty_group = pretty($this_group); #meta keywords my $keywords = "$self->{name}, $pretty_group, $pretty_company, Winter Clothes for Teens and Kids, warm clothes, ski clothes, snowboard clothes"; #dynamically make some keywords $template =~ s/\[keywords\]/$Meta_Tags->{$company}->{-Keywords}/g; $template =~ s/\[description\]/$Meta_Tags->{$company}->{-Description}/g; $template =~ s/\[title\]/$self->{name} by $pretty_company/g; #put the group menu on my $group_ssi_code ="<!--\#include virtual =\"includes/${this_group}_pd.shtml\" -->"; $template =~ s/\[group_menu\]/$group_ssi_code/g; #put the company menu on my $this_company = $self->{company}; my $company_ssi_code ="<!--\#include virtual =\"includes/${this_company}_pd.shtml\" -->"; $template =~ s/\[company_menu\]/$company_ssi_code/g; $template =~ s/\[add_form\]/$add_form_code/g; #add the quick cart summary code my $quick_cart_summary = "<!--\#exec cgi =\"cgi-local/cart/quick_cart_summary.cgi\" -->"; $template =~ s/\[quick_cart_summary\]/$quick_cart_summary/g; #and the rest my $img = $self->{image_name}; my $image_code = "<img src=$img_url/$img>"; $template =~ s/\[image_name\]/$image_code/g; $template =~ s/\[group\]/$pretty_group/g; $template =~ s/\[company\]/$pretty_company/g; $template =~ s/\[name\]/$self->{name}/g; $template =~ s/\[price\]/$self->{price}/g; $template =~ s/\[product_description\]/$self->{description}/g; $template =~ s/\[key\]/$self->{key}/g; $template =~ s/\[visibility\]/$self->{visibility}/g; $template =~ s/\[size\]/$self->{size}/g; $template =~ s/\[color\]/$self->{color}/g; $template =~ s/\[id\]/$self->{id}/g; $template =~ s/\[key\]/$self->{key}/g; #open the file and prrrrrint open(FILE, ">$prod_path/$key.shtml") or die "wtf? : $!"; print FILE $template; close(FILE); } } sub write_groups_nav { # yeah yeah, screwing the 00 shit, i'm in a rush, and this works really well my $key; my $value; my $db = "products"; my %DATABASE = open_data($db); my $this_group; foreach $this_group(@groups) { my @this_product_list = (); my @product_pd = (); my $pretty_group = pretty($this_group); my @keys = sort { $a <=> $b } (keys %DATABASE); foreach $key (@keys) {############################ $value = $DATABASE{$key}; # # do something with $key, $value #my ($section, $subsection, $the_quote, $author, $contrib_name, $contrib_address, $status) = # #split(/$delimiter/, $value); my ($key, $id, $name, $group, $company, $price, $description, $image_name, $size, $color, $linkto, $visibility) = split(':', $value); unless($visibility eq "no") { ################################## if ($group eq $this_group) { ############################### push(@this_product_list, "<!-- number $key -->\n<a href=$prod_url/$key.shtml>$name</a><br>"); push(@product_pd, "<option value=$key.shtml>$name</option>"); }#### }### # # } ### open(GROUP,">$prod_path/$this_group.shtml"); foreach(@this_product_list){ ################# print GROUP "$_\n"; }### close(GROUP); open(GROUP_PD,">$include_path/${this_group}_pd.shtml"); print GROUP_PD <<EOF <form name=group_form> <p><font face=arial>Also in $pretty_group<br> <select name=page> EOF ; foreach(@product_pd){ ################# print GROUP_PD "$_\n"; }### print GROUP_PD "</select><input type=button value=go onclick=go_group();></font></p></form>"; close(GROUP_PD); @this_product_list = (); @product_pd = (); } } sub write_companies_nav { # yeah yeah, screwing the 00 shit, i'm in a rush, and this works really well my $key; my $value; my $db = "products"; my %DATABASE = open_data($db); my $this_company; my @this_product_list; my @product_pulldown; my $blank_template = get_template($blank_template_path); $blank_template = <<EOF <base href="$base_url/"> $blank_template <center> EOF ; foreach $this_company(@companies) { my $template = $blank_template; my $pretty_company = pretty($this_company); my @keys = sort { $a <=> $b } (keys %DATABASE); my $prod_table = '<table cellpadding=5>'; $value = $DATABASE{$key}; my ($key, $id, $name, $group, $company, $price, $description, $image_name, $size, $color, $linkto, $visibility) = split(':', $value); unless($visibility eq "no") { if ($company eq $this_company) { # my $pretty_company = pretty($company); $template =~ s/\[company\]/$pretty_company/g; } } } =pod foreach $this_company(@companies) { my $template = $blank_template; foreach $key (@keys) {############################ # # do something with $key, $value #my ($section, $subsection, $the_quote, $author, $contrib_name, $contrib_address, $status) = # #split(/$delimiter/, $value); my ($key, $id, $name, $group, $company, $price, $description, $image_name, $size, $color, $linkto, $visibility) = split(':', $value); unless($visibility eq "no") { ################################## if ($company eq $this_company) { ############################### my $pretty_company = pretty($company); $template =~ s/\[company\]/$pretty_company/g; my $description_snippet = substr($description, 0, 50); my $product_row = <<EOF <tr> <td> <p><a href=$prod_url/$key.shtml>$name</a></p> </td> <td> <p>$description_snippet ... <a href=$prod_url/$key.shtml>(more)</a> </td> <td> <p>$price</p> </td> </tr> EOF ; push(@this_product_list, $product_row); push(@product_pulldown, "<option value=$key.shtml>$name</option>"); }#### }### # # } ### open(COMPANY,">$prod_path/$this_company.shtml"); my ($header, $footer) = split('\[content\]', $template); $header =~ s/\[keywords\]/$Meta_Tags->{$this_company}->{-Keywords}/g; $header =~ s/\[description\]/$Meta_Tags->{$this_company}->{-Description}/g; $header =~ s/\[title\]/$Meta_Tags->{$this_company}->{-Title}/g; print COMPANY $header; print COMPANY "<p><font face=arial size=2><a href=$base_url>$website_name</a> :: $pretty_company</p>"; print COMPANY <<EOF <p><center><img src=$logo_url/$this_company.gif></center></p> <center> <table border="0" cellpadding="1" cellspacing="0" bgcolor="#000000" width=400> <tr> <td bgcolor=#000000> <table border="0" cellspacing="1" cellpadding=3 width=398 bgcolor=#FFFFFF> <tr> <td><p><b>Name</b></p></td> <td><p><b>Description</b></p></td> <td><p><b>Price</b></p></td> EOF ; foreach(@this_product_list){ ################# print COMPANY "$_\n"; }### print COMPANY "</table></td></tr></table></center>"; print COMPANY '<hr width=66% size=1 color=black>'; print COMPANY "<p><b>Featured Product by $pretty_company</b></p>"; print COMPANY "<!--\#include virtual =\"cgi-local/cart/random_product.cgi?company=$this_company\" -->"; print COMPANY "</center>\n$footer"; close(COMPANY); open(COMPANY_PD,">$include_path/${this_company}_pd.shtml"); print COMPANY_PD <<EOF <form name=company_form> <p><font face=arial>Also from $pretty_company<br> <select name=page> EOF ; foreach(@product_pulldown){ ################# print COMPANY_PD "$_\n"; }### print COMPANY_PD "</select><input type=button value=go onclick=go_company();></font></p></form>"; close(COMPANY_PD); @this_product_list = (); @product_pulldown = (); } =cut } sub make_add_form { print "<p><b>Add a product to the database</b></p>\n"; print "<form>\n"; foreach(@array_fields) { my $field = $fields{$_}; print "<p>$_<br>\n"; print "<input type=\"text\" name=\"$_\">" if ($field eq "text"); print "<textarea name=\"$_\" cols=40 rows=5></textarea>\n"if ($field eq "textarea"); } print "<p><input type=submit value=\"Add Product\">\n"; print "</form>\n"; } 1;
|
