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   29 use strict;
  5         8  
  5         148  
4 5     5   24 use warnings;
  5         14  
  5         319  
5              
6 5     5   3240 use Autocache::Logger qw(get_logger);
  5         19  
  5         4844  
7              
8             sub new
9             {
10 28     28 0 51 my ($class,$name) = @_;
11 28         118 my $self = { name => $name, value => undef, child => {} };
12 28         97 return bless $self, $class;
13             }
14              
15             sub name
16             {
17 5     5 0 12 my ($self) = @_;
18 5         20 return $self->{name};
19             }
20              
21             sub value
22             {
23 26     26 0 48 my ($self,$value) = @_;
24 26         37 my $rv;
25 26 100       110 if( $value )
26             {
27 16         38 $rv = $self->{value};
28 16         28 $self->{value} = $value;;
29             }
30             else
31             {
32 10         25 $rv = $self->{value};
33             }
34 26         146 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 7     7 0 53 my ($self) = @_;
46 7         12 return values %{$self->{child}};
  7         42  
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 44     44 0 70 my ($self,$path) = @_;
66 44         199 get_logger()->debug( "get_node: $path" );
67 44         126 my ($name,$rest) = split /\./, $path, 2;
68              
69 44         111 my $node = $self->{child}{$name};
70              
71 44 100       169 unless( $node )
72             {
73 23         66 $node = __PACKAGE__->new( $name );
74 23         62 $self->{child}{$name} = $node;
75             }
76              
77 44 100       218 return ( defined $rest ) ?
78             $node->get_node( $rest ) : $node;
79             }
80              
81             sub node_exists
82             {
83 2     2 0 4 my ($self,$path) = @_;
84 2         8 get_logger()->debug( "node_exists: $path" );
85 2         7 my ($name,$rest) = split /\./, $path, 2;
86              
87 2 100       13 return undef unless exists $self->{child}{$name};
88              
89 1         4 my $node = $self->{child}{$name};
90              
91 1 50       14 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;