[interchange-cvs] interchange - heins modified 2 files

[interchange-cvs at icdevgroup.org]

User:      heins
Date:      2003-09-19 03:27:59 GMT
Modified:  lib/Vend CounterFile.pm Interpolate.pm
Log:
* Allow custom increment and decrement routines with inc-routine and
  dec-routine options. They can be an inline code reference:

	[counter
		file=testcount
		inc-routine=`sub { shift(@_) + 2 }`
	]
	[counter
		file=testcount
		decrement=1
		dec-routine=`sub { shift(@_) - 2 }`
	]

  or a Sub or GlobalSub:

	catalog.cfg:
  	Sub three_steps_forward <<EOR
	sub {
		my $val = shift; $val += 3; return $val;
	}
	EOR

  	Sub two_steps_back <<EOR
	sub {
		my $val = shift; $val -= 2; return $val;
	}
	EOR

	[counter file=testcount inc-routine=three_steps_forward]
	[counter file=testcount dec-routine=two_steps_back decrement=1]

Revision  Changes    Path
1.4       +23 -7     interchange/lib/Vend/CounterFile.pm


rev 1.4, prev_rev 1.3
Index: CounterFile.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/CounterFile.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- CounterFile.pm	4 Aug 2003 05:11:20 -0000	1.3
+++ CounterFile.pm	19 Sep 2003 03:27:59 -0000	1.4
@@ -1,6 +1,6 @@
 # This -*-perl -*- module implements a persistent counter class.
 #
-# $Id: CounterFile.pm,v 1.3 2003/08/04 05:11:20 mheins Exp $
+# $Id: CounterFile.pm,v 1.4 2003/09/19 03:27:59 mheins Exp $
 #
 
 package Vend::CounterFile;
@@ -98,7 +98,7 @@
 };
 
 sub Version { $VERSION; }
-$VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
 
 # first line in counter file, regex to match good value
 $MAGIC           = "#COUNTER-1.0\n";    # first line in standard counter files
@@ -124,7 +124,7 @@
 
 sub new
 {
-	my($class, $file, $initial, $date) = @_;
+	my($class, $file, $initial, $date, $inc_routine, $dec_routine) = @_;
 	croak "No file specified\n" unless defined $file;
 
 	$file = "$DEFAULT_DIR/$file" unless $file =~ /^[\.\/]/;
@@ -187,6 +187,8 @@
 	my $s = { file    => $file,  # the filename for the counter
 		   'value'  => $value, # the current value
 			updated => 0,      # flag indicating if value has changed
+			inc_routine => $inc_routine,      # Custom incrementor
+			dec_routine => $dec_routine,      # Custom decrementor
 			initial => $initial,      # initial value for date-based
 			magic_value => $magic_value,      # initial magic value for date-based
 			date	=> $date,  # flag indicating date-based counter
@@ -199,6 +201,10 @@
 
 sub inc_value {
 	my $self = shift;
+	if ($self->{inc_routine}) {
+		$self->{value} = $self->{inc_routine}->($self->{value});
+		return;
+	}
 	$self->{'value'}++, return unless $self->{date};
 	my $datebase = $self->{gmt}
 				 ? strftime($DATE_FORMAT, gmtime())
@@ -212,6 +218,16 @@
 	$self->{value} = $datebase . $inc;
 }
 
+sub dec_value {
+	my $self = shift;
+	if ($self->{dec_routine}) {
+		$self->{value} = $self->{dec_routine}->($self->{value});
+		return;
+	}
+	$self->{'value'}--;
+	return;
+}
+
 sub locked
 {
 	exists shift->{handle};
@@ -296,18 +312,18 @@
 
 	if ($self->locked) {
 		croak "Autodecrement is not magical in perl"
-			unless $self->{'value'} =~ /^\d+$/;
+			unless $self->{dec_routine} || $self->{'value'} =~ /^\d+$/;
 		croak "cannot decrement date-based counters"
 			if $self->{date};
-		$self->{'value'}--;
+		$self->dec_value();
 		$self->{updated} = 1;
 	} else {
 		$self->lock;
 		croak "Autodecrement is not magical in perl"
-			unless $self->{'value'} =~ /^\d+$/;
+			unless $self->{dec_routine} || $self->{'value'} =~ /^\d+$/;
 		croak "cannot decrement date-based counters"
 			if $self->{date};
-		$self->{'value'}--;
+		$self->dec_value();
 		$self->{updated} = 1;
 		$self->unlock;
 	}



2.192     +20 -4     interchange/lib/Vend/Interpolate.pm


rev 2.192, prev_rev 2.191
Index: Interpolate.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.191
retrieving revision 2.192
diff -u -r2.191 -r2.192
--- Interpolate.pm	11 Sep 2003 15:15:32 -0000	2.191
+++ Interpolate.pm	19 Sep 2003 03:27:59 -0000	2.192
@@ -1,6 +1,6 @@
 # Vend::Interpolate - Interpret Interchange tags
 # 
-# $Id: Interpolate.pm,v 2.191 2003/09/11 15:15:32 racke Exp $
+# $Id: Interpolate.pm,v 2.192 2003/09/19 03:27:59 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.191 $, 10);
+$VERSION = substr(q$Revision: 2.192 $, 10);
 
 @EXPORT = qw (
 
@@ -2343,7 +2343,7 @@
 sub tag_counter {
     my $file = shift || 'etc/counter';
 	my $opt = shift;
-#::logDebug("counter: file=$file start=$opt->{start} sql=$opt->{sql} caller=" . scalar(caller()) );
+::logDebug("counter: file=$file start=$opt->{start} sql=$opt->{sql} routine=$opt->{inc_routine} caller=" . scalar(caller()) );
 	if($opt->{sql}) {
 		my ($tab, $seq) = split /:+/, $opt->{sql}, 2;
 		my $db = database_exists_ref($tab);
@@ -2413,7 +2413,23 @@
 	
     $file = $Vend::Cfg->{VendRoot} . "/$file"
         unless Vend::Util::file_name_is_absolute($file);
-    my $ctr = new Vend::CounterFile $file, $opt->{start} || undef, $opt->{date};
+
+	for(qw/inc_routine dec_routine/) {
+		my $routine = $opt->{$_}
+			or next;
+
+		if( ! ref($routine) ) {
+			$opt->{$_}   = $Vend::Cfg->{Sub}{$routine};
+			$opt->{$_} ||= $Global::GlobalSub->{$routine};
+		}
+	}
+
+    my $ctr = new Vend::CounterFile
+					$file,
+					$opt->{start} || undef,
+					$opt->{date},
+					$opt->{inc_routine},
+					$opt->{dec_routine};
     return $ctr->value() if $opt->{value};
     return $ctr->dec() if $opt->{decrement};
     return $ctr->inc();