[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