/[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 687 by dpavlin, Sun Sep 24 17:49:05 2006 UTC revision 690 by dpavlin, Sun Sep 24 19:00:56 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.01  Version 0.02
21    
22  =cut  =cut
23    
24  our $VERSION = '0.01';  our $VERSION = '0.02';
25    
26  =head1 SYNOPSIS  =head1 SYNOPSIS
27    
# Line 54  sub new { Line 54  sub new {
54          my $source;          my $source;
55    
56          $self->{config}->iterate_inputs( sub {          $self->{config}->iterate_inputs( sub {
57                  my $input = shift;                  my ($input, $database) = @_;
58                  my $path = $input->{normalize}->{path} || return;                  my $path = $input->{normalize}->{path} || return;
59                  my $full = $self->{base_path} ? $self->{base_path} . '/' . $path : $path;                  my $full = $self->{base_path} ? $self->{base_path} . '/' . $path : $path;
60                  $log->logdie("normalization input $full doesn't exist") unless (-e $full);                  $log->logdie("normalization input $full doesn't exist") unless (-e $full);
61                  my $s = read_file( $full ) || $log->logdie("can't read $full: $!");                  my $s = read_file( $full ) || $log->logdie("can't read $full: $!");
62                  $log->debug("adding $path to parser [",length($s)," bytes]");                  my $input_name = $input->{name} || $log->logdie("can't deduce name of input: ", dump( $input ));
63                    $log->debug("$database/$input_name: adding $path to parser [",length($s)," bytes]");
64                  $source .= $s;                  $source .= $s;
65                    $self->{valid_inputs}->{$database}->{$input_name}++;
66          } );          } );
67    
68          $log->debug("collected ", length($source), " bytes of source");          $log->debug("collected ", length($source), " bytes of source");
# Line 81  sub parse { Line 83  sub parse {
83    
84          $log->logdie('no source found in object') unless ($self->{source});          $log->logdie('no source found in object') unless ($self->{source});
85    
86            $log->debug("valid_inputs = ", dump( $self->{valid_inputs} ));
87    
88          my $Document = PPI::Document->new( \$self->{source} ) || $log->logdie("can't parse source:\n", $self->{source});          my $Document = PPI::Document->new( \$self->{source} ) || $log->logdie("can't parse source:\n", $self->{source});
89    
90          $Document->prune('PPI::Token::Whitespace');          $Document->prune('PPI::Token::Whitespace');
# Line 89  sub parse { Line 93  sub parse {
93          # Find all the named subroutines          # Find all the named subroutines
94    
95          my $eval_create;          my $eval_create;
96            my @errors;
97    
98            sub error {
99                    my $msg = shift || $log->logconfess("error without message?");
100                    push @errors, $msg;
101                    return '';
102            }
103    
104          $Document->find( sub {          $Document->find( sub {
105                          my ($Document,$Element) = @_;                          my ($Document,$Element) = @_;
# Line 150  sub parse { Line 161  sub parse {
161    
162                          $log->debug("create: $create");                          $log->debug("create: $create");
163    
164                          $create =~ s/\s+/ /gs;                          return error("invalid database $e[3]" ) unless $self->valid_database( $e[3] );
165                            return error("invalid input $e[5] of database $e[3]", ) unless $self->valid_database_input( $e[3], $e[5] );
166    
167                          $eval_create->{ $e[3] }->{ $e[5] } .= $create;                          $eval_create->{ $e[3] }->{ $e[5] } .= $create;
168    
169                          if ($#e < 10) {                          if ($#e < 10) {
# Line 175  sub parse { Line 188  sub parse {
188                  $Dumper->print;                  $Dumper->print;
189          }          }
190    
191            $log->error("Parser errors: ", join("\n",@errors) ) if (@errors);
192    
193          return 1;          return 1;
194  }  }
195    
196    =head2 valid_database
197    
198      my $ok = $parse->valid_database('key');
199    
200    =cut
201    
202    sub valid_database {
203            my $self = shift;
204    
205            my $database = shift || return;
206            $database =~ s/['"]//g;
207    
208            return defined($self->{valid_inputs}->{$database});
209    }
210    
211    =head2 valid_database_input
212    
213      my $ok = $parse->valid_database('database_key','input_name');
214    
215    =cut
216    
217    sub valid_database_input {
218            my $self = shift;
219    
220            my ($database,$input) = @_;
221            $database =~ s/['"]//g;
222            $input =~ s/['"]//g;
223    
224            return defined($self->{valid_inputs}->{$database}->{$input});
225    }
226    
227  =head1 AUTHOR  =head1 AUTHOR
228    
229  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.687  
changed lines
  Added in v.690
  ViewVC Help
Powered by ViewVC 1.1.26