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

diff --git a/Makefile.PL b/Makefile.PL
index 902d3b6..ac51fa1 100644 (file)
--- 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 (executable)
--- 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 (executable)
--- 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 (file)
index 06ac5ae..0000000
--- a/lib/CWMP/MemLeak.pm
+++ /dev/null
@@ -1,79 +0,0 @@
-# Dobrica Pavlinusic, <dpavlin@rot13.org> 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 (file)
--- 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 (file)
--- 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 (file)
index 67542a3..0000000
--- a/lib/CWMP/Tree.pm
+++ /dev/null
@@ -1,76 +0,0 @@
-# Dobrica Pavlinusic, <dpavlin@rot13.org> 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 (executable)
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' );
-