File Coverage

blib/lib/Config/Objective/String.pm
Criterion Covered Total %
statement 24 28 85.7
branch 6 12 50.0
condition 3 9 33.3
subroutine 7 8 87.5
pod 6 6 100.0
total 46 63 73.0


line stmt bran cond sub pod time code
1              
2             ###
3             ### Copyright 2002-2003 University of Illinois Board of Trustees
4             ### Copyright 2002-2003 Mark D. Roth
5             ### All rights reserved.
6             ###
7             ### Config::Objective::String - string data type for Config::Objective
8             ###
9             ### Mark D. Roth
10             ### Campus Information Technologies and Educational Services
11             ### University of Illinois at Urbana-Champaign
12             ###
13              
14              
15             package Config::Objective::String;
16              
17 1     1   690 use strict;
  1         2  
  1         44  
18              
19 1     1   6 use Config::Objective::DataType;
  1         2  
  1         435  
20              
21             our @ISA = qw(Config::Objective::DataType);
22              
23              
24             ###############################################################################
25             ### equals() method (for conditional expressions)
26             ###############################################################################
27              
28             sub equals
29             {
30 3     3 1 8 my ($self, $value) = @_;
31              
32             # print "==> equals(" . ref($self) . "='$self->{value}', '$value')\n";
33              
34 3         12 return ($self->{value} eq $value);
35             }
36              
37              
38             ###############################################################################
39             ### match() method (for conditional expressions)
40             ###############################################################################
41              
42             sub match
43             {
44 1     1 1 2 my ($self, $regex) = @_;
45              
46 1         16 return ($self->{value} =~ m/$regex/i);
47             }
48              
49              
50             ###############################################################################
51             ### set() method
52             ###############################################################################
53              
54             sub set
55             {
56 11     11 1 14 my ($self, $value) = @_;
57              
58             # print "==> String::set($value)\n";
59              
60 11 100       14 if (defined($value))
61             {
62 9 50       17 die "non-scalar value specified for string variable\n"
63             if (ref($value));
64              
65 9 50 66     28 die "value must be absolute path\n"
66             if ($self->{value_abspath}
67             && $value !~ m|^/|);
68             }
69             else
70             {
71 2 50       6 die "value required\n"
72             if (! $self->{value_optional});
73 2         11 $value = '';
74             }
75              
76 11         33 return $self->SUPER::set($value);
77             }
78              
79              
80             ###############################################################################
81             ### append() method - append new string to existing value
82             ###############################################################################
83              
84             sub append
85             {
86 1     1 1 2 my ($self, $value) = @_;
87              
88 1 50 33     7 die "non-scalar value specified for string variable\n"
89             if (defined($value) && ref($value));
90              
91 1         2 $self->{value} .= $value;
92              
93 1         3 return 1;
94             }
95              
96              
97             ###############################################################################
98             ### prepend() method - prepend new string to existing value
99             ###############################################################################
100              
101             sub prepend
102             {
103 0     0 1 0 my ($self, $value) = @_;
104              
105 0 0 0     0 die "non-scalar value specified for string variable\n"
106             if (defined($value) && ref($value));
107              
108 0         0 $self->{value} = $value . $self->{value};
109              
110 0         0 return 1;
111             }
112              
113              
114             ###############################################################################
115             ### gsub() method - substring replacement
116             ###############################################################################
117              
118             sub gsub
119             {
120 1     1 1 2 my ($self, $old, $new) = @_;
121              
122             # print "==> gsub(): value='$self->{value}' old='$old' new='$new'\n";
123              
124 1         14 $self->{value} =~ s/$old/$new/g;
125              
126 1         4 return 1;
127             }
128              
129              
130             ###############################################################################
131             ### cleanup and documentation
132             ###############################################################################
133              
134             1;
135              
136             __END__