From: Dobrica Pavlinusic Date: Fri, 26 Oct 2007 15:11:50 +0000 (+0000) Subject: finished dump target (which used to be debug in last commit) which will dump X-Git-Url: http://git.rot13.org/?p=perl-cwmp.git;a=commitdiff_plain;h=edfd1a00b150b9255d8190d1f0f3272b81e5b1e1;hp=8e67b3292c452af53934770fd39cb20d9d30d86d finished dump target (which used to be debug in last commit) which will dump requests and responses to dump/ directory which will in turn be cleaned by make clean git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@116 836a5e1a-633d-0410-964b-294494ad4392 --- diff --git a/Makefile.PL b/Makefile.PL index 136ad25..d346367 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -22,6 +22,7 @@ requires 'Term::Shelly' => '0.03'; build_requires 'Test::More'; my_targets(); +clean_files('dump/*'); auto_install; diff --git a/lib/CWMP/Session.pm b/lib/CWMP/Session.pm index 40e5822..263794b 100644 --- a/lib/CWMP/Session.pm +++ b/lib/CWMP/Session.pm @@ -68,7 +68,7 @@ facilitate brain-dead concept of adding state to stateless protocol like HTTP. If used with debugging level of 3 or more, it will also create dumps of -requests named C<< nr.dump >> where C is number from 0 to total number +requests named C<< dump/nr.request >> where C is number from 0 to total number of requests in single session. =cut @@ -102,7 +102,7 @@ sub process_request { warn "<<<< ", $sock->peerhost, " [" . localtime() . "] ", $r->method, " ", $r->uri, " $size bytes\n"; if ( $self->debug > 2 ) { - my $file = $dump_nr++ . '.dump'; + my $file = sprintf("dump/%04d.request", $dump_nr); write_file( $file, $r->as_string ); warn "### request dump: $file\n"; } @@ -172,6 +172,8 @@ sub process_request { $xml = $self->dispatch('Inform', $response_arguments ); +If debugging level of 3 or more, it will create dumps of responses named C<< dump/nr.response >> + =cut sub dispatch { @@ -185,6 +187,11 @@ sub dispatch { warn ">>> dispatching to $dispatch\n"; my $xml = $response->$dispatch( $self->state, @_ ); warn "## response payload: ",length($xml)," bytes\n$xml\n" if $self->debug; + if ( $self->debug > 2 ) { + my $file = sprintf("dump/%04d.response", $dump_nr++); + write_file( $file, $xml ); + warn "### response dump: $file\n"; + } return $xml; } else { confess "can't dispatch to $dispatch"; diff --git a/lib/Module/Install/PRIVATE.pm b/lib/Module/Install/PRIVATE.pm index 1226843..544f137 100644 --- a/lib/Module/Install/PRIVATE.pm +++ b/lib/Module/Install/PRIVATE.pm @@ -25,12 +25,12 @@ sub my_targets { $self->postamble(<<"END_MAKEFILE"); # --- $self section: -debug: +dump: all ./bin/acs.pl -d -d -d 2>&1 | tee log END_MAKEFILE - warn "added my targets\n"; + warn "added my targets: dump\n"; return $self; }