uf, fix code to actually work with documentation :-\

git-svn-id: https://perl-cwmp.googlecode.com/svn/trunk@186 836a5e1a-633d-0410-964b-294494ad4392

diff --git a/lib/CWMP/Request.pm b/lib/CWMP/Request.pm
index 4ded128..2456e55 100644 (file)
--- a/lib/CWMP/Request.pm
+++ b/lib/CWMP/Request.pm
@@ -12,75 +12,15 @@ use Carp qw/confess cluck/;
 
 CWMP::Request - parse SOAP request metods
 
-=head1 METHODS
-
-=head2 _tag
-
-Get value of tag. Tag name is case insensitive (don't ask why),
-we ignore namespaces and can take optional C<sub_key>
-(usually C<_content>).
-
-  _tag( $tag_hash, $name, $sub_key )
-
-=cut
-
-sub _tag {
-       my ( $tag_hash, $name, $sub_key ) = @_;
-       confess "need hash as first argument" unless ( ref $tag_hash eq 'HASH' );
-       $name = (grep { m/^(?:\w+:)*$name$/i } keys %$tag_hash )[0];
-#      $name =~ s/^\w+://;
-       if ( defined $tag_hash->{$name} ) {
-               if ( ! defined $sub_key ) {
-                       return $tag_hash->{$name};
-               } elsif ( defined $tag_hash->{$name}->{$sub_key} ) {
-                       return $tag_hash->{$name}->{$sub_key};
-               } else {
-                       return if ( $name =~ m/^value$/i );
-                       warn "can't find '$name/$sub_key' in ", dump( $tag_hash );
-                       return;
-               }
-       } else {
-               warn "can't find '$name' in ", dump( $tag_hash );
-               return;
-       }
-}
-
-=head2 parse
-
-  my $state = CWMP::Request->parse( "<soap>request</soap>" );
-
-=cut
-
-sub parse {
-       my $self = shift;
-
-       my $xml = shift || confess "no xml?";
-
-       $state = {};
-       $parser->parsestring( $xml );
-       return $state;
-}
-
 =head1 CPE metods
 
 =cut
 
-our $state;    # FIXME check this!
-
 my $tree = CWMP::Tree->new({ debug => 0 });
 
-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 => [
+our $state;    # FIXME check this!
+
+my $rules =  [
                #_default => 'content trim',
                x_default => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
@@ -91,15 +31,6 @@ my $parser = XML::Rules->new(
                        $state->{ID} = $tag_hash->{_content};
                },
 
-=head2 Inform
-
-Generate InformResponse to CPE
-
-=cut
-
-               'Inform' => sub {
-                       $state->{_dispatch} = 'InformResponse';         # what reponse to call
-               },
                'DeviceId' => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        foreach my $name ( keys %$tag_hash ) {
@@ -124,19 +55,35 @@ Generate InformResponse to CPE
                        $state->{Parameter}->{ _tag($tag_hash, 'Name', '_content') } = _tag($tag_hash, 'Value', '_content' );
                },
 
+];
+
+=head2 Inform
+
+Generate InformResponse to CPE
+
+=cut
+
+push @$rules,
+       'Inform' => sub {
+               $state->{_dispatch} = 'InformResponse';         # what reponse to call
+       };
+
 =head2 GetRPCMethodsResponse
 
 =cut
+
+push @$rules,
                qr/^(?:^\w+:)*string$/ => 'content array',
                'MethodList' => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        $state->{MethodList} = _tag( $tag_hash, 'string' );
-               },
+               };
 
 =head2 GetParameterNamesResponse
 
 =cut
 
+push @$rules,
                'ParameterInfoStruct' => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        my $name = _tag($tag_hash, 'Name', '_content');
@@ -150,12 +97,13 @@ Generate InformResponse to CPE
                        confess "can't eval $s : $@" if ($@);
 
                        #warn "## state = dump( $state ), "\n";
-               },
+               };
        
 =head2 Fault
 
 =cut
 
+push @$rules,
                'Fault' => sub {
                        my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                        $state->{Fault} = {
@@ -163,8 +111,69 @@ Generate InformResponse to CPE
                                FaultString => _tag( $tag_hash, 'FaultString', '_content' ),
                        };
                        warn "FAULT: ", $state->{Fault}->{FaultCode}, " ", $state->{Fault}->{FaultString}, "\n";
-               }
-       ]
+               };
+
+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 $state = CWMP::Request->parse( "<soap>request</soap>" );
+
+=cut
+
+sub parse {
+       my $self = shift;
+
+       my $xml = shift || confess "no xml?";
+
+       $state = {};
+       $parser->parsestring( $xml );
+       return $state;
+}
+
+=head2 _tag
+
+Get value of tag. Tag name is case insensitive (don't ask why),
+we ignore namespaces and can take optional C<sub_key>
+(usually C<_content>).
+
+  _tag( $tag_hash, $name, $sub_key )
+
+=cut
+
+sub _tag {
+       my ( $tag_hash, $name, $sub_key ) = @_;
+       confess "need hash as first argument" unless ( ref $tag_hash eq 'HASH' );
+       $name = (grep { m/^(?:\w+:)*$name$/i } keys %$tag_hash )[0];
+#      $name =~ s/^\w+://;
+       if ( defined $tag_hash->{$name} ) {
+               if ( ! defined $sub_key ) {
+                       return $tag_hash->{$name};
+               } elsif ( defined $tag_hash->{$name}->{$sub_key} ) {
+                       return $tag_hash->{$name}->{$sub_key};
+               } else {
+                       return if ( $name =~ m/^value$/i );
+                       warn "can't find '$name/$sub_key' in ", dump( $tag_hash );
+                       return;
+               }
+       } else {
+               warn "can't find '$name' in ", dump( $tag_hash );
+               return;
+       }
+}
+
 1;