r969@llin: dpavlin | 2006-09-24 19:47:01 +0200

 use Log::Log4perl for logging

git-svn-id: svn+ssh://mjesec/home/dpavlin/svn/webpac2/trunk@687 07558da8-63fa-0310-ba24-9fe276d99e06

diff --git a/lib/WebPAC/Parser.pm b/lib/WebPAC/Parser.pm
index 0a37849..08eb855 100644 (file)
--- a/lib/WebPAC/Parser.pm
+++ b/lib/WebPAC/Parser.pm
@@ -96,24 +96,28 @@ sub parse {
                        $Element->isa('PPI::Token::Word') or return '';
                        $Element->content eq 'lookup' or return '';
 
-                       print "#*** expansion: ", $Element->snext_sibling,$/;
+                       $log->debug("expansion: ", $Element->snext_sibling);
 
                        my $args = $Element->snext_sibling;
                
                        my @e = $args->child(0)->elements;
-                       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);
 
-                       print "# found ", scalar @e, " elements:\n";
+                       if ($log->is_debug) {
+                               my $report = "found " . scalar @e . " elements:\n";
 
-                       foreach my $i ( 0 .. $#e ) {
-                               printf("# %-2d: %-30s %s\n", $i, ( $e[$i] || 'undef' ), $e[$i]->class );
+                               foreach my $i ( 0 .. $#e ) {
+                                       $report .= sprintf("# %-2d: %-30s %s\n", $i, ( $e[$i] || 'undef' ), $e[$i]->class );
+                               }
+
+                               $log->debug($report);
                        }
 
                        my $key_element = $e[8]->clone;
 
-                       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');
 
-                       print "## key part: ", $key_element, $/;
+                       $log->debug("key part: ", $key_element);
 
                        my @key;
 
@@ -124,17 +128,17 @@ sub parse {
 
                                my $kf = $e->snext_sibling;
 
-                               print "## key fragment = $kf\n";
+                               $log->debug("key fragment = $kf");
 
                                push @key, eval $kf;
-                               print "ERROR: can't eval { $kf }: $@" if ($@);
+                               $log->logdie("can't eval { $kf }: $@") if ($@);
 
                                return 1;
                        });
 
-                       my $key = join('-', @key ) || print "ERROR: no key found!";
+                       my $key = join('-', @key ) || $log->logdie("no key found!");
 
-                       print "key = $key\n";
+                       $log->debug("key = $key");
 
                        my $create = ' 
                                $coderef = ' . $e[7] . $e[8] . ';
@@ -144,7 +148,7 @@ sub parse {
                                }
                        ';
 
-                       print "create: $create\n";
+                       $log->debug("create: $create");
 
                        $create =~ s/\s+/ /gs;
                        $eval_create->{ $e[3] }->{ $e[5] } .= $create;
@@ -160,16 +164,18 @@ sub parse {
                        $e[8]->remove;
 
 
-                       print "# >>> ", $Element->snext_sibling, "\n";
+                       $log->debug(">>> ", $Element->snext_sibling);
        });
 
-       print "-----\ncreate: ", dump($eval_create), "\n";
-       print "-----\nlookup: ", $Document->serialize, "\n";
-       print "-----\n";
+       $log->info("create: ", dump($eval_create) );
+       $log->info("lookup: ", $Document->serialize );
 
-       my $Dumper = PPI::Dumper->new( $Document );
-       $Dumper->print;
+       if ($self->{debug}) {
+               my $Dumper = PPI::Dumper->new( $Document );
+               $Dumper->print;
+       }
 
+       return 1;
 }
 
 =head1 AUTHOR

diff --git a/t/2-parse.t b/t/2-parse.t
index 4a081c7..2b7564b 100755 (executable)
--- a/t/2-parse.t
+++ b/t/2-parse.t
@@ -29,6 +29,7 @@ ok(
        my $parser = new WebPAC::Parser(
                config => new WebPAC::Config( path => $config_path ),
                base_path => $abs_path,
+               debug => $debug,
 ), "new");
 
 ok($parser->{source}, "source exist");