/[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 686 by dpavlin, Sun Sep 24 17:25:04 2006 UTC revision 687 by dpavlin, Sun Sep 24 17:49:05 2006 UTC
# Line 96  sub parse { Line 96  sub parse {
96                          $Element->isa('PPI::Token::Word') or return '';                          $Element->isa('PPI::Token::Word') or return '';
97                          $Element->content eq 'lookup' or return '';                          $Element->content eq 'lookup' or return '';
98    
99                          print "#*** expansion: ", $Element->snext_sibling,$/;                          $log->debug("expansion: ", $Element->snext_sibling);
100    
101                          my $args = $Element->snext_sibling;                          my $args = $Element->snext_sibling;
102                                    
103                          my @e = $args->child(0)->elements;                          my @e = $args->child(0)->elements;
104                          print "hum, expect at least 8 elements, got ", scalar @e, " in $args\n" if ($#e < 8);                          $log->logdie("hum, expect at least 8 elements, got ", scalar @e, " in $args") if ($#e < 8);
105    
106                          print "# found ", scalar @e, " elements:\n";                          if ($log->is_debug) {
107                                    my $report = "found " . scalar @e . " elements:\n";
108    
109                          foreach my $i ( 0 .. $#e ) {                                  foreach my $i ( 0 .. $#e ) {
110                                  printf("# %-2d: %-30s %s\n", $i, ( $e[$i] || 'undef' ), $e[$i]->class );                                          $report .= sprintf("# %-2d: %-30s %s\n", $i, ( $e[$i] || 'undef' ), $e[$i]->class );
111                                    }
112    
113                                    $log->debug($report);
114                          }                          }
115    
116                          my $key_element = $e[8]->clone;                          my $key_element = $e[8]->clone;
117    
118                          die "key element must be PPI::Structure::Block" unless $key_element->isa('PPI::Structure::Block');                          $log->logdie("key element must be PPI::Structure::Block") unless $key_element->isa('PPI::Structure::Block');
119    
120                          print "## key part: ", $key_element, $/;                          $log->debug("key part: ", $key_element);
121    
122                          my @key;                          my @key;
123    
# Line 124  sub parse { Line 128  sub parse {
128    
129                                  my $kf = $e->snext_sibling;                                  my $kf = $e->snext_sibling;
130    
131                                  print "## key fragment = $kf\n";                                  $log->debug("key fragment = $kf");
132    
133                                  push @key, eval $kf;                                  push @key, eval $kf;
134                                  print "ERROR: can't eval { $kf }: $@" if ($@);                                  $log->logdie("can't eval { $kf }: $@") if ($@);
135    
136                                  return 1;                                  return 1;
137                          });                          });
138    
139                          my $key = join('-', @key ) || print "ERROR: no key found!";                          my $key = join('-', @key ) || $log->logdie("no key found!");
140    
141                          print "key = $key\n";                          $log->debug("key = $key");
142    
143                          my $create = '                          my $create = '
144                                  $coderef = ' . $e[7] . $e[8] . ';                                  $coderef = ' . $e[7] . $e[8] . ';
# Line 144  sub parse { Line 148  sub parse {
148                                  }                                  }
149                          ';                          ';
150    
151                          print "create: $create\n";                          $log->debug("create: $create");
152    
153                          $create =~ s/\s+/ /gs;                          $create =~ s/\s+/ /gs;
154                          $eval_create->{ $e[3] }->{ $e[5] } .= $create;                          $eval_create->{ $e[3] }->{ $e[5] } .= $create;
# Line 160  sub parse { Line 164  sub parse {
164                          $e[8]->remove;                          $e[8]->remove;
165    
166    
167                          print "# >>> ", $Element->snext_sibling, "\n";                          $log->debug(">>> ", $Element->snext_sibling);
168          });          });
169    
170          print "-----\ncreate: ", dump($eval_create), "\n";          $log->info("create: ", dump($eval_create) );
171          print "-----\nlookup: ", $Document->serialize, "\n";          $log->info("lookup: ", $Document->serialize );
         print "-----\n";  
172    
173          my $Dumper = PPI::Dumper->new( $Document );          if ($self->{debug}) {
174          $Dumper->print;                  my $Dumper = PPI::Dumper->new( $Document );
175                    $Dumper->print;
176            }
177    
178            return 1;
179  }  }
180    
181  =head1 AUTHOR  =head1 AUTHOR
Legend:
Removed from v.686  
changed lines
  Added in v.687
  ViewVC Help
Powered by ViewVC 1.1.26