X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=lib%2FCWMP%2FRequest.pm;h=0cea935227fb4d15a7ebbf58a1f5fe1956324a1f;hb=774c5ba74d808d504f5e6dd2b838f68e37b50842;hp=8de34de67fd9c32778d3cb0b15249f088c4dcb99;hpb=50ef368d348a07884b2a3d0a91bc5379a6a06df2;p=perl-cwmp.git diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm index 8de34de..0cea935 100644 --- a/lib/CWMP/Request.pm +++ b/lib/CWMP/Request.pm @@ -4,11 +4,12 @@ use warnings; use strict; use XML::Rules; -use CWMP::Tree; use Data::Dump qw/dump/; use Carp qw/confess cluck/; use Class::Trigger; +#use Devel::LeakTrace::Fast; + =head1 NAME CWMP::Request - parse SOAP request metods @@ -19,11 +20,9 @@ All methods described below call triggers with same name =cut -my $tree = CWMP::Tree->new({ debug => 0 }); - our $state; # FIXME check this! -my $rules = [ +our $rules = [ #_default => 'content trim', x_default => sub { my ($tag_name, $tag_hash, $context, $parent_data) = @_; @@ -32,6 +31,7 @@ my $rules = [ 'ID' => sub { my ($tag_name, $tag_hash, $context, $parent_data) = @_; $state->{ID} = $tag_hash->{_content}; + chomp( $state->{ID} ); }, 'DeviceId' => sub { @@ -97,15 +97,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"; @@ -113,6 +104,28 @@ push @$rules, $state->{_trigger} = 'GetParameterNamesResponse'; }; +=head2 GetParameterAttributesResponse + +=cut + +push @$rules, + 'ParameterAttributeStruct' => sub { + my ($tag_name, $tag_hash, $context, $parent_data) = @_; + warn dump( $tag_name, $tag_hash, $context ); + + confess "need state" unless ( $state ); # don't remove! + + my $name = _tag($tag_hash, 'Name', '_content'); + + + $state->{ParameterAttribute}->{$name} = { + Notification => _tag($tag_hash, 'Notification', '_content' ), + AccessList => _tag($tag_hash, 'AccessList', 'string' ), + }; + + $state->{_trigger} = 'GetParameterAttributesResponse'; + }; + =head2 Fault =cut @@ -128,20 +141,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 @@ -156,13 +155,33 @@ sub parse { my $xml = shift || confess "no xml?"; $state = {}; + + 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, + ); + +# warn "## created $parser\n"; + $parser->parsestring( $xml ); + + undef $parser; + if ( my $trigger = $state->{_trigger} ) { warn "### call_trigger( $trigger )\n"; $self->call_trigger( $trigger, $state ); } - # XXX don't propagate _trigger (useful?) - delete( $state->{_trigger} ); + # XXX propagate _trigger (useful for symlinks) + return $state; }