improvements to WebPAC::Normalize::XML

[webpac2] / lib / WebPAC / Lookup.pm

diff --git a/lib/WebPAC/Lookup.pm b/lib/WebPAC/Lookup.pm
index b74760d..02d73d7 100644 (file)
--- a/lib/WebPAC/Lookup.pm
+++ b/lib/WebPAC/Lookup.pm
@@ -9,9 +9,6 @@ use base qw/WebPAC::Common/;
 use File::Slurp;
 use Data::Dumper;
 
-my $LOOKUP_REGEX = 'lookup{[^\{\}]+}';
-my $LOOKUP_REGEX_SAVE = 'lookup{([^\{\}]+)}';
-
 =head1 NAME
 
 WebPAC::Lookup - simple normalisation plugin to produce lookup
@@ -54,6 +51,8 @@ Create new lookup object.
 
   my $lookup = new WebPAC::Lookup(
        lookup_file => '/path/to/conf/lookup/lookup.pm',
+       is_lookup_regex => 'lookup{[^\{\}]+}';
+       save_lookup_regex => 'lookup{([^\{\}]+)}';
   );
 
 =cut
@@ -77,6 +76,15 @@ sub new {
 
        $log->logconfess("lookup config file isn't ARRAY", sub { Dumper( $self->{'lookup_def'} ) }) if ($self->{'lookup_def'} !~ /ARRAY/o);
 
+       $self->{'is_lookup_regex'} ||= 'lookup{[^\{\}]+}';
+        $self->{'save_lookup_regex'} ||= 'lookup{([^\{\}]+)}';
+
+
+       $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'});
+
        $self ? return $self : return undef;
 }
 
@@ -144,14 +152,14 @@ sub lookup {
 
        my $tmp = shift || $log->logconfess("need format");
 
-       if ($tmp =~ /$LOOKUP_REGEX/o) {
+       if ($tmp =~ $self->{'LOOKUP_REGEX'}) {
                my @in = ( $tmp );
 
                $log->debug("lookup for: ",$tmp);
 
                my @out;
                while (my $f = shift @in) {
-                       if ($f =~ /$LOOKUP_REGEX_SAVE/o) {
+                       if ($f =~ $self->{'LOOKUP_REGEX_SAVE'}) {
                                my $k = $1;
                                if ($self->{'lookup'}->{$k}) {
                                        foreach my $nv (@{$self->{'lookup'}->{$k}}) {
@@ -173,6 +181,20 @@ sub lookup {
        }
 }
 
+=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> >>