From 03eb97317af85b13a1a2c8d0f66685d763a60c32 Mon Sep 17 00:00:00 2001 From: Dobrica Pavlinusic Date: Fri, 23 Nov 2007 21:14:54 +0000 Subject: [PATCH] r254@brr: dpavlin | 2007-11-23 22:14:16 +0100 - replace Devel::Events with Devel::LeakTrace::Fast - remove CWMP::Tree which is no longer used git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@220 836a5e1a-633d-0410-964b-294494ad4392 --- Makefile.PL | 5 +-- bin/acs.pl | 2 ++ bin/cpe-queue.pl | 23 ++++++------- lib/CWMP/MemLeak.pm | 79 --------------------------------------------- lib/CWMP/Request.pm | 40 +++++++++-------------- lib/CWMP/Server.pm | 5 --- lib/CWMP/Tree.pm | 76 ------------------------------------------- t/80-leaks.t | 25 -------------- 8 files changed, 30 insertions(+), 225 deletions(-) delete mode 100644 lib/CWMP/MemLeak.pm delete mode 100644 lib/CWMP/Tree.pm delete mode 100755 t/80-leaks.t diff --git a/Makefile.PL b/Makefile.PL index 902d3b6..ac51fa1 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -46,10 +46,7 @@ features( ], 'Memory leak detection (for developers)' => [ -default => 0, - recommends('Devel::Events' => '0.02'), - recommends('Devel::Events::Handler::ObjectTracker'), - recommends('Devel::Events::Generator::Objects'), - recommends('Devel::Size'), + recommends('Devel::LeakTrace::Fast' => 0.11), ], ); diff --git a/bin/acs.pl b/bin/acs.pl index 1b341e7..1cf9de8 100755 --- a/bin/acs.pl +++ b/bin/acs.pl @@ -14,6 +14,8 @@ use Getopt::Long; use Data::Dump qw/dump/; use File::Find; +use Devel::LeakTrace::Fast; + my $port = 3333; my $debug = 0; my $store_path = './'; diff --git a/bin/cpe-queue.pl b/bin/cpe-queue.pl index 6b6a008..0158753 100755 --- a/bin/cpe-queue.pl +++ b/bin/cpe-queue.pl @@ -116,20 +116,20 @@ foreach my $id ( @ARGV ) { $q->enqueue( 'GetRPCMethods' ); - # $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] ); +# $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] ); - # $q->enqueue( 'GetParameterValues', [ - # 'InternetGatewayDevice.', - # ]); + $q->enqueue( 'GetParameterValues', [ + 'InternetGatewayDevice.', + ]); - # $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] ); +# $q->enqueue( 'GetParameterNames', [ '.ExternalIPAddress', 1 ] ); - # $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] ); - # $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] ); - # $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceConfig.', 1 ] ); - # $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.ManagementServer.', 1 ] ); - # $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.Services.', 1 ] ); - # $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] ); + $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 1 ] ); +# $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceInfo.', 1 ] ); +# $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.DeviceConfig.', 1 ] ); +# $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.ManagementServer.', 1 ] ); +# $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.Services.', 1 ] ); +# $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.LANDevice.', 1 ] ); $q->enqueue( 'GetParameterNames', [ 'InternetGatewayDevice.', 0 ] ); $q->enqueue( 'GetParameterValues', [ @@ -138,6 +138,7 @@ foreach my $id ( @ARGV ) { $q->enqueue( 'GetParameterAttributes', [ 'InternetGatewayDevice.DeviceInfo.SerialNumber', + 'InternetGatewayDevice.DeviceInfo.SoftwareVersion', ]); # $q->enqueue( 'SetParameterAttributes', [ ' diff --git a/lib/CWMP/MemLeak.pm b/lib/CWMP/MemLeak.pm deleted file mode 100644 index 06ac5ae..0000000 --- a/lib/CWMP/MemLeak.pm +++ /dev/null @@ -1,79 +0,0 @@ -# Dobrica Pavlinusic, 06/22/07 14:35:38 CEST -package CWMP::MemLeak; - -use strict; -use warnings; - - -use base qw/Class::Accessor/; -__PACKAGE__->mk_accessors( qw/ -tracker -generator -debug -/ ); - -#use Carp qw/confess/; -use Data::Dump qw/dump/; -use Devel::Events::Handler::ObjectTracker; -use Devel::Events::Generator::Objects; -use Devel::Size 'total_size'; - - -=head1 NAME - -CWMP::MemLeak - debugging module to detect memory leeks - -=head1 METHODS - -=head2 new - - my $leek = CWMP::MemLeak->new({ - debug => 1 - }); - -=cut - -sub new { - my $class = shift; - my $self = $class->SUPER::new( @_ ); - - warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug; - - $self->tracker(Devel::Events::Handler::ObjectTracker->new()); - $self->generator( - Devel::Events::Generator::Objects->new(handler => $self->tracker) - ); - - $self->generator->enable(); - - return $self; -} - -=head2 report - - my $size = $leek->report; - -=cut - -my $empty_array = total_size([]); - -sub report { - my $self = shift; - - $self->generator->disable(); - - my $leaked = $self->tracker->live_objects; - my @leaks = keys %$leaked; - - my $size = total_size([ @leaks ]) - $empty_array; - - warn "leaked $size = ",dump( $leaked ),$/ if $size > 2; - - - $self->generator(undef); - $self->tracker(undef); - - return $size; -} - -1; diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm index 8de34de..d4817b0 100644 --- a/lib/CWMP/Request.pm +++ b/lib/CWMP/Request.pm @@ -19,8 +19,6 @@ All methods described below call triggers with same name =cut -my $tree = CWMP::Tree->new({ debug => 0 }); - our $state; # FIXME check this! my $rules = [ @@ -97,15 +95,6 @@ push @$rules, confess "need state" unless ( $state ); # don't remove! -=for obsolete - - # XXX dragons ahead: convert name to tree rewriting it into perl - my $s = '$state->{ParameterInfo}->' . $tree->name2perl( $name ) . "->{writable} = $writable;"; - eval "$s"; - confess "can't eval $s : $@" if ($@); - -=cut - $state->{ParameterInfo}->{$name} = $writable; #warn "## state = dump( $state ), "\n"; @@ -128,20 +117,6 @@ push @$rules, $state->{_trigger} = 'Fault'; }; -my $parser = XML::Rules->new( -# start_rules => [ -# '^division_name,fax' => 'skip', -# ], - namespaces => { - 'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv', - 'http://schemas.xmlsoap.org/soap/encoding/' => 'soap', - 'http://www.w3.org/2001/XMLSchema' => 'xsd', - 'http://www.w3.org/2001/XMLSchema-instance' => 'xsi', - 'urn:dslforum-org:cwmp-1-0' => '', - }, - rules => $rules, -); - =head1 METHODS =head2 parse @@ -155,7 +130,22 @@ sub parse { my $xml = shift || confess "no xml?"; + my $parser = XML::Rules->new( +# start_rules => [ +# '^division_name,fax' => 'skip', +# ], + namespaces => { + 'http://schemas.xmlsoap.org/soap/envelope/' => 'soapenv', + 'http://schemas.xmlsoap.org/soap/encoding/' => 'soap', + 'http://www.w3.org/2001/XMLSchema' => 'xsd', + 'http://www.w3.org/2001/XMLSchema-instance' => 'xsi', + 'urn:dslforum-org:cwmp-1-0' => '', + }, + rules => $rules, + ); + $state = {}; + $parser->parsestring( $xml ); if ( my $trigger = $state->{_trigger} ) { warn "### call_trigger( $trigger )\n"; diff --git a/lib/CWMP/Server.pm b/lib/CWMP/Server.pm index a3d909b..13a923c 100644 --- a/lib/CWMP/Server.pm +++ b/lib/CWMP/Server.pm @@ -16,7 +16,6 @@ server use CWMP::Session; use CWMP::Queue; -use CWMP::MemLeak; use Carp qw/confess/; use Data::Dump qw/dump/; @@ -125,8 +124,6 @@ sub options { sub process_request { my $self = shift; - my $leak = CWMP::MemLeak->new; - my $prop = $self->{server}; confess "no server in ", ref( $self ) unless $prop; my $sock = $prop->{client}; @@ -149,8 +146,6 @@ sub process_request { warn "...returning to accepting new connections\n" if $prop->{debug}; - $leak->report; - } 1; diff --git a/lib/CWMP/Tree.pm b/lib/CWMP/Tree.pm deleted file mode 100644 index 67542a3..0000000 --- a/lib/CWMP/Tree.pm +++ /dev/null @@ -1,76 +0,0 @@ -# Dobrica Pavlinusic, 06/22/07 14:35:38 CEST -package CWMP::Tree; - -use strict; -use warnings; - - -use base qw/Class::Accessor/; -__PACKAGE__->mk_accessors( qw/ -debug -/ ); - -use Carp qw/confess/; -use Data::Dump qw/dump/; - -=head1 NAME - -CWMP::Tree - description - -=head1 METHODS - -=head2 new - - my $obj = CWMP::Tree->new({ - debug => 1 - }); - -=cut - -sub new { - my $class = shift; - my $self = $class->SUPER::new( @_ ); - - warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug; - - return $self; -} - -=head2 name2perl - -Perl is dynamic language and we want parametars from TR-069 as -a tree. So we do rewrite of parametar to perl code and eval that. - - my $perl = $self->name2perl( 'InternetGatewayDevice.DeviceSummary' ); - -=cut - -sub name2perl { - my ( $self, $s ) = @_; - - confess "no name?" unless $s; - - warn "===> $s\n" if $self->debug; - $s =~ s/^([^\.]+)/{'$1'}/; - warn "---> $s\n" if $self->debug; - - my $stat; - while ( $s =~ s/\.(\d+)/->[$1]/ ) { - $stat->{array}++; - warn "-\@-> $s\n" if $self->debug; - } - while ( $s =~ s/\.([a-zA-Z0-9_]+)/->{'$1'}/ ) { - $stat->{scalar}++; - warn "-\$-> $s\n" if $self->debug; - - }; - - warn "## $s ", dump( $stat ), $/ if $self->debug; - - # FIXME if it ends with a dot (array values), remove it - $s =~ s/\.$//; - - return $s; -} - -1; diff --git a/t/80-leaks.t b/t/80-leaks.t deleted file mode 100755 index c1c6768..0000000 --- a/t/80-leaks.t +++ /dev/null @@ -1,25 +0,0 @@ -#!/usr/bin/perl -use strict; -use warnings; - -my $debug = shift @ARGV; - -use Test::More tests => 4; -use Data::Dump qw/dump/; -use lib 'lib'; - -BEGIN { - use_ok('CWMP::MemLeak'); -} - -#use Cwd qw/abs_path/; -#ok(my $abs_path = abs_path($0), "abs_path"); -#$abs_path =~ s!/[^/]*$!/!; #!fix-vim - -ok( my $leak = CWMP::MemLeak->new({ - debug => $debug, -}), 'new' ); -isa_ok( $leak, 'CWMP::MemLeak' ); - -ok( ! $leak->report, 'report' ); - -- 2.20.1