/usr/share/perl5/ConfigReader/Values.pm is in libconfigreader-perl 0.5-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | # ConfigReader/Values.pm: stores a set of configuration values
#
# Copyright 1996 by Andrew Wilcox <awilcox@world.std.com>.
# All rights reserved.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this library; if not, write to the Free
# Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
package ConfigReader::Values;
$VERSION = "0.5";
require ConfigReader::Spec;
use strict;
=head1 NAME
ConfigReader::Values - stores a set of configuration values
=head1 DESCRIPTION
This class stores a set of configuration values that have been read
from a configuration file. Methods are provided to define directives,
assign and retrieve values, and to create accessor subroutines.
As this class will usually be subclassed to implement a reader for a
specific style of configuration files, the user-oriented methods will be
described first. Methods used to help implement a subclass are
described later.
=head1 USER METHODS
=head2 C<directive($directive, [$parser, [$default, [$whence]]])>
Defines a directive named $directive for the configuration file. You
may optionally specify a parsing function or method for the directive,
and a default value.
If $directive is a simple string, it will be used as both the name of
the directive inside of the program and in the configuration file.
You can use an array ref of the form
['program-name', 'name1', 'name2', 'name3' ...]
to use 'program-name' inside of the program, but to recognize any of
'name1', 'name2', 'name3' as the name of directive in the
configuration file.
A directive will be set to undef if you don't specify a default value
and it is not set in the configuration file.
Any errors or warnings that occur while parsing the default value are
normally reported as orginating in the caller's module. You can
change the reported location by specifying $whence.
=cut
sub directive {
my ($self, $directive, $parser, $default, $whence) = @_;
unless (defined $whence) {
my ($package, $filename, $line) = caller;
$whence = "at $filename line $line";
}
return $self->{'spec'}->directive($directive, $parser, $default, $whence);
}
=head2 C<required($directive, [$parser, [$whence]])>
Defines a directive which must be specified in the configuration file.
=cut
sub required { my $s = shift; $s->{'spec'}->required(@_); }
=head2 C<ignore($directive, [$whence])>
Defines a directive which will be accepted but ignored in the
configuration file.
=cut
sub ignore { my $s = shift; $s->{'spec'}->ignore(@_); }
=head2 C<directives()>
Returns an array of the configuration directive names.
=cut
sub directives { my $s = shift; $s->{'spec'}->directives(@_); }
=head2 C<value($directive, [$whence])>
Returns the value of the configuration directive $directive.
=cut
sub value {
my ($self, $directive, $whence) = @_;
unless (defined $whence) {
my ($package, $filename, $line) = caller;
$whence = "at $filename line $line";
}
my $spec = $self->{'spec'};
my $values = $self->{'values'};
return $spec->value($directive, $values, $whence);
}
=head2 C<define_accessors([$package, [@names]])>
Creates subroutines in the caller's package to access configuration
values. For example, if one of the configuration directives is named
"Input_File", you can do:
$config->define_accessors();
...
open(IN, Input_File());
The names of the created subroutines is returned in an array. If
you'd like to export the accessor subroutines, you can say:
push @EXPORT, $config->define_accessors();
You can specify the package in which to create the subroutines with the
optional $package argument. You may also specify which configuration
directives to create accessor subroutines for. By default,
subroutines will be created for all the directives.
=cut
sub define_accessors {
my ($self, $package, @names) = @_;
@names = $self->directives() unless @names;
$package = (caller)[0] unless defined $package;
my $name;
foreach $name (@names) {
$self->_define_accessor($name, $package);
}
@names;
}
sub _define_accessor {
my ($self, $name, $package) = @_;
$package = (caller)[0] unless defined $package;
no strict 'refs';
*{ $package . "::" . $name } = $self->_make_accessor($name);
return $name;
}
sub _make_accessor {
my ($self, $name) = @_;
return sub {
my ($package, $filename, $line) = caller;
$self->value($name, "at $filename line $line")
};
}
=head1 IMPLEMENTATION METHODS
The following methods will probably be called by a subclass
implementing a reader for a particular style of configuration files.
=head2 new( [$spec] )
The static method new() creates and returns a new ConfigReader::Values
object.
Unless the optional $spec argument is present, a new
ConfigReader::Spec object will be created to store the configuration
specification. The directive(), required(), ignore(), value(), and
directive() methods described above are passed through to the spec
object.
By setting $spec, you can use a different class (perhaps a subclass)
to store the specification.
You can also set $spec if you want to use one specification for
multiple sets of values. Files like /etc/termcap describe a
configuration for multiple objects (terminals, in this case), but use
the same directives to describe each object.
=cut
sub new {
my ($class, $spec) = @_;
$spec = new ConfigReader::Spec unless defined $spec;
my $self = {spec => $spec,
values => {}};
return bless $self, $class;
}
=head2 C<values()>
Returns the hash ref which actually stores the configuration directive
values. The key of the hash ref is the directive name.
=cut
sub values {
my ($self) = @_;
return $self->{'values'};
}
=head2 C<spec()>
Returns the internal spec object used to store the configuration
specification.
=cut
sub spec {
my ($self) = @_;
return $self->{'spec'};
}
=head2 C<assign($directive, $value_string, $whence)>
Normally called while reading the configuration file, assigns a value
to the directive named $directive. The $value_string will be parsed
by the directive's parsing function or method, if any. $whence should
describe the line in the configuration file which contained the value
string.
=cut
sub assign {
my ($self, $directive, $value_string, $whence) = @_;
my $spec = $self->{'spec'};
my $values = $self->{'values'};
return $spec->assign($directive, $value_string, $values, $whence);
}
=head2 C<assign_defaults($whence)>
After the configuration file is read, the assign_defaults() method is
called to assign the default values for directives which were not
specified in the configuration file. $whence should describe the name
of the configuration file.
=cut
sub assign_defaults {
my ($self, $whence) = @_;
my $values = $self->{'values'};
my $spec = $self->{'spec'};
return $spec->assign_defaults($values, $whence);
}
1;
|