[interchange-cvs] interchange - heins modified 8 files

interchange-cvs at icdevgroup.org interchange-cvs at icdevgroup.org
Mon Aug 4 02:11:00 EDT 2003


User:      heins
Date:      2003-08-04 05:11:20 GMT
Modified:  lib/Vend CounterFile.pm Interpolate.pm
Modified:  dist/test/products tests.asc
Modified:  lib/Vend/Table Common.pm DBI.pm DB_File.pm GDBM.pm SDBM.pm
Log:
* Add date-based counter capability to Vend::CounterFile. Creates keys
  based

* In a database, you just add

	Database tablename AUTO_NUMBER_DATE 1

  To have real autonumbering, you still must define AUTO_NUMBER.
  This of course does not work with AUTO_SEQUENCE.

  You must make sure your key field type is at least 12 chars.

* In a counter tag, you do:

	[counter file=filename.ctr date=local]

  or

  	$Tag->counter({ file => $fn, date => 'local'});

  To define GMT as being used for the numbering, you do:

	[counter file=filename.ctr date=gmt]

* Regression tests included.

* Documentation included in separate commit to docs tree.

* This commit also fixes problems that GDBM and some other
  types would not honor HIDE_AUTO_FILES.

Revision  Changes    Path
1.3       +86 -16    interchange/lib/Vend/CounterFile.pm


rev 1.3, prev_rev 1.2
Index: CounterFile.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/CounterFile.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- CounterFile.pm	18 Jun 2003 17:34:44 -0000	1.2
+++ CounterFile.pm	4 Aug 2003 05:11:20 -0000	1.3
@@ -1,10 +1,11 @@
 # This -*-perl -*- module implements a persistent counter class.
 #
-# $Id: CounterFile.pm,v 1.2 2003/06/18 17:34:44 jon Exp $
+# $Id: CounterFile.pm,v 1.3 2003/08/04 05:11:20 mheins Exp $
 #
 
 package Vend::CounterFile;
 use Vend::Util;
+use POSIX qw/strftime/;
 
 
 =head1 NAME
@@ -97,10 +98,18 @@
 };
 
 sub Version { $VERSION; }
-$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
 
-$MAGIC           = "#COUNTER-1.0\n";   # first line in counter files
-$DEFAULT_INITIAL = 0;                  # default initial counter value
+# first line in counter file, regex to match good value
+$MAGIC           = "#COUNTER-1.0\n";    # first line in standard counter files
+# first line in date counter files
+$MAGIC_RE        = qr/^#COUNTER-1.0-(gmt|date)-([A-Za-z0-9]+)/;
+$MAGIC_DATE      = "#COUNTER-1.0-date"; # start of first line in date counter files
+$MAGIC_GMT       = "#COUNTER-1.0-gmt";  # start of first line in gmt counter files
+
+$DEFAULT_INITIAL	 	= 0;          # default initial counter value
+$DEFAULT_DATE_INITIAL	= '0000';     # default initial counter value in date mode
+$DATE_FORMAT     = '%Y%m%d';
 
  # default location for counter files
 $DEFAULT_DIR     ||= $ENV{TMPDIR} || "/usr/tmp";
@@ -115,11 +124,15 @@
 
 sub new
 {
-	my($class, $file, $initial) = @_;
+	my($class, $file, $initial, $date) = @_;
 	croak "No file specified\n" unless defined $file;
 
 	$file = "$DEFAULT_DIR/$file" unless $file =~ /^[\.\/]/;
-	$initial = $DEFAULT_INITIAL unless defined $initial;
+	$initial = $date ? $DEFAULT_DATE_INITIAL : $DEFAULT_INITIAL
+		unless defined $initial;
+
+	my $gmt;
+	my $magic_value;
 
 	local($/, $\) = ("\n", undef);
 	my $value;
@@ -129,23 +142,75 @@
 		my $first_line = <F>;
 		$value = <F>;
 		close(F);
-		croak "Bad counter magic '$first_line' in $file" unless $first_line eq $MAGIC;
+		if($first_line eq $MAGIC) {
+			# do nothing
+		}
+		elsif( $first_line =~ $MAGIC_RE) {
+			$date = $1;
+			$initial = $2;
+#::logDebug("read existing date counter, date=$date initial=$initial");
+			$gmt = 1 if $date eq 'gmt';
+			$magic_value = $first_line;
+		}
+		else {
+			chomp($first_line);
+			croak ::errmsg("Bad counter magic '%s' in %s", $first_line, $file);
+		}
 		chomp($value);
 	} else {
 		open(F, ">$file") or croak "Can't create $file: $!";
-		print F $MAGIC;
-		print F "$initial\n";
+		if($date) {
+			my $ivalue;
+			if($date eq 'gmt') {
+				$magic_value = $MAGIC_GMT . "-$initial\n";
+				print F $magic_value;
+				$ivalue = strftime('%Y%m%d', gmtime()) . $initial;
+				print F "$ivalue\n";
+				$gmt = 1;
+			}
+			else {
+				$magic_value = $MAGIC_DATE . "-$initial\n";
+				print F $magic_value;
+				$ivalue = strftime('%Y%m%d', localtime()) . $initial;
+				print F "$ivalue\n";
+			}
+			$value = $ivalue;
+		}
+		else {
+			print F $MAGIC;
+			print F "$initial\n";
+			$value = $initial;
+		}
 		close(F);
-		$value = $initial;
 	}
 
