/[webpac2]/trunk/lib/WebPAC/Parser.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Parser.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 698 by dpavlin, Mon Sep 25 11:14:53 2006 UTC revision 703 by dpavlin, Mon Sep 25 13:24:09 2006 UTC
# Line 17  WebPAC::Parser - parse perl normalizatio Line 17  WebPAC::Parser - parse perl normalizatio
17    
18  =head1 VERSION  =head1 VERSION
19    
20  Version 0.04  Version 0.05
21    
22  =cut  =cut
23    
24  our $VERSION = '0.04';  our $VERSION = '0.05';
25    
26  =head1 SYNOPSIS  =head1 SYNOPSIS
27    
# Line 61  sub new { Line 61  sub new {
61    
62          $log->logdie("can't iterate_inputs over this config object") unless ($self->{config}->can('iterate_inputs'));          $log->logdie("can't iterate_inputs over this config object") unless ($self->{config}->can('iterate_inputs'));
63    
64          $self->read_sources;          $self->_read_sources;
   
         $self->{config}->iterate_inputs( sub {  
                 my ($input, $database) = @_;  
                 return unless $self->valid_database_input($database, _input_name($input));  
                 $self->parse_lookups($database, _input_name($input));  
         } );  
65    
66          $self ? return $self : return undef;          $self ? return $self : return undef;
67  }  }
68    
69  =head2 read_sources  =head2 lookup_create_rules
70    
71    my $source_files = $parser->read_sources;    my $source = $parser->lookup_create_rules($database, $input);
72    
73  Called by L</new>.  =cut
74    
75    sub lookup_create_rules {
76            my $self = shift;
77            my ($database,$input) = @_;
78            return $self->{_lookup_create}->{ _q($database) }->{ _q($input) };
79    }
80    
81    =head2 valid_database
82    
83      my $ok = $parse->valid_database('key');
84    
85  =cut  =cut
86    
87  sub _input_name($);  sub valid_database {
88            my $self = shift;
89    
90            my $database = shift || return;
91    
92            return defined($self->{valid_inputs}->{ _q($database) });
93    }
94    
95    =head2 valid_database_input
96    
97      my $ok = $parse->valid_database('database_key','input_name');
98    
99    =cut
100    
101    sub valid_database_input {
102            my $self = shift;
103    
104            my ($database,$input) = @_;
105            return defined($self->{valid_inputs}->{ _q($database) }->{ _q($input) });
106    }
107    
108    =head2 depends
109    
110    Return all databases and inputs on which specified one depends
111    
112      $depends_on = $parser->depends('database','input');
113    
114    =cut
115    
116    sub depends {
117            my $self = shift;
118            my ($database,$input) = @_;
119            $self->_get_logger->debug("depends($database,$input)");
120            return unless (
121                    defined( $self->{depends}->{ _q($database) } ) &&
122                    defined( $self->{depends}->{ _q($database) }->{ _q($input) } )
123            );
124            return $self->{depends}->{ _q($database) }->{ _q($input) };
125    }
126    
127    =head1 PRIVATE
128    
129    =head2 _read_sources
130    
131      my $source_files = $parser->_read_sources;
132    
133    Called by L</new>.
134    
135    =cut
136    
137  sub read_sources {  sub _read_sources {
138          my $self = shift;          my $self = shift;
139    
140          my $log = $self->_get_logger();          my $log = $self->_get_logger();
141    
142          my $nr = 0;          my $nr = 0;
143    
144            my @lookups;
145    
146          $self->{config}->iterate_inputs( sub {          $self->{config}->iterate_inputs( sub {
147                  my ($input, $database) = @_;                  my ($input, $database) = @_;
148    
149                  my @normalize;                  $log->debug("database: $database input = ", dump($input));
   
                 if (ref($input->{normalize}) eq 'ARRAY') {  
                         @normalize = @{ $input->{normalize} };  
                 } else {  
                         @normalize = ( $input->{normalize} );  
                 }  
150    
151                  foreach my $normalize (@normalize) {                  foreach my $normalize (@{ $input->{normalize} }) {
152    
153                          my $path = $normalize->{path};                          my $path = $normalize->{path};
154                          return unless($path);                          return unless($path);
# Line 114  sub read_sources { Line 162  sub read_sources {
162    
163                          $log->debug("$database/$input_name: adding $path");                          $log->debug("$database/$input_name: adding $path");
164    
165                          $self->{valid_inputs}->{$database}->{$input_name} = {                          $self->{valid_inputs}->{$database}->{$input_name}++;
                                 source => $s,  
                                 path => $full,  
                                 usage => 0,  
                         } unless defined($self->{valid_inputs}->{$database}->{$input_name});  
166    
167                          $self->{valid_inputs}->{$database}->{$input_name}->{usage}++;                          push @lookups, sub {
168                                    $self->_parse_lookups( $database, $input_name, $full, $s );
169                            };
170    
171                          $nr++;                          $nr++;
172                  }                  }
# Line 128  sub read_sources { Line 174  sub read_sources {
174    
175          $log->debug("found $nr source files");          $log->debug("found $nr source files");
176    
177            # parse all lookups
178            $_->() foreach (@lookups);
179    
180          return $nr;          return $nr;
181  }  }
182    
183  =head2 parse_lookups  =head2 _parse_lookups
184    
185    $parser->parse_lookups($database,$input);    $parser->_parse_lookups($database,$input,$path,$source);
186    
187  Called for each input by L</new>  Called for each normalize source (rules) in each input by L</read_sources>
188    
189  It will report invalid databases and inputs in error log after parsing.  It will report invalid databases and inputs in error log after parsing.
190    
191  =cut  =cut
192    
193  sub parse_lookups {  sub _parse_lookups {
194          my $self = shift;          my $self = shift;
195          my ($database, $input) = @_;          my ($database, $input, $path, $source) = @_;
196    
197          $input = _input_name($input);          $input = _input_name($input);
198    
# Line 152  sub parse_lookups { Line 201  sub parse_lookups {
201          $log->logdie("invalid database $database" ) unless $self->valid_database( $database );          $log->logdie("invalid database $database" ) unless $self->valid_database( $database );
202          $log->logdie("invalid input $input of database $database", ) unless $self->valid_database_input( $database, $input );          $log->logdie("invalid input $input of database $database", ) unless $self->valid_database_input( $database, $input );
203    
         my $source = $self->{valid_inputs}->{$database}->{$input}->{source};  
         my $path = $self->{valid_inputs}->{$database}->{$input}->{path};  
   
204          $log->logdie("no source found for database $database input $input path $path") unless ($source);          $log->logdie("no source found for database $database input $input path $path") unless ($source);
205    
206          $log->info("parsing lookups for $database/$input from $path");          $log->info("parsing lookups for $database/$input from $path (",length($source)," bytes)");
207    
208          my $Document = PPI::Document->new( \$source ) || $log->logdie("can't parse source:\n", $self->{source});          my $Document = PPI::Document->new( \$source ) || $log->logdie("can't parse source:\n", $self->{source});
209    
# Line 243  sub parse_lookups { Line 289  sub parse_lookups {
289                          $self->{_lookup_create}->{ _q($e[3]) }->{ _q($e[5]) }->{ _q($key) } .= $create;                          $self->{_lookup_create}->{ _q($e[3]) }->{ _q($e[5]) }->{ _q($key) } .= $create;
290    
291    
292                          if (defined( $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) } )) {                          if (defined( $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) }->{ $key } )) {
293                                  my $dep_key = $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) };                                  $log->warn("dependency of $database/$input on $e[3]/$e[5] with $key allready recorded");
                                 $log->warn("dependency of $database/$input on $e[3]/$e[5] allready recorded as $dep_key, now changed to $key") if ($dep_key ne $key);  
294                          }                          }
295    
296                          # save this dependency                          # save this dependency
297                          $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) } .= $key;                          $self->{depends}->{ $database }->{ $input }->{ _q($e[3]) }->{ _q($e[5]) }->{$key}++;
298    
299                          if ($#e < 10) {                          if ($#e < 10) {
300                                  $e[8]->insert_after( $e[8]->clone );                                  $e[8]->insert_after( $e[8]->clone );
# Line 282  sub parse_lookups { Line 327  sub parse_lookups {
327  }  }
328    
329    
 =head2 lookup_create_rules  
   
   my $source = $parser->lookup_create_rules($database, $input);  
   
 =cut  
   
 sub lookup_create_rules {  
         my $self = shift;  
         my ($database,$input) = @_;  
         return $self->{_lookup_create}->{ _q($database) }->{ _q($input) };  
 }  
   
 =head2 valid_database  
   
   my $ok = $parse->valid_database('key');  
   
 =cut  
   
 sub valid_database {  
         my $self = shift;  
   
         my $database = shift || return;  
   
         return defined($self->{valid_inputs}->{ _q($database) });  
 }  
   
 =head2 valid_database_input  
   
   my $ok = $parse->valid_database('database_key','input_name');  
   
 =cut  
   
 sub valid_database_input {  
         my $self = shift;  
   
         my ($database,$input) = @_;  
         return defined($self->{valid_inputs}->{ _q($database) }->{ _q($input) });  
 }  
   
 =head2 depends  
   
 Return all databases and inputs on which specified one depends  
   
   $depends_on = $parser->depends('database','input');  
   
 =cut  
   
 sub depends {  
         my $self = shift;  
         my ($database,$input) = @_;  
         $self->_get_logger->debug("depends($database,$input)");  
         return unless defined( $self->{depends}->{ _q($database) }->{ _q($input) } );  
         return $self->{depends}->{ _q($database) }->{ _q($input) };  
 }  
   
 =head1 PRIVATE  
   
330  =head2 _q  =head2 _q
331    
332  Strip single or double quotes around value  Strip single or double quotes around value
Legend:
Removed from v.698  
changed lines
  Added in v.703
  ViewVC Help
Powered by ViewVC 1.1.26