/[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 689 by dpavlin, Sun Sep 24 18:52:35 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 150  sub parse { Line 154  sub parse {
154    
155                          $log->debug("create: $create");                          $log->debug("create: $create");
156    
157                          $create =~ s/\s+/ /gs;                          $log->logdie("invalid database $e[3]" ) unless $self->valid_database( $e[3] );
158                            $log->logdie("invalid input $e[5] of database $e[3]", ) unless $self->valid_database_input( $e[3], $e[5] );
159    
160                          $eval_create->{ $e[3] }->{ $e[5] } .= $create;                          $eval_create->{ $e[3] }->{ $e[5] } .= $create;
161    
162                          if ($#e < 10) {                          if ($#e < 10) {
# Line 178  sub parse { Line 184  sub parse {
184          return 1;          return 1;
185  }  }
186    
187    =head2 valid_database
188    
189      my $ok = $parse->valid_database('key');
190    
191    =cut
192    
193    sub valid_database {
194            my $self = shift;
195    
196            my $database = shift || return;
197            $database =~ s/['"]//g;
198    
199            return defined($self->{valid_inputs}->{$database});
200    }
201    
202    =head2 valid_database_input
203    
204      my $ok = $parse->valid_database('database_key','input_name');
205    
206    =cut
207    
208    sub valid_database_input {
209            my $self = shift;
210    
211            my ($database,$input) = @_;
212            $database =~ s/['"]//g;
213            $input =~ s/['"]//g;
214    
215            return defined($self->{valid_inputs}->{$database}->{$input});
216    }
217    
218  =head1 AUTHOR  =head1 AUTHOR
219    
220  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.687  
changed lines
  Added in v.689
  ViewVC Help
Powered by ViewVC 1.1.26