X-Git-Url: http://git.rot13.org/?p=perl-cwmp.git;a=blobdiff_plain;f=lib%2FCWMP%2FRequest.pm;h=07b93f4c8ccd65a9806b8bcf8da3d278674524f8;hp=2456e5568c6d2f1916680b897fe6fec8a0b66a6a;hb=5eee4c310323f72d3fc166f105f9ce09ed2e099b;hpb=397dff9ff9273c840cc59d5c2a6bde0540da7a4e

diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm
index 2456e55..07b93f4 100644
--- a/lib/CWMP/Request.pm
+++ b/lib/CWMP/Request.pm
@@ -4,9 +4,11 @@ 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
 
@@ -14,13 +16,13 @@ CWMP::Request - parse SOAP request metods
 
 =head1 CPE metods
 
-=cut
+All methods described below call triggers with same name
 
-my $tree = CWMP::Tree->new({ debug => 0 });
+=cut
 
 our $state;	# FIXME check this!
 
-my $rules =  [
+our $rules =  [
 		#_default => 'content trim',
 		x_default => sub {
 			my ($tag_name, $tag_hash, $context, $parent_data) = @_;
@@ -29,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 {
@@ -37,7 +40,7 @@ my $rules =  [
 				next if $name eq '_content';
 				my $key = $name;
 				$key =~ s/^\w+://;	# stip namespace
-				$state->{DeviceID}->{ $key } = _tag( $tag_hash, $name, '_content' );
+				$state->{DeviceId}->{ $key } = _tag( $tag_hash, $name, '_content' );
 			}
 		},
 		'EventStruct' => sub {
@@ -53,6 +56,7 @@ my $rules =  [
 			# Name/Value tags must be case insnesitive
 			my $value = (grep( /value/i, keys %$tag_hash ))[0];
 			$state->{Parameter}->{ _tag($tag_hash, 'Name', '_content') } = _tag($tag_hash, 'Value', '_content' );
+			$state->{_trigger} = 'ParameterValue';
 		},
 
 ];
@@ -66,6 +70,7 @@ Generate InformResponse to CPE
 push @$rules,
 	'Inform' => sub {
 		$state->{_dispatch} = 'InformResponse';		# what reponse to call
+		$state->{_trigger} = 'Inform';
 	};
 
 =head2 GetRPCMethodsResponse
@@ -77,6 +82,7 @@ push @$rules,
 		'MethodList' => sub {
 			my ($tag_name, $tag_hash, $context, $parent_data) = @_;
 			$state->{MethodList} = _tag( $tag_hash, 'string' );
+			$state->{_trigger} = 'GetRPCMethodsResponse';
 		};
 
 =head2 GetParameterNamesResponse
@@ -91,14 +97,35 @@ push @$rules,
 
 			confess "need state" unless ( $state );	# don't remove!
 
-			# 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 ($@);
+			$state->{ParameterInfo}->{$name} = $writable;
 
 			#warn "## state = dump( $state ), "\n";
+
+			$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
@@ -111,22 +138,9 @@ push @$rules,
 				FaultString => _tag( $tag_hash, 'FaultString', '_content' ),
 			};
 			warn "FAULT: ", $state->{Fault}->{FaultCode}, " ", $state->{Fault}->{FaultString}, "\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
@@ -141,7 +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 propagate _trigger (useful for symlinks)
+
 	return $state;
 }