/[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 737 by dpavlin, Thu Oct 5 14:38:45 2006 UTC revision 1061 by dpavlin, Tue Nov 20 22:07:45 2007 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.07  Version 0.08
21    
22  =cut  =cut
23    
24  our $VERSION = '0.07';  our $VERSION = '0.08';
25    
26  =head1 SYNOPSIS  =head1 SYNOPSIS
27    
# Line 49  Create new parser object. Line 49  Create new parser object.
49    my $parser = new WebPAC::Parser(    my $parser = new WebPAC::Parser(
50          config => new WebPAC::Config(),          config => new WebPAC::Config(),
51          base_path => '/optional/path/to/conf',          base_path => '/optional/path/to/conf',
52            only_database => $only
53    );    );
54    
55  =cut  =cut
# Line 169  sub normalize_rules { Line 170  sub normalize_rules {
170  }  }
171    
172    
173  =head2 generate_marc  =head2 have_rules
174    
175    my $do_marc = $parser->generate_marc($database, $input);    my $do_marc = $parser->have_rules('marc', $database, $input);
176      my $do_index = $parser->have_rules('search', $database);
177    
178  This function will return hash containing count of all found C<marc_*> directives.  This function will return hash containing count of all found C<marc_*> or
179    C<search> directives. Input name is optional.
180    
181  =cut  =cut
182    
183  sub generate_marc {  sub have_rules {
184          my $self = shift;          my $self = shift;
185          my ($database,$input) = @_;  
186            my $log = $self->_get_logger();
187            my $type = shift @_ || $log->logconfess("need at least type");
188            my $database = shift @_ || $log->logconfess("database is required");
189            my $input = shift @_;
190    
191          $input = _input_name($input);          $input = _input_name($input);
192          return unless (  
193                  defined( $self->{_generate_marc}->{ _q($database) } ) &&  
194                  defined( $self->{_generate_marc}->{ _q($database) }->{ _q($input) } )          return unless defined( $self->{_have_rules}->{ _q($database) } );
195          );  
196          return $self->{_generate_marc}->{ _q($database) }->{ _q($input) };          my $database_rules = $self->{_have_rules}->{ _q($database ) };
197    
198            if (defined($input)) {
199    
200                    return unless (
201                            defined( $database_rules->{ _q($input) } ) &&
202                            defined( $database_rules->{ _q($input) }->{ $type } )
203                    );
204    
205                    return $database_rules->{ _q($input) }->{ $type };
206            }
207    
208            my $usage;
209    
210            foreach my $i (keys %{ $database_rules }) {
211                    next unless defined( $database_rules->{$i}->{$type} );
212    
213                    foreach my $t (keys %{ $database_rules->{ $i }->{$type} }) {
214                            $usage->{ $t } += $database_rules->{ $i }->{ $t };
215                    }
216            }
217    
218            return $usage;
219    
220  }  }
221    
222    
# Line 208  sub _read_sources { Line 239  sub _read_sources {
239    
240          my @sources;          my @sources;
241    
242            my $lookup_src_cache;
243    
244            my $only_database = $self->{only_database};
245            my $only_input = $self->{only_input};
246    
247          $self->{config}->iterate_inputs( sub {          $self->{config}->iterate_inputs( sub {
248                  my ($input, $database) = @_;                  my ($input, $database) = @_;
249    
250                    return if ( $only_database && $database !~ m/$only_database/i );
251                    return if ( $only_input && $input->{name} !~ m/$only_input/i );
252    
253                  $log->debug("database: $database input = ", dump($input));                  $log->debug("database: $database input = ", dump($input));
254    
255                  foreach my $normalize (@{ $input->{normalize} }) {                  foreach my $normalize (@{ $input->{normalize} }) {
# Line 230  sub _read_sources { Line 269  sub _read_sources {
269                          $self->{valid_inputs}->{$database}->{$input_name}++;                          $self->{valid_inputs}->{$database}->{$input_name}++;
270    
271                          push @sources, sub {                          push @sources, sub {
272                                    #warn "### $database $input_name, $full ###\n";
273                                  $self->_parse_source( $database, $input_name, $full, $s );                                  $self->_parse_source( $database, $input_name, $full, $s );
274                          };                          };
275    
# Line 292  sub _parse_source { Line 332  sub _parse_source {
332                          my ($Document,$Element) = @_;                          my ($Document,$Element) = @_;
333    
334                          $Element->isa('PPI::Token::Word') or return '';                          $Element->isa('PPI::Token::Word') or return '';
335    
336                            if ( $Element->content eq 'sub' ) {
337                                    # repair demage done by prune of whitespace
338                                    $Element->insert_after( PPI::Token::Whitespace->new(' ') );
339                                    return '';
340                            }
341    
342                          $Element->content eq 'lookup' or return '';                          $Element->content eq 'lookup' or return '';
343    
344                          $log->debug("expansion: ", $Element->snext_sibling);                          $log->debug("expansion: ", $Element->snext_sibling);
# Line 366  sub _parse_source { Line 413  sub _parse_source {
413                          }                          }
414    
415                          $e[7]->remove;                          $e[7]->remove;
416                          $e[8]->insert_before( new PPI::Token::Quote::Single( "'$key'" ) );                          $e[8]->insert_before( PPI::Token::Quote::Single->new( "'$key'" ) );
417                          $e[8]->remove;                          $e[8]->remove;
418    
419    
# Line 390  sub _parse_source { Line 437  sub _parse_source {
437                          my ($Document,$Element) = @_;                          my ($Document,$Element) = @_;
438    
439                          $Element->isa('PPI::Token::Word') or return '';                          $Element->isa('PPI::Token::Word') or return '';
440                          $Element->content =~ m/^marc/ or return '';                          if ($Element->content =~ m/^(marc|search)/) {
441                                    my $what = $1;
442                          $log->debug("found marc output generation for $database/$input");                                  $log->debug("found $what rules in $database/$input");
443                          $self->{_generate_marc}->{ $database }->{ $input }->{ $Element->content }++;                                  $self->{_have_rules}->{ $database }->{ $input }->{ $what }->{ $Element->content }++;
444                            } else {
445                                    return '';
446                            }
447          });          });
448    
449          return 1;          return 1;
Legend:
Removed from v.737  
changed lines
  Added in v.1061
  ViewVC Help
Powered by ViewVC 1.1.26