-	bless { file    => $file,  # the filename for the counter
+	my $s = { file    => $file,  # the filename for the counter
 		   'value'  => $value, # the current value
 			updated => 0,      # flag indicating if value has changed
+			initial => $initial,      # initial value for date-based
+			magic_value => $magic_value,      # initial magic value for date-based
+			date	=> $date,  # flag indicating date-based counter
+			gmt		=> $gmt,   # flag indicating GMT for date
 			# handle => XXX,   # file handle symbol. Only present when locked
 		  };
+#::logDebug("counter object created: " . ::uneval($s));
+	return bless $s;
 }
 
+sub inc_value {
+	my $self = shift;
+	$self->{'value'}++, return unless $self->{date};
+	my $datebase = $self->{gmt}
+				 ? strftime($DATE_FORMAT, gmtime())
+				 : strftime($DATE_FORMAT, localtime());
+	$self->{value} = $datebase . ($self->{initial} || $DEFAULT_DATE_INITIAL)
+		if $self->{value} lt $datebase;
+	my $inc = substr($self->{value}, 8);
+#::logDebug("initial=$self->{initial} inc before autoincrement value=$inc");
+	$inc++;
+#::logDebug("initial=$self->{initial} inc after  autoincrement value=$inc");
+	$self->{value} = $datebase . $inc;
+}
 
 sub locked
 {
@@ -167,9 +232,10 @@
 
 	local($/) = "\n";
 	my $magic = <$fh>;
-	if ($magic ne $MAGIC) {
+	if ($magic ne $MAGIC and $magic !~ $MAGIC_RE ) {
 		$self->unlock;
-		croak("Bad counter magic '$magic' in $file");
+		chomp $magic;
+		croak errmsg("Bad counter magic '%s' in %s on lock", $magic, $file);
 	}
 	chomp($self->{'value'} = <$fh>);
 
@@ -197,7 +263,7 @@
 		croak "Can't seek to beginning: $!"
 				if ! $sstatus;
 
-		print $fh $MAGIC;
+		print $fh $self->{magic_value} || $MAGIC;
 		print $fh "$self->{'value'}\n";
 	}
 
@@ -212,11 +278,11 @@
 	my($self) = @_;
 
 	if ($self->locked) {
-		$self->{'value'}++;
+		$self->inc_value();
 		$self->{updated} = 1;
 	} else {
 		$self->lock;
-		$self->{'value'}++;
+		$self->inc_value();
 		$self->{updated} = 1;
 		$self->unlock;
 	}
@@ -231,12 +297,16 @@
 	if ($self->locked) {
 		croak "Autodecrement is not magical in perl"
 			unless $self->{'value'} =~ /^\d+$/;
+		croak "cannot decrement date-based counters"
+			if $self->{date};
 		$self->{'value'}--;
 		$self->{updated} = 1;
 	} else {
 		$self->lock;
 		croak "Autodecrement is not magical in perl"
 			unless $self->{'value'} =~ /^\d+$/;
+		croak "cannot decrement date-based counters"
+			if $self->{date};
 		$self->{'value'}--;
 		$self->{updated} = 1;
 		$self->unlock;



2.187     +3 -3      interchange/lib/Vend/Interpolate.pm


rev 2.187, prev_rev 2.186
Index: Interpolate.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.186
retrieving revision 2.187
diff -u -r2.186 -r2.187
--- Interpolate.pm	31 Jul 2003 13:18:20 -0000	2.186
+++ Interpolate.pm	4 Aug 2003 05:11:20 -0000	2.187
@@ -1,6 +1,6 @@
 # Vend::Interpolate - Interpret Interchange tags
 # 
-# $Id: Interpolate.pm,v 2.186 2003/07/31 13:18:20 jon Exp $
+# $Id: Interpolate.pm,v 2.187 2003/08/04 05:11:20 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -28,7 +28,7 @@
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = substr(q$Revision: 2.186 $, 10);
+$VERSION = substr(q$Revision: 2.187 $, 10);
 
 @EXPORT = qw (
 
@@ -2394,7 +2394,7 @@
 	
     $file = $Vend::Cfg->{VendRoot} . "/$file"
         unless Vend::Util::file_name_is_absolute($file);
-    my $ctr = new Vend::CounterFile $file, $opt->{start} || undef;
+    my $ctr = new Vend::CounterFile $file, $opt->{start} || undef, $opt->{date};
     return $ctr->value() if $opt->{value};
     return $ctr->dec() if $opt->{decrement};
     return $ctr->inc();



2.12      +39 -8     interchange/dist/test/products/tests.asc


rev 2.12, prev_rev 2.11
Index: tests.asc
===================================================================
RCS file: /var/cvs/interchange/dist/test/products/tests.asc,v
retrieving revision 2.11
retrieving revision 2.12
diff -u -r2.11 -r2.12
--- tests.asc	12 Jul 2003 13:40:43 -0000	2.11
+++ tests.asc	4 Aug 2003 05:11:20 -0000	2.12
@@ -2330,20 +2330,51 @@
 %%
 Test DB error handling
 %%%
-999999
+000150
 %%
-[the test] [perl]
-# Make this come out right
-return 'The expected result as a regex.';
-[/perl]
+[unlink-file name="tmp/date_based.ctr"]
+[calc]
+	$Scratch->{initial} = $Tag->time({fmt => '%Y%m%d'}) . '0001';
+	$Scratch->{initial2} = $Scratch->{initial} + 1;
+	return;
+[/calc]
+'[counter date=1 file="tmp/date_based.ctr"]'='[scratch initial]'
+'[counter file="tmp/date_based.ctr"]'='[scratch initial2]'
 %%
-The expected result as a regex.
+'(\d+)'='\1'\s+'(\d+)'='\2'
 %%
-The NOT expected result.
+
+%%
+
+%%
+Test local date-based counter
+%%%
+000151
+%%
+[unlink-file name="tmp/date_based.ctr"]
+[calc]
+	$Scratch->{initial} = $Tag->time({fmt => '%Y%m%d'}) . 'A001';
+	$Scratch->{initial2} = $Tag->time({fmt => '%Y%m%d'}) . 'A002';
+	return;
+[/calc]
+'[counter date=1 file="tmp/date_based.ctr" start=A000]'='[scratch initial]'
+'[counter file="tmp/date_based.ctr"]'='[scratch initial2]'
+[calc]
+	my $newtime =  $Tag->time({fmt => '%Y%m%d', adjust => "-1 day"});
+	my $ctr = $Tag->file('tmp/date_based.ctr');
+	$ctr =~ s/(.*\n)\d{8}/$1$newtime/;
+	$Tag->write_relative_file('tmp/date_based.ctr', $ctr);
+	return;
+[/calc]
+'[counter file="tmp/date_based.ctr" start=A000]'='[scratch initial]'
+%%
+'(\w+)'='\1'\s+'(\w+)'='\2'\s+'(\w+)'='\3'
+%%
+
 %%
 
 %%
-Skeleton test.
+Test local date-based counter with alpha start, test rollover
 %%%
 999999
 %%



2.32      +7 -3      interchange/lib/Vend/Table/Common.pm


rev 2.32, prev_rev 2.31
Index: Common.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/Common.pm,v
retrieving revision 2.31
retrieving revision 2.32
diff -u -r2.31 -r2.32
--- Common.pm	12 Jul 2003 12:56:56 -0000	2.31
+++ Common.pm	4 Aug 2003 05:11:20 -0000	2.32
@@ -1,6 +1,6 @@
 # Vend::Table::Common - Common access methods for Interchange databases
 #
-# $Id: Common.pm,v 2.31 2003/07/12 12:56:56 mheins Exp $
+# $Id: Common.pm,v 2.32 2003/08/04 05:11:20 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -23,7 +23,7 @@
 # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
 # MA  02111-1307  USA.
 
-$VERSION = substr(q$Revision: 2.31 $, 10);
+$VERSION = substr(q$Revision: 2.32 $, 10);
 use strict;
 
 package Vend::Table::Common;
@@ -149,8 +149,12 @@
 	local($/) = "\n";
 	my $c = $s->[$CONFIG];
 	if(! defined $c->{AutoNumberCounter}) {
+		my $dot = $c->{HIDE_AUTO_FILES} ? '.' : '';
 		$c->{AutoNumberCounter} = new Vend::CounterFile
-									"$c->{DIR}/$c->{name}.autonumber", $start;
+									"$c->{DIR}/$dot$c->{name}.autonumber",
+									$start,
+									$c->{AUTO_NUMBER_DATE},
+									;
 	}
 	my $num;
 	do {



2.55      +5 -5      interchange/lib/Vend/Table/DBI.pm


rev 2.55, prev_rev 2.54
Index: DBI.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/DBI.pm,v
retrieving revision 2.54
retrieving revision 2.55
diff -u -r2.54 -r2.55
--- DBI.pm	29 Jul 2003 23:56:54 -0000	2.54
+++ DBI.pm	4 Aug 2003 05:11:20 -0000	2.55
@@ -1,6 +1,6 @@
 # Vend::Table::DBI - Access a table stored in an DBI/DBD database
 #
-# $Id: DBI.pm,v 2.54 2003/07/29 23:56:54 jon Exp $
+# $Id: DBI.pm,v 2.55 2003/08/04 05:11:20 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -21,7 +21,7 @@
 # MA  02111-1307  USA.
 
 package Vend::Table::DBI;
-$VERSION = substr(q$Revision: 2.54 $, 10);
+$VERSION = substr(q$Revision: 2.55 $, 10);
 
 use strict;
 
@@ -519,8 +519,6 @@
 
 sub open_table {
     my ($class, $config, $tablename) = @_;
-	
-	my $dot = $config->{HIDE_AUTO_FILES} ? '.' : '';
 
 	$config->{PRINTERROR} = 0 if ! defined $config->{PRINTERROR};
 	$config->{RAISEERROR} = 1 if ! defined $config->{RAISEERROR};
@@ -533,9 +531,11 @@
 
     if (! $config->{AUTO_SEQUENCE} and ! defined $config->{AutoNumberCounter}) {
 	    eval {
+			my $dot = $config->{HIDE_AUTO_FILES} ? '.' : '';
 			$config->{AutoNumberCounter} = new Vend::CounterFile
 									"$config->{DIR}/$dot$config->{name}.autonumber",
-									$config->{AUTO_NUMBER} || '00001';
+									$config->{AUTO_NUMBER} || '00001',
+									$config->{AUTO_NUMBER_DATE};
 		};
 		if($@) {
 			::logError("Cannot create AutoNumberCounter: %s", $@);



2.10      +6 -4      interchange/lib/Vend/Table/DB_File.pm


rev 2.10, prev_rev 2.9
Index: DB_File.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/DB_File.pm,v
retrieving revision 2.9
retrieving revision 2.10
diff -u -r2.9 -r2.10
--- DB_File.pm	12 Jul 2003 13:40:43 -0000	2.9
+++ DB_File.pm	4 Aug 2003 05:11:20 -0000	2.10
@@ -1,6 +1,6 @@
 # Vend::Table::DB_File - Access an Interchange table stored in a DB file hash
 #
-# $Id: DB_File.pm,v 2.9 2003/07/12 13:40:43 mheins Exp $
+# $Id: DB_File.pm,v 2.10 2003/08/04 05:11:20 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -31,7 +31,7 @@
 use Vend::Table::Common;
 
 @ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.9 $, 10);
+$VERSION = substr(q$Revision: 2.10 $, 10);
 
 sub create {
 	my ($class, $config, $columns, $filename) = @_;
@@ -83,9 +83,11 @@
 		$flags = O_RDWR;
 		if(! defined $config->{AutoNumberCounter}) {
 			eval {
+				my $dot = $config->{HIDE_AUTO_FILES} ? '.' : '';
 				$config->{AutoNumberCounter} = new Vend::CounterFile
-											"$config->{DIR}/$config->{name}.autonumber",
-											$config->{AUTO_NUMBER} || '00001';
+									"$config->{DIR}/$dot$config->{name}.autonumber",
+									$config->{AUTO_NUMBER} || '00001',
+									$config->{AUTO_NUMBER_DATE};
 			};
 			if($@) {
 				::logError("Cannot create AutoNumberCounter: %s", $@);



2.10      +6 -4      interchange/lib/Vend/Table/GDBM.pm


rev 2.10, prev_rev 2.9
Index: GDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/GDBM.pm,v
retrieving revision 2.9
retrieving revision 2.10
diff -u -r2.9 -r2.10
--- GDBM.pm	12 Jul 2003 13:40:43 -0000	2.9
+++ GDBM.pm	4 Aug 2003 05:11:20 -0000	2.10
@@ -1,6 +1,6 @@
 # Vend::Table::GDBM - Access an Interchange table stored in a GDBM file
 #
-# $Id: GDBM.pm,v 2.9 2003/07/12 13:40:43 mheins Exp $
+# $Id: GDBM.pm,v 2.10 2003/08/04 05:11:20 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -30,7 +30,7 @@
 use Vend::Table::Common;
 
 @ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.9 $, 10);
+$VERSION = substr(q$Revision: 2.10 $, 10);
 
 sub new {
 	my ($class, $obj) = @_;
@@ -85,9 +85,11 @@
 		$flags = GDBM_WRITER;
 		if(! defined $config->{AutoNumberCounter}) {
 			eval {
+				my $dot = $config->{HIDE_AUTO_FILES} ? '.' : '';
 				$config->{AutoNumberCounter} = new Vend::CounterFile
-											"$config->{DIR}/$config->{name}.autonumber",
-											$config->{AUTO_NUMBER} || '00001';
+									"$config->{DIR}/$dot$config->{name}.autonumber",
+									$config->{AUTO_NUMBER} || '00001',
+									$config->{AUTO_NUMBER_DATE};
 			};
 			if($@) {
 				::logError("Cannot create AutoNumberCounter: %s", $@);



2.10      +7 -5      interchange/lib/Vend/Table/SDBM.pm


rev 2.10, prev_rev 2.9
Index: SDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/SDBM.pm,v
retrieving revision 2.9
retrieving revision 2.10
diff -u -r2.9 -r2.10
--- SDBM.pm	12 Jul 2003 13:40:43 -0000	2.9
+++ SDBM.pm	4 Aug 2003 05:11:20 -0000	2.10
@@ -1,6 +1,6 @@
 # Vend::Table::SDBM - Access an Interchange table stored in Perl's internal SDBM
 #
-# $Id: SDBM.pm,v 2.9 2003/07/12 13:40:43 mheins Exp $
+# $Id: SDBM.pm,v 2.10 2003/08/04 05:11:20 mheins Exp $
 #
 # Copyright (C) 2002-2003 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -24,7 +24,7 @@
 # MA  02111-1307  USA.
 
 package Vend::Table::SDBM;
-$VERSION = substr(q$Revision: 2.9 $, 10);
+$VERSION = substr(q$Revision: 2.10 $, 10);
 use strict;
 use Fcntl;
 use SDBM_File;
@@ -32,7 +32,7 @@
 use Vend::Table::Common;
 
 @ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.9 $, 10);
+$VERSION = substr(q$Revision: 2.10 $, 10);
 
 sub create {
 	my ($class, $config, $columns, $filename) = @_;
@@ -101,9 +101,11 @@
 		$flags = O_RDWR;
 		if(! defined $config->{AutoNumberCounter}) {
 			eval {
+				my $dot = $config->{HIDE_AUTO_FILES} ? '.' : '';
 				$config->{AutoNumberCounter} = new Vend::CounterFile
-											"$config->{DIR}/$config->{name}.autonumber",
-											$config->{AUTO_NUMBER} || '00001';
+									"$config->{DIR}/$dot$config->{name}.autonumber",
+									$config->{AUTO_NUMBER} || '00001',
+									$config->{AUTO_NUMBER_DATE};
 			};
 			if($@) {
 				::logError("Cannot create AutoNumberCounter: %s", $@);







More information about the interchange-cvs mailing list