lib/CWMP/Tree.pm

# Dobrica Pavlinusic, <dpavlin@rot13.org> 06/22/07 14:35:38 CEST
package CWMP::Tree;

use strict;
use warnings;


use base qw/Class::Accessor/;
__PACKAGE__->mk_accessors( qw/
debug
/ );

use Carp qw/confess/;
use Data::Dump qw/dump/;

=head1 NAME

CWMP::Tree - description

=head1 METHODS

=head2 new

  my $obj = CWMP::Tree->new({
        debug => 1
  });

=cut

sub new {
        my $class = shift;
        my $self = $class->SUPER::new( @_ );

        warn "created ", __PACKAGE__, "(", dump( @_ ), ") object\n" if $self->debug;

        return $self;
}

=head2 name2perl

Perl is dynamic language and we want parametars from TR-069 as
a tree. So we do rewrite of parametar to perl code and eval that.

  my $perl = $self->name2perl( 'InternetGatewayDevice.DeviceSummary' );

=cut

sub name2perl {
        my ( $self, $s ) = @_;

        confess "no name?" unless $s;

        warn "===> $s\n" if $self->debug;
        $s =~ s/^([^\.]+)/{'$1'}/;
        warn "---> $s\n"  if $self->debug;

        my $stat;
        while ( $s =~ s/\.(\d+)/->[$1]/ ) {
                $stat->{array}++;
                warn "-\@-> $s\n" if $self->debug;
        }
        while ( $s =~ s/\.([a-zA-Z0-9_]+)/->{'$1'}/ ) {
                $stat->{scalar}++;
                warn "-\$-> $s\n" if $self->debug;

        };

        warn "## $s ", dump( $stat ), $/ if $self->debug;

        # FIXME if it ends with a dot (array values), remove it
        $s =~ s/\.$//;

        return $s;
}

1;
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;