File Coverage

blib/lib/Autocache/Config/Node.pm
Criterion Covered Total %
statement 38 55 69.0
branch 9 14 64.2
condition n/a
subroutine 9 13 69.2
pod 0 10 0.0
total 56 92 60.8


line stmt bran cond sub pod time code
1             package Autocache::Config::Node;
2              
3 5     5   22 use strict;
  5         6  
  5         112  
4 5     5   14 use warnings;
  5         5  
  5         111  
5              
6 5     5   1599 use Autocache::Logger qw(get_logger);
  5         8  
  5         2971  
7              
8             sub new
9             {
10 29     29 0 36 my ($class,$name) = @_;
11 29         72 my $self = { name => $name, value => undef, child => {} };
12 29         51 return bless $self, $class;
13             }
14              
15             sub name
16             {
17 8     8 0 12 my ($self) = @_;
18 8         22 return $self->{name};
19             }
20              
21             sub value
22             {
23 29     29 0 28 my ($self,$value) = @_;
24 29         25 my $rv;
25 29 100       63 if( $value )
26             {
27 16         23 $rv = $self->{value};
28 16         20 $self->{value} = $value;;
29             }
30             else
31             {
32 13         15 $rv = $self->{value};
33             }
34 29         111 return $rv;
35             }
36              
37             sub children_names
38             {
39 0     0 0 0 my ($self) = @_;
40 0         0 return keys %{$self->{child}};
  0         0  
41             }
42              
43             sub children
44             {
45 8     8 0 11 my ($self) = @_;
46 8         14 return values %{$self->{child}};
  8         41  
47             }
48              
49             sub add_child
50             {
51 0     0 0 0 my ($self,$node) = @_;
52 0         0 return $self->{child}{$node->name} = $node;
53             }
54              
55             sub remove_child
56             {
57 0     0 0 0 my ($self,$node_or_name) = @_;
58 0 0       0 $node_or_name = $node_or_name->name
59             if blessed $node_or_name;
60 0         0 return delete $self->{child}{$node_or_name};
61             }
62              
63             sub get_node
64             {
65 46     46 0 45 my ($self,$path) = @_;
66 46         141 get_logger()->debug( "get_node: $path" );
67 46         93 my ($name,$rest) = split /\./, $path, 2;
68              
69 46         66 my $node = $self->{child}{$name};
70              
71 46 100       79 unless( $node )
72             {
73 24         43 $node = __PACKAGE__->new( $name );
74 24         44 $self->{child}{$name} = $node;
75             }
76              
77 46 100       141 return ( defined $rest ) ?
78             $node->get_node( $rest ) : $node;
79             }
80              
81             sub node_exists
82             {
83 3     3 0 3 my ($self,$path) = @_;
84 3         7 get_logger()->debug( "node_exists: $path" );
85 3         9 my ($name,$rest) = split /\./, $path, 2;
86              
87 3 100       13 return undef unless exists $self->{child}{$name};
88              
89 2         4 my $node = $self->{child}{$name};
90              
91 2 50       13 return ( defined $rest ) ?
92             $node->node_exists( $rest ) : $node;
93             }
94              
95             sub to_hash
96             {
97 0     0 0   my ($self) = @_;
98              
99 0           my @children = $self->children;
100 0 0         if( scalar @children )
101             {
102 0           my %hash;
103 0           foreach my $child ( $self->children )
104             {
105 0           $hash{$child->name} = $child->to_hash;
106             }
107 0           $hash{_value} = $self->value;
108 0           return \%hash;
109             }
110             else
111             {
112 0           return $self->value;
113             }
114             }
115              
116             1;