],
'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),
],
);
use Data::Dump qw/dump/;
use File::Find;
+use Devel::LeakTrace::Fast;
+
my $port = 3333;
my $debug = 0;
my $store_path = './';
$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', [
$q->enqueue( 'GetParameterAttributes', [
'InternetGatewayDevice.DeviceInfo.SerialNumber',
+ 'InternetGatewayDevice.DeviceInfo.SoftwareVersion',
]);
# $q->enqueue( 'SetParameterAttributes', [ '
+++ /dev/null
-# 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;
=cut
-my $tree = CWMP::Tree->new({ debug => 0 });
-
our $state; # FIXME check this!
my $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";
$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
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";
use CWMP::Session;
use CWMP::Queue;
-use CWMP::MemLeak;
use Carp qw/confess/;
use Data::Dump qw/dump/;
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};
warn "...returning to accepting new connections\n" if $prop->{debug};
- $leak->report;
-
}
1;
+++ /dev/null
-# 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;
+++ /dev/null
-#!/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' );
-