MiniVend 1.03

interchange · Jan 2, 2009 · 9cc3044 · 9cc3044
1 parent e7bb55e
commit 9cc3044
Show file tree

Hide file tree

Showing 142 changed files with 14,706 additions and 5,663 deletions.
diff --git a/Changes b/Changes
@@ -1,3 +1,31 @@
+MiniVend 1.03 - Multiple servers and disconnected searching
+* Multiple servers can be run for the same catalog
+* Searches are forked so single-server installations will
+  not see delays while searching
+* Cookie support
+* Quantity price breaks
+* Revamped demo yet again
+* Order lists can be displayed anywhere
+* Nameable order and search pages
+* Accessories feature
+* Added TaxShipping, NonTaxableField, PriceField, DescriptionField,
+  AlwaysSecure, ExtraSecure, HammerLock, MultiServer, PageCheck,
+  PriceBreaks, MixMatch, Cookies, Specialpage, Database directives
+* Searches are now independent on database field
+* Fixed bugs in match paging
+* Arbitrary table-like text formatting with [row] [column] elements
+* Vend variables available with [if][else][/else][/if]
+* Configuration script now handles multiple installs, and
+  GCC is recognized
+* Code somewhat modularized
+* Pages are checked for fatal errors before server starts???
+* Static mode will be almost unusable unless the Apache
+  Perl_fast mode is used (not supported or explained)
+* MAT now displays error logs???
+* Unlimited databases
+* Special pages are mapped
+* [data database field key] tag added
+
 MiniVend 1.02 - SSL Security
 * Revamped demo to have fewer frames
 * Added CreditCards, EncryptProgram, FrameOrderPage, SecureOrderMsg,

