evaluate variable expansion on demand when $config->{} (FETCH()) is

called.

nuke _expand_special_syntax()

reorder methods and add documents on them.

1 files changed, 127 insertions, 75 deletions

diff --git a/fml/lib/FML/Config.pm b/fml/lib/FML/Config.pm
index 73f4960c..95fdac9e 100644
--- a/fml/lib/FML/Config.pm
+++ b/fml/lib/FML/Config.pm
@@ -2,14 +2,17 @@
 # Copyright (C) 2000 Ken'ichi Fukamachi
 #
 # $Id$
-# $FML: Config.pm,v 1.26 2001/04/03 09:45:40 fukachan Exp $ # 注意: cvs のタグを $FML: Config.pm,v 1.26 2001/04/03 09:45:40 fukachan Exp $ にする
+# $FML: Config.pm,v 1.27 2001/04/08 13:25:38 fukachan Exp $ # 注意: cvs のタグを $FML: Config.pm,v 1.27 2001/04/08 13:25:38 fukachan Exp $ にする
 #
 
 package FML::Config;
 
 use strict;
 use Carp;
-use vars qw(%_fml_config %_default_fml_config);
+use vars qw($need_expantion_variables
+	    %_fml_config_result
+	    %_fml_config
+	    %_default_fml_config);
 use ErrorStatus qw(error_set error error_clear);
 
 
@@ -75,24 +78,11 @@ memory which locates within FML::Parse name space.
 
 =head1 METHODS
 
-=head2  C<Init( ref_to_curproc )>
+=head2  C<new( ref_to_curproc )>
 
 special method only used in the initialization phase.
 This method binds $curproc and the %_fml_config memory area.
 
-=head2  C<load_file( filename )>
-
-read the configuration file, split key and value and set them to
-%_fml_config.
-
-=head2  C<get( key )>
-
-=head2  C<set( key, value )>
-
-=head2  C<dump_variables()>
-
-show all {key => value} for debug.
-
 =cut
 
 
@@ -101,7 +91,11 @@ sub new
     my ($self, $args) = @_;
 
     unless (defined %_fml_config) { %_fml_config = ( pid => $$ );}
-    my $me = \%_fml_config;
+
+    # prepare the tied hash to %_fml_config;
+    # to support $config->{ variable } syntax.
+    my $me = {};
+    tie %$me, $self;
 
     # import variables
     if (defined $args) {
@@ -113,39 +107,11 @@ sub new
 }
 
 
-sub dump_variables
-{
-    my ($self, $args) = @_;
-    my ($k, $v);
-    my $len  = 0;
-    my $mode = $args->{ mode } || 'all';
-
-    for $k (keys %_fml_config) { $len = $len > length($k) ? $len : length($k);}
-
-    my $format = '%-'. $len. 's = %s'. "\n";
-    for $k (sort keys %_fml_config) {
-	next unless $k =~ /^[a-z0-9]/io;
-	$v = $_fml_config{ $k };
+=head2  C<get( key )>
 
-	# print out all keys
-	if ($mode eq 'all') {
-	    printf $format, $k, $v;
-	}
-	# compare the value with the default one
-	# print key if values for the key differs.
-	else {
-	    if (defined $_default_fml_config{ $k }) {
-		if ($v ne $_default_fml_config{ $k }) {
-		    printf $format, $k, $v;
-		}
-	    }
-	    else {
-		printf $format, $k, $v;
-	    }
-	}
-    }
-}
+=head2  C<set( key, value )>
 
+=cut
 
 sub get
 {
@@ -161,6 +127,19 @@ sub set
 }
 
 
+
+=head2  C<overload( filename )>
+
+alias of C<load_file( filename )>.
+
+=head2  C<load_file( filename )>
+
+read the configuration file, split key and value and set them to
+%_fml_config.
+
+=cut
+
+
 sub overload 
 {
     my ($self, $file) = @_;
@@ -210,19 +189,37 @@ sub load_file
     unless (%_default_fml_config) {
 	%_default_fml_config = %_fml_config;
     }
+
+    # flag on: we need $config->{ key } needs variable expantion
+    $need_expantion_variables = 1;
 }
 
 
