r274@brr: dpavlin | 2007-11-25 21:34:51 +0100

[perl-cwmp.git] / lib / CWMP / Request.pm

diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm
index 2456e55..ef8c322 100644 (file)
--- 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) = @_;
@@ -53,6 +55,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 +69,7 @@ Generate InformResponse to CPE
 push @$rules,
        'Inform' => sub {
                $state->{_dispatch} = 'InformResponse';         # what reponse to call
+               $state->{_trigger} = 'Inform';
        };
 
 =head2 GetRPCMethodsResponse
@@ -77,6 +81,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,12 +96,11 @@ 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 Fault
@@ -111,22 +115,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 +132,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;
 }