diff --git a/File/CounterFile.pm b/File/CounterFile.pm
@@ -0,0 +1,323 @@
+# This -*-perl -*- module implements a persistent counter class.
+#
+# $Id: CounterFile.pm,v 0.7 1996/02/26 18:58:50 aas Exp $
+#
+
+package File::CounterFile;
+
+
+=head1 NAME
+
+File::CounterFile - Persistent counter class
+
+=head1 SYNOPSIS
+
+ use File::CounterFile;
+ $c = new File::CounterFile "COUNTER", "aa00";
+
+ $id = $c->inc;
+ open(F, ">F$id");
+
+=head1 DESCRIPTION
+
+This module implements a persistent counter class.  Each counter is
+represented by a separate file in the file system.  File locking is
+applied, so multiple processes might try to access the same counters
+at the same time without risk of counter destruction.
+
+You give the file name as the first parameter to the object
+constructor (C<new>).  The file is created if it does not exist.
+
+If the file name does not start with "/" or ".", then it is
+interpreted as a file relative to C<$File::CounterFile::DEFAULT_DIR>.
+The default value for this variable is initialized from the
+environment variable C<TMPDIR>, or F</usr/tmp> is no environment
+variable is defined.  You may want to assign a different value to this
+variable before creating counters.
+
+If you pass a second parameter to the constructor, that sets the
+initial value for a new counter.  This parameter only takes effect
+when the file is created (i.e. it does not exist before the call).
+
+When you call the C<inc()> method, you increment the counter value by
+one. When you call C<dec()> the counter value is decrementd.  In both
+cases the new value is returned.  The C<dec()> method only works for
+numerical counters (digits only).
+
+You can peek at the value of the counter (without incrementing it) by
+using the C<value()> method.
+
+The counter can be locked and unlocked with the C<lock()> and
+C<unlock()> methods.  Incrementing and value retrieval is faster when
+the counter is locked, because we do not have to update the counter
+file all the time.  You can query whether the counter is locked with
+the C<locked()> method.
+
+There is also an operator overloading interface to the
+File::CounterFile object.  This means that you might use the C<++>
+operator for incrementing the counter, C<--> operator for decrementing
+and you can interpolate counters diretly into strings.
+
+=head1 BUGS
+
+It uses flock(2) to lock the counter file.  This does not work on all
+systems.  Perhaps we should use the File::Lock module?
+
+=head1 INSTALLATION
+
+Copy this file to the F<File> subdirectory of your Perl 5 library
+directory (often F</usr/local/lib/perl5>).
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-1996 Gisle Aas. All rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Gisle Aas <aas@sn.no>
+
+=cut
+
+require 5.002;
+use Carp   qw(croak);
+use Symbol qw(gensym);
+
+sub Version { $VERSION; }
+$VERSION = sprintf("%d.%02d", q$Revision: 0.7 $ =~ /(\d+)\.(\d+)/);
+
+$MAGIC           = "#COUNTER-1.0\n";   # first line in counter files
+$DEFAULT_INITIAL = 0;                  # default initial counter value
+
+ # default location for counter files
+$DEFAULT_DIR     = $ENV{TMPDIR} || "/usr/tmp";
+
+# Experimental overloading.
+%OVERLOAD = ('++'     => \&inc,
+	     '--'     => \&dec,
+ 	     '""'     => \&value,
+	     fallback => 1,
+);
+
+
+sub new
+{
+    my($class, $file, $initial) = @_;
+    croak "No file specified\n" unless defined $file;
+
+    $file = "$DEFAULT_DIR/$file" unless $file =~ /^[\.\/]/;
+    $initial = $DEFAULT_INITIAL unless defined $initial;
+
+    my $value;
+    if (-e $file) {
+	croak "Specified file is a directory" if -d _;
+	open(F, $file) or croak "Can't open $file: $!";
+	my $first_line = <F>;
+	$value = <F>;
+	close(F);
+	croak "Bad counter magic in $file" unless $first_line eq $MAGIC;
+	chomp($value);
+    } else {
+	open(F, ">$file") or croak "Can't create $file: $!";
+	print F $MAGIC;
+	print F $initial, "\n";
+	close(F);
+	$value = $initial;
+    }
+
+    bless { file    => $file,  # the filename for the counter
+	    value   => $value, # the current value
+	    updated => 0,      # flag indicating if value has changed
+	    # handle => XXX,   # file handle symbol. Only present when locked
+	  };
+}
+
+
+sub locked
+{
+    exists shift->{handle};
+}
+
+
+sub lock
+{
+    my($self) = @_;
+    $self->unlock if $self->locked;
+
+    my $fh = gensym();
+    my $file = $self->{file};
+
+    open($fh, "+<$file") or croak "Can't open $file: $!";
+    flock($fh, 2) or croak "Can't flock: $!";  # 2 = exlusive lock
+
+    my $magic = <$fh>;
+    if ($magic ne $MAGIC) {
+	$self->unlock;
+	croak("Bad counter magic '$magic' in $file");
+    }
+    chomp($self->{value} = <$fh>);
+
+    $self->{handle}  = $fh;
+    $self->{updated} = 0;
+    $self;
+}
+
+
+sub unlock
+{
+    my($self) = @_;
+    return unless $self->locked;
+
+    my $fh = $self->{handle};
+
+    if ($self->{updated}) {
+	# write back new value
+	seek($fh, 0, 0) or croak "Can't seek to beginning: $!";
+	print $fh $MAGIC;
+	print $fh "$self->{value}\n";
+    }
+
+    close($fh) or warn "Can't close: $!";
+    delete $self->{handle};
+    $self;
+}
+
+
+sub inc
+{
+    my($self) = @_;
+
+    if ($self->locked) {
+	$self->{value}++;
+	$self->{updated} = 1;
+    } else {
+	$self->lock;
+	$self->{value}++;
+	$self->{updated} = 1;
+	$self->unlock;
+    }
+    $self->{value}; # return value
+}
+
+
+sub dec
+{
+    my($self) = @_;
+
+    if ($self->locked) {
+	croak "Autodecrement is not magical in perl"
+	    unless $self->{value} =~ /^\d+$/;
+	$self->{value}--;
+	$self->{updated} = 1;
+    } else {
+	$self->lock;
+	croak "Autodecrement is not magical in perl"
+	    unless $self->{value} =~ /^\d+$/;
+	$self->{value}--;
+	$self->{updated} = 1;
+	$self->unlock;
+    }
+    $self->{value}; # return value
+}
+
+
+sub value
+{
+    my($self) = @_;
+    my $value;
+    if ($self->locked) {
+	$value = $self->{value};
+    } else {
+	$self->lock;
+	$value = $self->{value};
+	$self->unlock;
+    }
+    $value;
+}
+
+
+sub DESTROY
+{
+    my $self = shift;
+    $self->unlock;
+}
+
+####################################################################
+#
+# S E L F   T E S T   S E C T I O N
+#
+#####################################################################
+#
+# If we're not use'd or require'd execute self-test.
+#
+# Test is kept behind __END__ so it doesn't take uptime
+# and memory  unless explicitly required. If you're working
+# on the code you might find it easier to comment out the
+# eval and __END__ so that error line numbers make more sense.
+
+package main;
+
+eval join('',<DATA>) || die $@ unless caller();
+
+1;
+
+__END__
+
+
+$cf = "./zz-counter-$$";  # the name for out temprary counter
+
+# Test normal object creation and increment
+
+$c = new File::CounterFile $cf;
+
+$id1 = $c->inc;
+$id2 = $c->inc;
+
+$c = new File::CounterFile $cf;
+$id3 = $c->inc;
+$id4 = $c->dec;
+
+die "test failed" unless ($id1 == 1 && $id2 == 2 && $id3 == 3 && $id4 == 2);
+unlink $cf;
+
+# Test magic increment
+
+$id1 = (new File::CounterFile $cf, "aa98")->inc;
+$id2 = (new File::CounterFile $cf)->inc;
+$id3 = (new File::CounterFile $cf)->inc;
+
+eval {
+    # This should now work because "Decrement is not magical in perl"
+    $c = new File::CounterFile $cf; $id4 = $c->dec; $c = undef;
+};
+die "test failed (No exception to catch)" unless $@;
+
+#print "$id1 $id2 $id3\n";
+
+die "test failed" unless ($id1 eq "aa99" && $id2 eq "ab00" && $id3 eq "ab01");
+unlink $cf;
+
+# Test operator overloading
+
+$c = new File::CounterFile $cf, "100";
+
+$c->lock;
+
+$c++;  # counter is now 101
+$c++;  # counter is now 102
+$c++;  # counter is now 103
+$c--;  # counter is now 102 again
+
+$id1 = "$c";
+$id2 = ++$c;
+
+$c = undef;  # destroy object
+
+unlink $cf;
+
+die "test failed" unless $id1 == 102 && $id2 == 103;
+
+
+print "Selftest for File::CounterFile $File::CounterFile::VERSION ok\n";