+=head2 C<expand_variables()>
+
+expand all variables in C<%_default_fml_config> and C<%_fml_config>.
+The expanded result is saved in the same hash.
+
+  XXX obsolete ? This method is used before hook is introduced.
+  XXX Consider a hook may change the variable.
+  XXX We should expand variables on demand in that case
+
+=cut
+
+
 # expand variable name e.g. $dir/xxx -> /var/spool/ml/elena/xxx
 sub expand_variables
 {
     my ($self) = @_;
+
+    # always expand variables within itself.
     _expand_variables( \%_default_fml_config );
-    _expand_variables( \%_fml_config );
 
-    # disable POSIX strftime() expansion which conflicts
-    # printf() expansion
-    # _expand_special_syntax( \%_fml_config );
+    # XXX 2001/05/05
+    # XXX %_fml_config        has variables before expansion.
+    # XXX %_fml_config_result has variables after expansion.
+    %_fml_config_result = %_fml_config;
+    _expand_variables( \%_fml_config_result );
 }
 
 
@@ -247,8 +244,8 @@ sub _expand_variables
 	next KEY if $config->{ $x } !~ /\$/o;
 
 	# we need a loop to expand nested variables, for example, 
-	# a = $x/y and b = $a/c/0
-	# 
+	# "a = $x/y" and "b = $a/c/0" would be "b = $x/y/c/0"
+
 	$max = 0;
       EXPANSION_LOOP:
 	while ($max++ < 16) {
@@ -272,28 +269,13 @@ sub _expand_variables
 }
 
 
-sub _expand_special_syntax
-{
-    my ($config) = @_;
-    my @order  = keys %$config;
-    my $use_strftime = 0;
+=head2 C<yes( key )>
 
-    for my $x ( @order ) {
-	if ($config->{ $x } =~ /\%[a-zA-Z]/) { $use_strftime = 1;}
-    }
+=head2 C<no( key )>
 
-    if ($use_strftime) {
-	eval qq{ require POSIX; import POSIX qw(strftime);};
-	unless ($@) {
-	    for my $x ( @order ) {
-		if ($config->{ $x } =~ /\%[a-zA-Z]/) { 
-		    $config->{ $x } = strftime($config->{ $x }, localtime);
-		}
-	    }    
-	}
-    }
-}
+=head2 C<has_attribute( key )>
 
+=cut
 
 sub yes
 {
@@ -329,16 +311,83 @@ sub has_attribute
 }
 
 
+=head2  C<dump_variables()>
+
+show all {key => value} for debug.
+
+=cut
+
+sub dump_variables
+{
+    my ($self, $args) = @_;
+    my ($k, $v);
+    my $len  = 0;
+    my $mode = $args->{ mode } || 'all';
+
+    $self->expand_variables();
+
+    for $k (keys %_fml_config) { $len = $len > length($k) ? $len : length($k);}
+
+    my $format = '%-'. $len. 's = %s'. "\n";
+    for $k (sort keys %_fml_config) {
+	next unless $k =~ /^[a-z0-9]/io;
+	$v = $_fml_config{ $k };
+
+	# print out all keys
+	if ($mode eq 'all') {
+	    printf $format, $k, $v;
+	}
+	# compare the value with the default one
+	# print key if values for the key differs.
+	else {
+	    if (defined $_default_fml_config{ $k }) {
+		if ($v ne $_default_fml_config{ $k }) {
+		    printf $format, $k, $v;
+		}
+	    }
+	    else {
+		printf $format, $k, $v;
+	    }
+	}
+    }
+}
+
+
+
+=head1 TIEED HASH
+
+=cut
+
+sub TIEHASH
+{
+    my ($self, $args) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = \%_fml_config;
+    return bless $me, $type;
+}
+
+
 sub FETCH
 {
     my ($self, $key) = @_;
-    return $_fml_config{$key};
+
+    if ($need_expantion_variables) {
+	$self->expand_variables();
+	$need_expantion_variables = 0;
+    }
+
+    defined($_fml_config_result{$key}) ? $_fml_config_result{$key} : undef;
 }
 
 
 sub STORE
 {
     my ($self, $key, $value) = @_;
+
+    # inform fml we need to expand variable again when FETCH() is
+    # called.
+    if ($value =~ /\$/) { $need_expantion_variables = 1;}
+
     $_fml_config{$key} = $value;
 }
 
@@ -346,6 +395,8 @@ sub STORE
 sub DELETE
 {
     my ($self, $key) = @_;
+
+    delete $_fml_config_result{$key};
     delete $_fml_config{$key};
 }
 
@@ -353,9 +404,10 @@ sub DELETE
 sub CLEAR
 {
     my ($self) = @_;
+
+    undef %_fml_config_result;
     undef %_fml_config;
 }
 
 
-
 1;