#!/usr/bin/perl -wT
######################################################################
# cart.pl
######################################################################
# Perl Power! - Michael Schilli 1998
######################################################################

use CGI qw/:standard :html3/;       # CGI standard with tables
use Fcntl qw/:flock/;               # LOCK_EX
use IO::File;                       # new file handle generation
use strict;                         # strict conventions

my $TRANSDIR      = "transactions"; # directory for Temp files
my $ORDERFILE     = "/usr/data/orders.dat";  # file for orders
my $items_total   = 100;            # total number of items
my $items_perpage = 10;             # displayed per page
my %merchandise   = ();             # merchandise
my ($q, $i, $id);                   # variables

for($i=1; $i<=$items_total; $i++) {
    $merchandise{$i} = "Book $i";   # create test items
}

eval {                              # intercept errors

    if(!defined(my $id=cookie(-name => 'ID'))) {

        # create new cookie from time, process no. and random no.
        $id = unpack ('H*', 
                      pack('Ncs', time, $$ & 0xff, rand(0xffff)));

        print header('-cookie' => cookie('ID' => $id));
        print_address_form();       # send cookie/address form

    } else {                        # cookie already exists
        print header();
        print start_html('-title'  => 'The Online Shopper',
                          -bgcolor => "white"); 

        ($id) = ($id =~ /([0-9a-f]+)/);      # percolate ID

        if(-f "$TRANSDIR/$id") { 
            $q = restore_cgi($id);  # read old transaction data
            shop($q, $id);          # call shopper
        } else {                    # no transaction file? create
            $q = CGI->new();        # current CGI data
                                    # address information complete?
            if(grep { !$q->param($_) } qw/name first_name street 
                                          city zip/) {
                print_address_form("Please fill in all fields!");
            } else {
                save_cgi($q, $id);  # create new transaction file
                shop($q, $id);
            }
        }
    }
};                                  # eval end;

if($@) {                            # error occurred?
    print h1("Error: $@");
}

######################################################################
sub shop { my ($q, $id) = @_;
######################################################################
    my $item;
                                    # offset of visible section
    my $offset = ($q->param('offset') || 0);

        # store items selected up to now in @selected, but deselect
        # items shown in current window (will be inserted later)
    my @selected = grep {
                       $_ <= $offset || $_ > $offset+$items_perpage } 
                   ($q->param('items'));

        # newly selected items to @selected
    foreach $item (param('newitems')) { push(@selected, $item); }

    $q->delete('items');            # store @selected in CGI
    $q->param('items', @selected);  # parameter 'items'
    save_cgi($q, $id);

        # 'Order' button pressed? Write incoice!
    if(param('Order')) {
        process_order($q, \%merchandise);
        $q->delete('items');        # order terminated,
        save_cgi($q, $id);          # reset shoppiong cart
    
    } else {                        # show item list
    
        if($offset >= $items_perpage) {
            $offset -= $items_perpage if param("Back");
        }
        if($offset < $items_total - $items_perpage) {
            $offset += $items_perpage if param("Forward");
        }

        $q->param('offset', $offset);
        save_cgi($q, $id);

        my @subset = sort {$a <=> $b} keys %merchandise;
        @subset = splice(@subset, $offset, $items_perpage);
    
                                   # new item list
        print b("Our red hot offers, specially for ", 
                $q->param('first_name'), " ", $q->param('name'), ":"),
              start_form(), 
              $q->checkbox_group(
                  '-name'      => 'newitems',
                  '-values'    => [@subset],
                  '-default'   => [$q->param('items')],
                  '-linebreak' => 'true',
                  '-labels'    => \%merchandise),
              submit('Back'), submit('Forward'), 
              submit('Order'), 
              end_form, end_html;
    }
}

######################################################################
sub save_cgi {
######################################################################
    my ($query, $id) = @_;

    my $out = IO::File->new(">$TRANSDIR/$id");  # write access
    die "Can't open $TRANSDIR/$id" unless defined $out;
    $query->save($out);
    close($out);
}

######################################################################
sub restore_cgi {
######################################################################
    my $id = shift;

    $id =~ s/[^0-9a-f]//g;       # protect against attacks

    my $in = IO::File->new("<$TRANSDIR/$id");  # read access
    die "Can't open $TRANSDIR/$id" unless defined $in;
    my $q = new CGI($in);
    close($in);
    return $q;
}

######################################################################
sub print_address_form {
######################################################################
    my $msg = (shift || "");
    print start_html('-title' => 'The Online Shopper',
                     -bgcolor => 'white'), 
          tt(CGI::font({color => 'red'}, $msg)),
          start_form(), 
          table(
            TR(td("Name:"), td(textfield('name'))),
            TR(td("First name:"), td(textfield('first_name'))),
            TR(td("Street:"), td(textfield('street'))),
            TR(td("City:"), td(textfield('city'))),
            TR(td("ZIP:"), td(textfield('zip')))),
          submit(-name => "Here we go!"), end_form(), end_html();
}

######################################################################
sub process_order {
######################################################################
    my ($q, $merchandiseref) = @_;
    my $item;

    my $order = sprintf "%s %s\n%s\n%s\n%s\n\n", 
                        $q->param('first_name'), $q->param('name'),
                        $q->param('street'),
                        $q->param('city'), $q->param('zip');
   
    foreach $item ($q->param('items')) {
        $order .= sprintf "1 pcs '%s'\n", $merchandiseref->{$item};
    }

    $order .= "\nMany thanks!";

    my $out = IO::File->new(">>$ORDERFILE");
    die "Cannot open $ORDERFILE" unless defined $out;
    flock($out, LOCK_EX);                    # set lock
    print $out $order, "\n", "-" x 70, "\n";
    close($out);
  
    print pre($order), 
          b("Your order is on its way!"), end_html();
}