File Coverage

blib/lib/WebFetch/Data/Config.pm
Criterion Covered Total %
statement 42 45 93.3
branch 11 14 78.5
condition n/a
subroutine 11 11 100.0
pod 0 5 0.0
total 64 75 85.3


line stmt bran cond sub pod time code
1             # WebFetch::Data::Config
2             # ABSTRACT: WebFetch configuration data management
3             #
4             # Copyright (c) 2022 Ian Kluft. This program is free software; you can
5             # redistribute it and/or modify it under the terms of the GNU General Public
6             # License Version 3. See https://www.gnu.org/licenses/gpl-3.0-standalone.html
7             #
8             # WebFetch::Data::Config contains configuration data for the WebFetch class hierarchy.
9             # It was made to replace older-generation code which depended on subclasses defining
10             # package variables. That is no longer considered good practice. This uses the singleton
11             # design pattern to maintain a simple key/value store for configuration data.
12              
13             # pragmas to silence some warnings from Perl::Critic
14             ## no critic (Modules::RequireExplicitPackage)
15             # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first
16 6     6   1291 use strict;
  6         19  
  6         190  
17 6     6   48 use warnings;
  6         23  
  6         147  
18 6     6   32 use utf8;
  6         20  
  6         72  
19             ## use critic (Modules::RequireExplicitPackage)
20              
21             package WebFetch::Data::Config;
22             $WebFetch::Data::Config::VERSION = '0.15.9';
23 6     6   364 use Carp qw(croak confess);
  6         28  
  6         422  
24 6     6   46 use base 'Class::Singleton';
  6         13  
  6         3432  
25              
26             # helper function to allow methods to get the singleton instance whether called as a class or instance method
27             sub _class_or_obj
28             {
29 2381     2381   3091 my $coo = shift; # coo = class or object
30              
31             # safety net: all-stop if we received an undef
32 2381 50       3972 if ( not defined $coo ) {
33 0         0 confess "coo got undef from:" . ( join "|", caller 1 );
34             }
35              
36             # safety net: the class or object must be WebFetch::Data::Config or a derivative
37 2381 50       5145 if ( not $coo->isa("WebFetch::Data::Config") ) {
38 0         0 confess "incompatible class $coo from:" . ( join "|", caller 1 );
39             }
40              
41             # instance method if it got an object reference
42 2381 100       4487 return $coo if ref $coo;
43              
44             # class method: return the instance via the instance() class method
45             # if the singleton object wasn't already instantiated, this will take care of it
46             # assumption: it must be string name of class WebFetch::Data::Config or subclass of it - so it has instance()
47 809         1658 return $coo->instance();
48             }
49              
50             # check for existence of a config entry
51             sub contains
52             {
53 803     803 0 12600 my ( $class_or_obj, $key ) = @_;
54 803         1187 my $instance = _class_or_obj($class_or_obj);
55 803 100       2433 return exists $instance->{$key} ? 1 : 0;
56             }
57              
58             # configuration read accessor
59             sub read_accessor
60             {
61 753     753 0 1214 my ( $class_or_obj, $key ) = @_;
62 753         1076 my $instance = _class_or_obj($class_or_obj);
63 753 100       1271 if ( $instance->contains($key) ) {
64 736         2465 return $instance->{$key};
65             }
66 17         69 return;
67             }
68              
69             # configuration write accessor
70             sub write_accessor
71             {
72 30     30 0 59 my ( $class_or_obj, $key, $value ) = @_;
73 30         57 my $instance = _class_or_obj($class_or_obj);
74 30         72 $instance->{$key} = $value;
75 30         56 return;
76             }
77              
78             # configuration read/write accessor
79             # WebFetch's config() method calls here
80             sub accessor
81             {
82 783     783 0 1604 my ( $class_or_obj, $key, $value ) = @_;
83 783         1196 my $instance = _class_or_obj($class_or_obj);
84              
85             # if no value is provided, use read accessor
86 783 100       6281 if ( not defined $value ) {
87 753         1266 return $instance->read_accessor($key);
88             }
89              
90             # otherwise use write accessor
91 30         81 $instance->write_accessor( $key, $value );
92 30         85 return;
93             }
94              
95             # delete configuration item
96             sub del
97             {
98 12     12 0 6817 my ( $class_or_obj, $key ) = @_;
99 12         31 my $instance = _class_or_obj($class_or_obj);
100 12 50       92 if ( $instance->contains($key) ) {
101 12         63 return delete $instance->{$key};
102             }
103 0           return;
104             }
105              
106             1;
107              
108             __END__
109              
110             =pod
111              
112             =encoding UTF-8
113              
114             =head1 NAME
115              
116             WebFetch::Data::Config - WebFetch configuration data management
117              
118             =head1 VERSION
119              
120             version 0.15.9
121              
122             =head1 SYNOPSIS
123              
124             In all classes other than WebFetch, use WebFetch's config() and has_config() class methods.
125              
126             use WebFetch;
127             # ...
128             WebFetch->config($key, $write_value);
129             my $read_value = WebFetch->config($key);
130             my $bool_value = WebFetch->has_config($key);
131             my $del_value = WebFetch->del_config($key);
132              
133             From within WebFetch, class or instance methods may be used interchangeably.
134              
135             use WebFetch::Data::Config;
136             WebFetch::Data::Config->instance(@params); # instantiate singleton with optional initalization data
137             #...
138             my $config_instance = WebFetch::Data::Config->instance();
139             #...
140             $config_instance->write_accessor($key, $write_value);
141             my $read_value = $config_instance->read_accessor($key);
142             my $bool_value = $config_instance->contains($key);
143             my $del_value = $config_instance->del($key);
144             # or
145             WebFetch::Data::Config->accessor($key, $write_value);
146             my $read_value = WebFetch::Data::Config->accessor($key);
147             my $bool_value = WebFetch::Data::Config->contains($key);
148             my $del_value = WebFetch::Data::Config->del($key);
149              
150             =head1 DESCRIPTION
151              
152             WebFetch::Data::Config is a key/value store for global WebFetch configuration data.
153             The methods of this class should only be called from WebFetch.
154             Otherwise use the config() and has_config() class methods provided by WebFetch to access it.
155              
156             =head1 SEE ALSO
157              
158             L<WebFetch>
159             L<https://github.com/ikluft/WebFetch>
160              
161             =head1 BUGS AND LIMITATIONS
162              
163             Please report bugs via GitHub at L<https://github.com/ikluft/WebFetch/issues>
164              
165             Patches and enhancements may be submitted via a pull request at L<https://github.com/ikluft/WebFetch/pulls>
166              
167             =head1 AUTHOR
168              
169             Ian Kluft <https://github.com/ikluft>
170              
171             =head1 COPYRIGHT AND LICENSE
172              
173             This software is Copyright (c) 1998-2023 by Ian Kluft.
174              
175             This is free software, licensed under:
176              
177             The GNU General Public License, Version 3, June 2007
178              
179             =cut