lib/CWMP/Tree.pm

   1 # Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
   2 package CWMP::Tree;
   3
   4 use strict;
   5 use warnings;
   6
   7
   8 use base qw/Class::Accessor/;
   9 __PACKAGE__->mk_accessors( qw/
  10 debug
  11 / );
  12
  13 use Carp qw/confess/;
  14 use Data::Dump qw/dump/;
  15
  16 =head1 NAME
  17
  18 CWMP::Tree - description
  19
  20 =head1 METHODS
  21
  22 =head2 new
  23
  24   my $obj = CWMP::Tree->new({
  25         debug => 1
  26   });
  27
  28 =cut
  29
  30 sub new {
  31         my $class = shift;
  32         my $self = $class->SUPER::new( @_ );
  33
  34         warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;
  35
  36         return $self;
  37 }
  38
  39 =head2 name2perl
  40
  41 Perl is dynamic language and we want parametars from TR-069 as
  42 a tree. So we do rewrite of parametar to perl code and eval that.
  43
  44   my $perl = $self->name2perl( 'InternetGatewayDevice.DeviceSummary' );
  45
  46 =cut
  47
  48 sub name2perl {
  49         my ( $self, $s ) = @_;
  50
  51         confess "no name?" unless $s;
  52
  53         warn "===> $s\n" if $self->debug;
  54         $s =~ s/^([^\.]+)/{'$1'}/;
  55         warn "---> $s\n"  if $self->debug;
  56
  57         my $stat;
  58         while ( $s =~ s/\.(\d+)/->[$1]/ ) {
  59                 $stat->{array}++;
  60                 warn "-\@-> $s\n" if $self->debug;
  61         }
  62         while ( $s =~ s/\.([a-zA-Z0-9_]+)/->{'$1'}/ ) {
  63                 $stat->{scalar}++;
  64                 warn "-\$-> $s\n" if $self->debug;
  65
  66         };
  67
  68         warn "## $s ", dump( $stat ), $/ if $self->debug;
  69
  70         # FIXME if it ends with a dot (array values), remove it
  71         $s =~ s/\.$//;
  72
  73         return $s;
  74 }
  75
  76 1;