Vend 0.3.3

interchange · Jan 2, 2009 · 38df6af · 38df6af
1 parent 59f4c86
commit 38df6af
Show file tree

Hide file tree

Showing 9 changed files with 1,106 additions and 37 deletions.
diff --git a/ChangeLog b/ChangeLog
diff --git a/Vend/Catalog.pm b/Vend/Catalog.pm
@@ -1,6 +1,6 @@
 # Catalog.pm: on-line ordering abstract class
 #
-# $Id: Catalog.pm,v 1.17 1995/12/04 20:23:38 amw Exp $
+# $Id: Catalog.pm,v 1.18 1995/12/15 20:06:14 amw Exp $
 #
 package Vend::Catalog;
 
@@ -38,21 +38,44 @@ sub order_values;               # ($input, $quantities, $submitted)
 sub validate_fields;            # ()
 sub process_order;              # ($items)
 
+
+# what should a placeholder return if the record isn't found?
+
+sub na {
+    return "NA";
+}
+
+
+# return the product code of an item code
+
+sub product_code {
+    return $_[1];
+}
+
+
+sub create_table_placeholder {
+    my ($class, $table, $field_name) = @_;
+    my $field_accessor = $table->field_accessor($field_name);
+
+    return sub {
+        my ($code) = @_;
+        my $product_code = $class->product_code($code);
+        return $class->na() unless defined $product_code;
+        return &$field_accessor($product_code)
+            if $table->record_exists($product_code);
+        return $class->na();
+    };
+}
+
 sub create_table_placeholders {
     my ($class, $name, $table) = @_;
 
     my $column;
     foreach $column ($table->columns()) {
-        my $ph = "$name-$column";
-        define_placeholder "[$ph \$key]", $table->field_accessor($column);
+        my $ph = "[$name-$column \$key]";
+        my $sub = $class->create_table_placeholder($table, $column);
+        define_placeholder $ph, $sub;
     }
-
-    # my $exists = sub {
-    #     my ($key) = @_;
-    #     return $table->record_exists($key);
-    # };
-    #
-    # define_placeholder("[$name-exists \$key]", $exists);
 }
 
 
@@ -95,19 +118,19 @@ sub shopping_list_link {
 
 ## ORDER AN ITEM
 
-# Returns an url to place an order for the product PRODUCT_CODE.
+# Returns an url to place an order for the product ITEMCODE.
 
 sub order_url {
-    my ($class, $product) = @_;
-    vend_url('order', {order => $product});
+    my ($class, $itemcode) = @_;
+    vend_url('order', {order => $itemcode});
 }
 
 
 # Order an item with product code CODE.
 
 sub action_order {
     my ($class, $action_name, $path, $args) = @_;
-    my ($i, $found, $item);
+    my ($found, $item);
 
     my $item_code = $args->{order};
 
@@ -123,10 +146,11 @@ sub action_order {
     }
 
     # Item already on order form?
-    undef $i;
-    foreach $item (@{Item()}) {
-	$i = $item, last if ($item->{code} eq $item_code);
-    }
+    my $i = $class->lookup_item($item_code);
+    # undef $i;
+    # foreach $item (@{Item()}) {
+    #     $i = $item, last if ($item->{code} eq $item_code);
+    # }
 
     if (defined $i) {
         $i->{quantity} = 1 if $i->{quantity} < 1;

diff --git a/Vend/Page.pm b/Vend/Page.pm
@@ -1,6 +1,6 @@
 # Page.pm:  compiles and processes pages and placeholders
 #
-# $Id: Page.pm,v 1.11 1995/11/28 18:34:24 amw Exp $
+# $Id: Page.pm,v 1.12 1995/12/15 20:03:43 amw Exp $
 #
 package Vend::Page;
 
@@ -24,10 +24,12 @@ require Exporter;
 @ISA = qw(Exporter);
 @EXPORT = qw(page_code test_pages read_phds
              placeholder
+             call_template
              define_placeholder
              canonical_ph_name
              compile_page
              load_ph_definition_files
+             read_templates
              compile_action);
 
 use strict;
@@ -282,6 +284,24 @@ sub read_phds {
     load_ph_definition_files($files);
 }
 
+##
+
+sub read_templates {
+    my (@dirs) = @_;
+    my ($dir, $file);
+
+    foreach $dir (@dirs) {
+        opendir(DIR, $dir) or die "Couldn't read directory '$dir': $!\n";
+        while ($file = readdir(DIR)) {
+            next if $file eq '.' or $file eq '..';
+            next unless $file =~ m!\.tpl$!;
+            parse_template_file("$dir/$file");
+        }
+        closedir(DIR);
+    }
+}
+
+
 ##
 
 my %Placeholder_list = ();
@@ -315,14 +335,6 @@ sub compile_page {
 # name  canonical_name
 # text_variable  'text'
 
-# sub new {
-#    my ($class) = @_;
-#    my $self = {};
-#    bless $self, $class;
-#    $self;
-# }
-
-
 # Called by modules to define Perl code placeholders
 
 sub define_placeholder {
@@ -468,6 +480,55 @@ sub define_text_placeholder {
 }
 
 
+##
+
+my $Templates = {};
+
+sub parse_template_file {
+    my ($fn) = @_;
+    local ($_, $.);
+
+    open(IN, $fn) or croak "Couldn't open '$fn': $!\n";
+    while (<IN>) {
+        chomp;
+        s/#.*//;
+        next if m/^\s*$/;
+        last;
+    }
+    m/^\s*template\s*/ or croak "'$fn' should start with a template statement\n";
+    my ($name, $vars) = m/^\s*template\s+(\w+)(.*)/
+        or croak "Syntax error on line $. of '$fn':\n$_\n";
+    $vars =~ s/^\s+//;
+    my @vars = split(/\s+/, $vars);
+    my $var;
+    foreach $var (@vars) {
+        croak "Syntax error in template variable name:\n$_\n"
+            unless $var =~ m/^\$\w+$/;
+        $var =~ s/^\$//;
+    }
+
+    my $source;
+    do {
+        $source = <IN>;
+    } while ($source =~ m/^\s*$/);
+
+    while (<IN>) {
+        $source .= $_;
+    }
+
+    my $subname = "Template::" . escape_to_varname($name);
+    compile_text(\$source, [@vars], undef, $fn, 0, $subname);
+    no strict 'refs';
+    $Templates->{$name} = \&$subname;
+}
+
+sub call_template {
+    my ($template_name, @args) = @_;
+    my $sub = $Templates->{$template_name};
+    croak "There is no template named '$template_name'" unless defined $sub;
+    return &$sub(@args);
+}
+
 ##
 
 sub canonical_ph_name {

diff --git a/Vend/Server.pm b/Vend/Server.pm
@@ -1,6 +1,6 @@
 # Server.pm:  listen for cgi requests as a background server
 #
-# $Id: Server.pm,v 1.12 1995/11/10 15:23:09 amw Exp $
+# $Id: Server.pm,v 1.13 1995/12/15 20:11:53 amw Exp $
 
 # Copyright 1995 by Andrew M. Wilcox <awilcox@world.std.com>
 #
@@ -86,7 +86,7 @@ sub _find {
 sub _string {
     my ($in) = @_;
     my $len = _find($in, " ");
-    _read($in) while (length($$in) < $len);
+    _read($in) while (length($$in) < $len + 1);
     my $str = substr($$in, 0, $len);
     substr($$in, 0, $len + 1) = '';
     $str;