File Coverage

lib/Config/AST/Node/Value.pm
Criterion Covered Total %
statement 42 48 87.5
branch 15 26 57.6
condition n/a
subroutine 12 12 100.0
pod 6 6 100.0
total 75 92 81.5


line stmt bran cond sub pod time code
1             # This file is part of Config::AST -*- perl -*-
2             # Copyright (C) 2017-2019 Sergey Poznyakoff
3             #
4             # Config::AST is free software; you can redistribute it and/or modify
5             # it under the terms of the GNU General Public License as published by
6             # the Free Software Foundation; either version 3, or (at your option)
7             # any later version.
8             #
9             # Config::AST is distributed in the hope that it will be useful,
10             # but WITHOUT ANY WARRANTY; without even the implied warranty of
11             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12             # GNU General Public License for more details.
13             #
14             # You should have received a copy of the GNU General Public License
15             # along with Config::AST. If not, see .
16              
17             package Config::AST::Node::Value;
18 19     19   183 use parent 'Config::AST::Node';
  19         25  
  19         75  
19 19     19   969 use strict;
  19         32  
  19         277  
20 19     19   62 use warnings;
  19         31  
  19         7719  
21              
22             =head1 NAME
23              
24             Config::AST::Node::Value - simple statement node
25              
26             =head1 DESCRIPTION
27              
28             Implements a simple statement node. Simple statement is always associated
29             with a value, hence the class name.
30              
31             =cut
32              
33             sub new {
34 55     55 1 214 my $class = shift;
35 55         185 local %_ = @_;
36 55         110 my $v = delete $_{value};
37 55         285 my $self = $class->SUPER::new(%_);
38 55         135 $self->value($v);
39 55         248 return $self;
40             }
41              
42             =head1 METHODS
43              
44             =head2 $node->value
45              
46             Returns the value associated with the statement.
47              
48             If value is a code reference, it is invoked without arguments, and its
49             return is used as value.
50            
51             If the value is a reference to a list or hash, the return depends on the
52             context. In scalar context, the reference itself is returned. In list
53             context, the array or hash is returned.
54              
55             =cut
56              
57             sub value {
58 202     202 1 267 my ($self, $val) = @_;
59              
60 202 100       285 if (defined($val)) {
61 103         130 $self->{_value} = $val;
62 103         158 return; # Avoid evaluatig value too early
63             } else {
64 99         121 $val = $self->{_value};
65             }
66            
67 99 100       174 if (ref($val) eq 'CODE') {
68 1         2 $val = &$val;
69             }
70              
71 99 100       147 if (wantarray) {
72 2 50       13 if (ref($val) eq 'ARRAY') {
    50          
73 0         0 return @$val
74             } elsif (ref($val) eq 'HASH') {
75 0         0 return %$val
76             }
77             }
78            
79 99         300 return $val;
80             }
81              
82             =head2 bool = $node->is_leaf
83              
84             Returns false.
85              
86             =cut
87            
88 61     61 1 150 sub is_leaf { 1 };
89              
90 57     57 1 126 sub is_section { 0 }
91              
92             =head2 $s = $node->as_string
93              
94             Returns the node value, converted to string.
95              
96             =cut
97              
98             sub as_string {
99 8     8 1 14 my $val = shift->value;
100 8 50       19 if (ref($val) eq 'ARRAY') {
    50          
101 0 0       0 return @$val ? $val : '';
102             } elsif (ref($val) eq 'HASH') {
103 0 0       0 return keys %$val ? $val : '';
104             } else {
105 8         24 return $val;
106             }
107             }
108              
109             =head2 $s = $node->as_number
110              
111             Returns the node value, converted to number.
112              
113             If the value is an array, returns number of elements in the array.
114             If the value is a hash, returns number of keys.
115             Otherwise, returns the value itself.
116              
117             =cut
118              
119             sub as_number {
120 3     3 1 6 my $val = shift->value;
121 3 50       8 if (ref($val) eq 'ARRAY') {
    50          
122 0         0 return scalar @$val;
123             } elsif (ref($val) eq 'HASH') {
124 0         0 return keys %$val;
125             } else {
126 3         9 return $val;
127             }
128             }
129              
130             =head1 CONTEXT-SENSITIVE COERCIONS
131              
132             Depending on the context in which it is used, the B
133             is coerced to the most appropriate data type. For example, in the following
134             expression;
135              
136             if ($cf->getnode('offset') < 10) {
137             ...
138             }
139              
140             the value will be coerced to a number prior to comparison. This means that
141             in most cases you don't need to explicitly invoke the B method.
142              
143             =cut
144              
145             use overload
146             '""' => \&as_string,
147             '0+' => \&as_number,
148             '<=>' => sub {
149 2     2   10 my ($self, $other, $swap) = @_;
150 2         10 my $res = $self->as_number <=> $other;
151 2 100       8 return $swap ? - $res : $res;
152             },
153             'cmp' => sub {
154 1     1   3 my ($self, $other, $swap) = @_;
155 1         2 my $res = $self->as_string cmp "$other";
156 1 50       13 return $swap ? - $res : $res;
157             },
158 19     19   132 fallback => 1;
  19         39  
  19         179  
159            
160              
161             =head1 SEE ALSO
162              
163             L,
164             L.
165              
166             =cut
167              
168             1;