--- trunk/lib/WebPAC/Lookup.pm	2005/07/16 12:37:18	4
+++ trunk/lib/WebPAC/Lookup.pm	2005/12/15 14:12:00	251
@@ -3,10 +3,9 @@
 use warnings;
 use strict;
 
-use WebPAC::Common;
-
-use base qw/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
 
@@ -51,6 +52,8 @@
 
   my $lookup = new WebPAC::Lookup(
   	lookup_file => '/path/to/conf/lookup/lookup.pm',
+	is_lookup_regex => 'lookup{[^\{\}]+}';
+	save_lookup_regex => 'lookup{([^\{\}]+)}';
   );
 
 =cut
@@ -66,13 +69,28 @@
 
 	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 but ", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
+
+	$self->{'is_lookup_regex'} ||= 'lookup{\[[^\{\}]+\]}';
+        $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
+
 
-	$log->logconfess("lookup config file isn't ARRAY", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
+	$self->{'LOOKUP_REGEX'} = qr/$self->{'is_lookup_regex'}/;
+	$self->{'LOOKUP_REGEX_SAVE'} = qr/$self->{'save_lookup_regex'}/;
+
+	$log->debug("regexps lookup:", $self->{'LOOKUP_REGEX'}, " save:", $self->{'LOOKUP_REGEX_SAVE'});
 
 	$self ? return $self : return undef;
 }
@@ -81,13 +99,13 @@
 
 Create lookup from record using lookup definition.
 
- $self->create_lookup($rec);
+ $self->add($rec);
 
 Returns true if this record produced lookup.
 
 =cut
 
-sub add($) {
+sub add {
 	my $self = shift;
 
 	my $log = $self->_get_logger();
@@ -99,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++;
 
@@ -111,19 +129,79 @@
 				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;
 		}
 	}
 
 	return $n;
 }
 
+=head2 lookup
+
+Perform lookups on format supplied to it.
+
+ my $text = $lookup->lookup('[v900]');
+
+Lookups can be nested (like C<[d:[a:[v900]]]>).
+
+=cut
+
+sub lookup {
+	my $self = shift;
+
+	my $log = $self->_get_logger();
+
+	my $tmp = shift || $log->logconfess("need format");
+
+	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_data'}->{$k}) {
+					foreach my $nv (@{$self->{'_lookup_data'}->{$k}}) {
+						my $tmp2 = $f;
+						$tmp2 =~ s/lookup{$k}/$nv/g;
+						push @in, $tmp2;
+					}
+				} else {
+					undef $f;
+				}
+			} elsif ($f) {
+				push @out, $f;
+			}
+		}
+		$log->logconfess("return is array and it's not expected!") unless wantarray;
+		return @out;
+	} else {
+		return $tmp;
+	}
+}
+
+=head2 regex
+
+Returns precompiled regex for lookup format.
+
+ if ($foo =~ $lookup->reges) { ... }
+
+=cut
+
+sub regex {
+	my $self = shift;
+
+	return $self->{'LOOKUP_REGEX'};
+}
+
 =head1 AUTHOR
 
 Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>