--- trunk/lib/WebPAC/Lookup.pm 2005/07/16 22:57:26 12 +++ trunk/lib/WebPAC/Lookup.pm 2006/05/13 12:07:56 473 @@ -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.03 =cut -our $VERSION = '0.01'; +our $VERSION = '0.03'; =head1 SYNOPSIS @@ -42,7 +41,6 @@ 'val' => 'v900' }, ]; - =head1 FUNCTIONS =head2 new @@ -58,8 +56,8 @@ =cut sub new { - my $class = shift; - my $self = {@_}; + my $class = shift; + my $self = {@_}; bless($self, $class); my $log = $self->_get_logger(); @@ -68,13 +66,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 +87,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 +102,7 @@ =cut -sub add($) { +sub add { my $self = shift; my $log = $self->_get_logger(); @@ -110,8 +114,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 +126,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 +143,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{Blookup{Blookup{B}}}). =cut @@ -155,14 +159,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,13 +176,29 @@ 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; } } +=head2 lookup_hash + +Returns hash representation of lookup data + + my $l_hash = $lookup->lookup_hash; + +=cut + +sub lookup_hash { + my $self = shift; + return $self->{_lookup_data}; +} + =head2 regex Returns precompiled regex for lookup format.