File Coverage

blib/lib/WWW/Sitebase.pm
Criterion Covered Total %
statement 21 97 21.6
branch 0 24 0.0
condition 0 15 0.0
subroutine 7 15 46.6
pod 7 7 100.0
total 35 158 22.1


line stmt bran cond sub pod time code
1             package WWW::Sitebase;
2              
3 2     2   88396 use Spiffy -Base;
  2         6962  
  2         9  
4 2     2   5485 use Carp;
  2     2   2  
  2     2   37  
  2         6  
  2         6  
  2         34  
  2         6  
  2         1  
  2         83  
5 2     2   895 use Params::Validate;
  2         12173  
  2         89  
6 2     2   1174 use Config::General;
  2         36012  
  2         103  
7 2     2   781 use YAML qw'LoadFile DumpFile';
  2         10539  
  2         1310  
8              
9             =head1 NAME
10              
11             WWW::Sitebase - Base class for Perl modules
12              
13             =head1 VERSION
14              
15             Version 0.15
16              
17             =cut
18              
19             our $VERSION = '0.15';
20              
21             =head1 SYNOPSIS
22              
23             This is a base class that can be used for all Perl modules.
24             I could probably call it "Base" or somesuch, but that's a bit
25             too presumptious for my taste, so I just included it here.
26             You'll probably just use WWW::Sitebase::Navigator or WWW::Sitebase::Poster
27             instead, which subclass WWW::Sitebase.
28             WWW::Sitebase provides basic, standardized options parsing
29             in several formats. It validates data using Params::Validate, provides clean
30             OO programming using Spiffy, and reads config files using Config::General.
31             It gives your module a powerful "new" method that automatically
32             takes any fields your module supports as arguments or reads them from a
33             config file. It also provides your module with "save" and "load" methods.
34              
35              
36             To use this to write your new module, you simply subclass this module, add
37             the "default_options" method to define your data, and write your methods.
38              
39             package WWW::MySite::MyModule;
40             use WWW::Sitebase -Base;
41              
42             const default_options => {
43             happiness => 1, # Required
44             count => { default => 50 }, # Not required, defaults to 50
45             };
46              
47             field 'happiness';
48             field 'count';
49              
50             sub mymethod {
51             if ( $self->happiness ) { print "I'm happy" }
52             }
53              
54              
55             People can then call your method with:
56             $object = new WWW::MySite::MyModule( happiness => 5 );
57            
58             or
59            
60             $object = new WWW::MySite::MyModule( { happiness => 5 } );
61            
62             They can save their object to disk:
63             $object->save( $filename );
64            
65             And read it back:
66             $object = new WWW::MySite::MyModule();
67             $object->load( $filename );
68            
69             or since "save" writes a YAML file:
70             $object = new WWW::MySite::MyModule(
71             'config_file' => $filename, 'config_file_format' => 'YAML' );
72              
73             See Params::Validate for more info on the format of, and available
74             parsing stunts available in, default_options.
75            
76             =cut
77              
78             #
79             ######################################################################
80             # Setup
81              
82             ######################################################################
83             # Libraries we use
84              
85             ######################################################################
86             # new
87              
88             =head1 METHODS
89              
90             =head2 default_options
91              
92             This method returns a hashref of the available options and their default
93             values. The format is such that it can be passed to Params::Validate
94             (and, well it is :).
95              
96             You MUST override this method to return your default options.
97             Basically, you just have to do this:
98              
99             sub default_options {
100            
101             $self->{default_options}={
102             option => { default => value },
103             option => { default => value },
104             };
105            
106             return $self->{default_options};
107              
108             }
109              
110             The approach above lets your subclasses add more options if they need to.
111             it also sets the default_options parameter, and returns it so that
112             you can call $self->default_options instead of $self->{default_options}.
113              
114             =cut
115              
116             stub 'default_options';
117              
118             =head2 positional_parameters
119              
120             If you need to use positional paramteres, define a
121             "positional_parameters" method that returns a reference to a list of the
122             parameter names in order, like this:
123              
124             const positional_parameters => [ "username", "password" ];
125              
126             If the first argument to the "new" method is not a recognized option,
127             positional parameters will be used instead. So to have someone pass
128             a browser object followed by a hashref of options, you could do:
129              
130             const positional_parameters => [ 'browser', 'options' ];
131              
132             =cut
133              
134             stub 'positional_parameters';
135              
136             =head2 new
137              
138             Initialize and return a new object.
139              
140             We accept the following formats:
141              
142             new - Just creates and returns the new object.
143             new( $options_hashref )
144             new( %options );
145             new( @options ); - Each option passed is assigned in order to the keys
146             of the "DEFAULT_OPTIONS" hash.
147             new( 'config_file' => "/path/to/file", 'config_file_format' => 'YAML' );
148             - File format can be "YAML" (see YAML.pm) or "CFG" (see Config::General).
149             - Defaults to "YAML" if not specified.
150              
151             If you specify options and a config file, the config file will be read,
152             and any options you explicitly passed will override the options read from
153             the config file.
154              
155             =cut
156              
157             sub new() {
158              
159             # Set up the basic object
160 0     0 1   my $proto = shift;
161 0   0       my $class = ref($proto) || $proto;
162 0           my $self = {};
163              
164 0           bless( $self, $class );
165              
166             # Unless they passed some options, we're done.
167 0 0         return $self unless ( @_ );
168            
169             # Set the options they passed.
170 0           $self->set_options( @_ );
171              
172             # Done
173 0           return $self;
174              
175             }
176              
177             =head2 set_options
178              
179             Allows you to set additional options. This is called by the "new" method
180             to parse, validate, and set options into the object. You can call it
181             yourself if you want to, either to set the options, or to change them later.
182              
183             # Set up the object
184             $object->new( browser => $browser );
185            
186             # Read in a config file later.
187             $object->set_options( config_file => $user_config );
188              
189             This also lets you override options you supply directly with, say, a
190             user-supplied config file. Otherwise, the options passed to "new" would
191             override the config file.
192              
193             =cut
194              
195 0     0 1   sub set_options {
196              
197             # Figure out the paramter format and return a hash of option=>value pairs
198 0           my %options = $self->parse_options( @_ );
199              
200             # Validate the options
201 0           my @options = ();
202 0           foreach my $key ( keys %options ) {
203 0           push ( @options, $key, $options{$key} );
204             }
205              
206 0           %options = validate( @options, $self->default_options );
207              
208             # Copy them into $self
209 0           foreach my $key ( keys( %options ) ) {
210 0           $self->{"$key"} = $options{"$key"}
211             }
212            
213             }
214              
215             =head2 get_options
216              
217             General accessor method for all options.
218             Takes a list of options and returns their values.
219              
220             If called with one option, returns just the value.
221             If called with more than one option, returns a list of option => value
222             pairs (not necessarily in the order of your original list).
223             If called with no arguments, returns a list of all options and
224             their values (as option => value pairs).
225              
226             This is basically a "catch all" accessor method that allows you to be
227             lazy and not create accessors for your options.
228              
229             =cut
230              
231 0     0 1   sub get_options {
232              
233 0           my ( @options ) = @_;
234              
235             # If no options were specified, return them all
236 0 0         unless ( @options ) {
237 0           @options = keys( %{ $self->default_options } );
  0            
238             }
239              
240             # If there's only one value requested, return just it
241 0 0         return $self->{$options[0]} if ( @options == 1 );
242            
243             # Otherwise return a hash of option => value pairs.
244 0           my %ret_options = ();
245            
246 0           foreach my $option ( @options ) {
247 0 0         if ( $self->{ $option } ) {
248 0           $ret_options{ $option } = $self->{ $option };
249             } else {
250 0           croak "Invalid option passed to get_options";
251             }
252             }
253            
254 0           return ( %ret_options );
255              
256             }
257              
258             =head2 parse_options
259              
260             This method is called by set_options to determine the format of the options
261             passed and return a hash of option=>value pairs. If needed, you can
262             call it yourself using the same formats described in "new" above.
263              
264             $object->new;
265             $object->parse_options( 'username' => $username,
266             'config_file' => "/path/to/file" );
267              
268             =cut
269              
270 0     0 1   sub parse_options {
271              
272 0           my %options = ();
273              
274             # figure out the format
275             # - new( $options_hashref )
276 0 0 0       if ( ( @_ == 1 ) && ( ref $_[0] eq 'HASH') ) {
    0 0        
      0        
277 0           %options = %{ $_[0] };
  0            
278             # - new( %options )
279             # If more than 1 argument, and an even number of arguments, and
280             # the first argument is one of our known options.
281             } elsif ( ( @_ > 1 ) && ( @_ % 2 == 0 ) &&
282             ( defined( $self->default_options->{ "$_[0]" } ) ) ) {
283 0           %options = ( @_ );
284             # - new( @options )
285             # We just assign them in order.
286             } else {
287 0           foreach my $option ( @{ $self->positional_parameters } ) {
  0            
288 0           $options{"$option"} = shift;
289             }
290             }
291            
292             # If they passed a config file, read it
293 0 0         if ( exists $options{'config_file'} ) {
294 0           %options = $self->read_config_file( %options );
295             }
296            
297 0           return %options;
298              
299             }
300              
301             =head2 read_config_file
302              
303             This method is called by parse_options. If a "config_file" argument is
304             passed, this method is used to read options from it. Currently supports
305             CFG and YAML formats.
306              
307             =cut
308              
309 0     0 1   sub read_config_file {
310              
311 0           my ( %options ) = @_;
312            
313 0           my %config;
314              
315             # XXX CFG reads into a hash, YAML reads into a hashref.
316             # This is a bit unstable, but YAML's file looks weird if you
317             # just dump a hash to it, and hashrefs are better anyway.
318 0 0 0       if ( ( defined $options{'config_file_format'} ) &&
319             ( $options{'config_file_format'} eq "CFG" ) ) {
320             # Read CFG-file format
321 0           my $conf = new Config::General( $options{'config_file'} );
322 0           %config = $conf->getall;
323             } else {
324             # Default to YAML format
325 0           my $config = LoadFile( $options{'config_file'} );
326 0           %config = %{ $config };
  0            
327             }
328            
329             # Copy the config file into the options hashref.
330             # Existing params override the config file
331 0           foreach my $key ( keys %config ) {
332 0 0         unless ( exists $options{"$key"} ) {
333 0           $options{"$key"} = $config{"$key"};
334             }
335             }
336              
337 0           return %options;
338            
339             }
340              
341             =head2 save( filename )
342              
343             Saves the object to the file specified by "filename".
344             Saves every field specified in the default_options and
345             positional_parameters methods.
346              
347             =cut
348              
349 0     0 1   sub save {
350              
351 0           my $filename = shift;
352 0           my $data = {};
353              
354             # For each field listed as persistent, store it in the
355             # hash of data that's going to be saved.
356 0           foreach my $key ( ( keys( %{ $self->default_options } ),
  0            
357 0           @{ $self->positional_parameters } ) ) {
358 0 0         unless ( $self->_nosave( $key ) ) {
359             # IMPORTANT: Only save what's defined or we'll
360             # break defaults.
361 0 0         if ( exists $self->{$key} ) {
362 0           ${$data}{$key} = $self->{$key}
  0            
363             }
364             }
365             }
366              
367 0           DumpFile( $filename, $data );
368              
369             }
370              
371             =head2 _nosave( fieldname )
372              
373             Override this method in your base class if there are fields you
374             don't want the save command to save. Otherwise, all fields specified in
375             your default_options and postitional_parameters will be saved.
376              
377             _nosave is passed a field name. Return 1 if you don't want it saved.
378             Return 0 if you want it saved. The stub method just returns 0.
379              
380             Sample _nosave method:
381             sub _nosave {
382              
383             my ( $key ) = @_;
384              
385             # List only fields you don't want saved
386             my %fields = ( fieldname => 1, fieldname2 => 1 );
387              
388             if ( $key && ( $fields{"$key"} ) ) { return 1 } else { return 0 }
389              
390             }
391              
392             =cut
393              
394 0     0     sub _nosave { return 0 }
  0            
