--- trunk/lib/WebPAC/Lookup.pm 2005/07/24 14:20:59 30 +++ trunk/lib/WebPAC/Lookup.pm 2005/12/27 22:26:43 330 @@ -5,6 +5,7 @@ use base qw/WebPAC::Common WebPAC::Normalize/; use File::Slurp; +use YAML qw/LoadFile/; use Data::Dumper; =head1 NAME @@ -13,11 +14,11 @@ =head1 VERSION -Version 0.01 +Version 0.02 =cut -our $VERSION = '0.01'; +our $VERSION = '0.02'; =head1 SYNOPSIS @@ -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++; @@ -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{Blookup{Blookup{B}}}). =cut @@ -155,8 +162,6 @@ 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'}) { @@ -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;