File Coverage

blib/lib/App/Rsnapshot/Config/Node.pm
Criterion Covered Total %
statement 51 52 98.0
branch 17 20 85.0
condition 7 11 63.6
subroutine 12 13 92.3
pod 2 2 100.0
total 89 98 90.8


line stmt bran cond sub pod time code
1             package App::Rsnapshot::Config::Node;
2              
3 3     3   16 use strict;
  3         5  
  3         95  
4 3     3   22 use warnings;
  3         5  
  3         85  
5              
6 3     3   16 use vars qw($VERSION $AUTOLOAD);
  3         6  
  3         442  
7              
8             use overload
9 183     183   3462 '""' => sub { return shift()->_gettext(); },
10 1     1   2 'eq' => sub { my $s = shift(); return $s->_compare('eq', @_) },
  1         5  
11 1     1   3 'ne' => sub { my $s = shift(); return $s->_compare('ne', @_) },
  1         5  
12 3     3   1550 ;
  3         1085  
  3         41  
13              
14             $VERSION = '1.0';
15              
16             =head1 NAME
17              
18             App::Rsnapshot::Config::Node - a node in the config file
19              
20             =head1 SYNOPSIS
21              
22             You should never need to create one of these objects from scratch.
23             It provides methods to get at information in the XML. eg, given this
24             and a suitably setup App::Rsnapshot::Config object:
25              
26            
27            
28             /.snapshots/
29            
30            
31            
32            
33             -a
34             -q
35            
36            
37             --delete
38            
39            
40            
41            
42              
43             then you can get all the information about rsync thus:
44              
45             my $rsync = $config->externalprograms()->rsync();
46             my $rsyncbinary = $rsync->binary();
47             my $rsyncargs = [
48             $rsync->shortargs()->values(),
49             $srync->longargs()->values()
50             ];
51             my $secondbackuppoint = $config->backuppoints()->backup(1);
52             my @backuppoints = $config->backuppoints()->backup('*');
53              
54             =head1 DESCRIPTION
55              
56             Provides access to all the nodes in an App::Rsnapshot::Config object.
57              
58             =head1 METHODS
59              
60             =head2 new
61              
62             Constructor, that you should never have to use.
63              
64             =head2 various created by AUTOLOAD
65              
66             The methods (eg C, C etc) in the synopsis above are created
67             using AUTOLOAD. The AUTOLOADer first looks for an attribute with the
68             appropriate name and if it exists, returns its contents.
69              
70             If no such attribute is found, then it looks for a child node of the
71             appropriate type. If no parameter is given, it returns the first one.
72              
73             If a numeric parameter is given it returns the Nth such node - they are
74             numbered from 0.
75              
76             If the parameter is an asterisk (C<*>) then a list of all such nodes
77             is returned.
78              
79             Otherwise the node of the appropriate type whose C<-Ename()> method
80             matches is returned. It is an error to try this if there's no such
81             method.
82              
83             Nodes stringify to their contents if necessary, and can also be compared
84             for string (in)equality. Note that when stringifying, leading and
85             trailing whitespace is removed.
86              
87             =head2 values
88              
89             Returns a list of the string contents of all child nodes.
90              
91             =cut
92              
93             sub new {
94 165     165 1 270 my $class = shift;
95 165         342 my $document = shift;
96 165         620 bless $document, $class;
97             }
98              
99             sub AUTOLOAD {
100 307     307   2844 (my $nodename = $AUTOLOAD) =~ s/.*:://;
101 307         443 my $self = shift();
102 307   100     1489 my $wanted = shift() || 0;
103              
104             # attribs take precedence ...
105 307 100       5862 return $self->{attrib}->{$nodename}
106             if(exists($self->{attrib}->{$nodename}));
107              
108 77         110 my @childnodes = ();
109 77         83 foreach my $childnode (@{$self->{content}}) {
  77         164  
110 334 100 66     2040 if($childnode->{type} eq 'e' && $childnode->{name} eq $nodename) {
111 158         419 push @childnodes, __PACKAGE__->new($childnode);
112             }
113             }
114 77 100       432 if($wanted eq '*') {
    100          
115 12         54 return @childnodes;
116             } elsif($wanted =~ /^\d+$/) {
117 53 100       480 return $childnodes[$wanted] if(exists($childnodes[$wanted]));
118 1         10 die("Can't get '$nodename' number $wanted from object ".ref($self)."\n");
119             } else {
120 12         22 return (grep { $_->name() eq $wanted } @childnodes)[0];
  48         193  
121             }
122             }
123              
124             sub values {
125 2     2 1 4 my $self = shift;
126 2         5 my @values = ();
127 2 50 33     26 if(exists($self->{content}) && ref($self->{content}) eq 'ARRAY') {
128 2         8 push @values, __PACKAGE__->new($_)->_gettext()
129 2         5 foreach (@{$self->{content}});
130             }
131 2         16 return @values;
132             }
133              
134             sub _gettext {
135 189     189   302 my $self = shift;
136 189         354 my $c = $self->{content};
137 189 100 66     1499 if(
138             ref($c) eq 'ARRAY' && # there's some contents
139             $c->[0]->{type} eq 't' # it's a text node
140             ) {
141 188         3363 (my $value = $c->[0]->{content}) =~ s/^\s+|\s+$//g;
142 188         3819 return $value;
143             } else {
144 1         10 die("Can't stringify '".$self->{name}."' in ".ref($self)."\n");
145             }
146             }
147              
148             sub _compare {
149 2     2   5 my($self, $op, $comparand, $reversed) = @_;
150 2         4 my $value = $self->_gettext();
151 2 50       8 ($value, $comparand) = ($comparand, $value) if($reversed);
152 2 50       13 return ($op eq 'eq') ? $value eq $comparand :
    100          
153             ($op eq 'ne') ? $value ne $comparand :
154             # ($op eq 'lt') ? $value lt $comparand :
155             # ($op eq 'le') ? $value le $comparand :
156             # ($op eq 'gt') ? $value gt $comparand :
157             # ($op eq 'ge') ? $value ge $comparand :
158             # ($op eq 'cmp') ? $value cmp $comparand :
159             die("_compare can't $op\n");
160             }
161              
162 0     0     sub DESTROY {}
163              
164             =head1 BUGS/WARNINGS/LIMITATIONS
165              
166             None known
167              
168             =head1 SOURCE CODE REPOSITORY
169              
170             L
171              
172             =head1 AUTHOR, COPYRIGHT and LICENCE
173              
174             Copyright 2009 David Cantrell
175              
176             This software is free-as-in-speech software, and may be used,
177             distributed, and modified under the terms of either the GNU
178             General Public Licence version 2 or the Artistic Licence. It's
179             up to you which one you use. The full text of the licences can
180             be found in the files GPL2.txt and ARTISTIC.txt, respectively.
181              
182             =head1 CONSPIRACY
183              
184             This module is also free-as-in-mason software.
185              
186             =cut
187              
188             1;