395              
396             =head2 load( filename )
397              
398             Loads a message in YAML format (i.e. as saved by the save method)
399             from the file specified by filename.
400              
401             =cut
402              
403 0     0 1   sub load {
404              
405 0           my ( $file ) = @_;
406 0           my $data = {};
407            
408 0           ( $data ) = LoadFile( $file );
409              
410             # For security we only loop through fields we know are
411             # persistent. If there's a stored value for that field, we
412             # load it in.
413 0           foreach my $key ( ( keys( %{ $self->default_options } ),
  0            
414 0           @{ $self->positional_parameters } ) ) {
415 0 0         if ( exists ${$data}{$key} ) {
  0            
416 0           $self->{$key} = ${$data}{$key}
  0            
417             }
418             }
419            
420             }
421              
422             =pod
423              
424             =head1 AUTHOR
425              
426             Grant Grueninger, C<< >>
427              
428             =head1 BUGS
429              
430             Please report any bugs or feature requests to
431             C, or through the web interface at
432             L.
433             I will be notified, and then you'll automatically be notified of progress on
434             your bug as I make changes.
435              
436             =head1 NOTES
437              
438             You currently have to both specify the options in default_options and
439             create accessor methods for those you want accessor methods for
440             (i.e. all of them). This should be made less redundant.
441              
442             We probably want to include cache_dir and possibile cache_file methods here.
443              
444             =head1 TO DO
445              
446             =head1 SUPPORT
447              
448             You can find documentation for this module with the perldoc command.
449              
450             perldoc WWW::Sitebase
451              
452             You can also look for information at:
453              
454             =over 4
455              
456             =item * AnnoCPAN: Annotated CPAN documentation
457              
458             L
459              
460             =item * CPAN Ratings
461              
462             L
463              
464             =item * RT: CPAN's request tracker
465              
466             L
467              
468             =item * Search CPAN
469              
470             L
471              
472             =back
473              
474             =head1 ACKNOWLEDGEMENTS
475              
476             =head1 COPYRIGHT & LICENSE
477              
478             Copyright 2005, 2014 Grant Grueninger, all rights reserved.
479              
480             This program is free software; you can redistribute it and/or modify it
481             under the same terms as Perl itself.
482              
483             =cut
484              
485             1; # End of WWW::Sitebase