--- trunk/lib/WebPAC/Lookup.pm	2005/07/17 10:42:23	15
+++ trunk/lib/WebPAC/Lookup.pm	2006/02/15 14:49:48	393
@@ -3,10 +3,9 @@
 use warnings;
 use strict;
 
-use WebPAC::Common;
-
 use base qw/WebPAC::Common WebPAC::Normalize/;
 use File::Slurp;
+use YAML qw/LoadFile/;
 use Data::Dumper;
 
 =head1 NAME
@@ -15,11 +14,11 @@
 
 =head1 VERSION
 
-Version 0.01
+Version 0.02
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 =head1 SYNOPSIS
 
@@ -42,6 +41,8 @@
     'val' => 'v900' },
  ];
 
+Just for a reference, lookup data is internally stored in
+C<< $self->{'_lookup_data'} >>.
 
 =head1 FUNCTIONS
 
@@ -58,8 +59,8 @@
 =cut
 
 sub new {
-        my $class = shift;
-        my $self = {@_};
+	my $class = shift;
+	my $self = {@_};
 	bless($self, $class);
 
 	my $log = $self->_get_logger();
@@ -68,13 +69,19 @@
 
 	my $lookup_code = read_file($lookup_file) || $log->logconfess("can't read lookup file $lookup_file: $!");
 
-	{
+	if ($lookup_file =~ m#\.pm$#) {
 		no strict 'vars';
 		do $lookup_file or $log->logdie("Failed to read configuration parameters '$lookup_file' $! $@");
 		$self->{'lookup_def'} = \@lookup || $log->logdie("lookup config $lookup_file doesn't produce \@lookup array");
+	} elsif ($lookup_file =~ m#\.(:?yml|yaml)$#) {
+		my $yaml = LoadFile( $lookup_file ) || $log->logdie("lookup YAML file $lookup_file error: $!");
+		$self->{'lookup_def'} = $yaml->{lookup} || $log->logdie("lookup YAML file $lookup_file should begin with 'lookup:'");
+	} else {
+		$log->logide("unsupported lookup file $lookup_file");
 	}
+	$log->debug("lookup_def: " . Dumper( $self->{lookup_def} ));
 
-	$log->logconfess("lookup config file isn't ARRAY", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
+	$log->logconfess("lookup config file isn't ARRAY but ", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
 
 	$self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';
         $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
@@ -83,7 +90,7 @@
 	$self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;
 	$self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;
 
-	$log->debug("regexps: ", $self->{'LOOKUP_REGEX'}, " ", $self->{'LOOKUP_REGEX_SAVE'});
+	$log->debug("regexps lookup:", $self->{'LOOKUP_REGEX'}, " save:", $self->{'LOOKUP_REGEX_SAVE'});
 
 	$self ? return $self : return undef;
 }
@@ -98,7 +105,7 @@
 
 =cut
 
-sub add($) {
+sub add {
 	my $self = shift;
 
 	my $log = $self->_get_logger();
@@ -110,8 +117,8 @@
 	my $n = 0;
 
 	foreach my $i (@{ $self->{'lookup_def'} }) {
-		$log->logconfess("need key") unless defined($i->{'key'});
-		$log->logconfess("need val") unless defined($i->{'val'});
+		$log->logconfess("need key in ", Dumper($i) ) unless defined($i->{'key'});
+		$log->logconfess("need val in ", Dumper($i) ) unless defined($i->{'val'});
 
 		$n++;
 
@@ -122,13 +129,13 @@
 				my $key = $self->fill_in($rec,$i->{'key'}) || next;
 				my @val = $self->fill_in($rec,$i->{'val'}) || next;
 				$log->debug("stored $key = ",sub { join(" | ",@val) });
-				push @{$self->{'lookup'}->{$key}}, @val;
+				push @{$self->{'_lookup_data'}->{$key}}, @val;
 			}
 		} else {
 			my $key = $self->fill_in($rec,$i->{'key'}) || next;
 			my @val = $self->fill_in($rec,$i->{'val'}) || next;
 			$log->debug("stored $key = ",sub { join(" | ",@val) });
-			push @{$self->{'lookup'}->{$key}}, @val;
+			push @{$self->{'_lookup_data'}->{$key}}, @val;
 		}
 	}
 
@@ -139,9 +146,9 @@
 
 Perform lookups on format supplied to it.
 
- my $text = $lookup->lookup('[v900]');
+ my $text = $lookup->lookup('lookup{v900}');
 
-Lookups can be nested (like C<[d:[a:[v900]]]>).
+Lookups can be nested (like lookup{B<d:>lookup{B<a:>lookup{B<v900>}}}).
 
 =cut
 
@@ -155,14 +162,12 @@
 	if ($tmp =~ $self->{'LOOKUP_REGEX'}) {
 		my @in = ( $tmp );
 
-		$log->debug("lookup for: ",$tmp);
-
 		my @out;
 		while (my $f = shift @in) {
 			if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {
 				my $k = $1;
-				if ($self->{'lookup'}->{$k}) {
-					foreach my $nv (@{$self->{'lookup'}->{$k}}) {
+				if ($self->{'_lookup_data'}->{$k}) {
+					foreach my $nv (@{$self->{'_lookup_data'}->{$k}}) {
 						my $tmp2 = $f;
 						$tmp2 =~ s/lookup{$k}/$nv/g;
 						push @in, $tmp2;
@@ -174,7 +179,10 @@
 				push @out, $f;
 			}
 		}
+		$log->debug("lookup for: ",$tmp, " returned: ", join(", ",@out));
+
 		$log->logconfess("return is array and it's not expected!") unless wantarray;
+
 		return @out;
 	} else {
 		return $tmp;