/[cwmp]/google/trunk/lib/CWMP/Request.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /google/trunk/lib/CWMP/Request.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 93 by dpavlin, Sat Jun 23 09:20:03 2007 UTC revision 103 by dpavlin, Sun Jun 24 19:36:31 2007 UTC
# Line 4  use warnings; Line 4  use warnings;
4  use strict;  use strict;
5    
6  use XML::Rules;  use XML::Rules;
7    use CWMP::Tree;
8  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
9  use Carp qw/confess cluck/;  use Carp qw/confess cluck/;
10    
 my $debug = 0;  
   
11  =head1 NAME  =head1 NAME
12    
13  CWMP::Request - parse SOAP request  CWMP::Request - parse SOAP request
# Line 48  sub _tag { Line 47  sub _tag {
47    
48  our $state;     # FIXME check this!  our $state;     # FIXME check this!
49    
50    my $tree = CWMP::Tree->new({ debug => 0 });
51    
52  my $parser = XML::Rules->new(  my $parser = XML::Rules->new(
53  #       start_rules => [  #       start_rules => [
54  #               '^division_name,fax' => 'skip',  #               '^division_name,fax' => 'skip',
# Line 117  my $parser = XML::Rules->new( Line 118  my $parser = XML::Rules->new(
118                          confess "need state" unless ( $state ); # don't remove!                          confess "need state" unless ( $state ); # don't remove!
119    
120                          # XXX dragons ahead: convert name to tree rewriting it into perl                          # XXX dragons ahead: convert name to tree rewriting it into perl
121                            my $s = '$state->{ParameterInfo}->' . $tree->name2perl( $name ) . "->{writable} = $writable;";
                         my $s = $name;  
                         warn "===> $name\n" if $debug;  
                         $s =~ s/^([^\.]+)/\$state->{ParameterInfo}->{'$1'}/;  
                         warn "---> $s\n"  if $debug;  
   
                         my $stat;  
                         while ( $s =~ s/\.(\d+)/->[$1]/ ) {  
                                 $stat->{array}++;  
                                 warn "-\@-> $s\n" if $debug;  
                         }  
                         while ( $s =~ s/\.([a-zA-Z0-9_]+)/->{'$1'}/ ) {  
                                 $stat->{scalar}++;  
                                 warn "-\$-> $s\n" if $debug;  
   
                         };  
                         $s .= "->{'writable'} = $writable;";  
   
                         warn "## $name\n## tree: $s\n## stat: ",dump( $stat ), "\n" if $debug;  
   
122                          eval "$s";                          eval "$s";
123                          confess "can't eval $s : $@" if ($@);                          confess "can't eval $s : $@" if ($@);
124    
Legend:
Removed from v.93  
changed lines
  Added in v.103
  ViewVC Help
Powered by ViewVC 1.1.26