File Coverage

blib/lib/Config/Param/FileWorker.pm
Criterion Covered Total %
statement 54 54 100.0
branch 4 8 50.0
condition 1 3 33.3
subroutine 10 10 100.0
pod 7 7 100.0
total 76 82 92.6


line stmt bran cond sub pod time code
1             package Config::Param::FileWorker;
2              
3 1     1   50973 use Config::Param;
  1         3  
  1         32  
4 1     1   464 use IO::File;
  1         6545  
  1         92  
5 1     1   557 use Storable qw(dclone);
  1         2475  
  1         430  
6              
7             our $VERSION = '4.000003'; # updated by release script
8             $VERSION = eval $VERSION;
9              
10             sub new
11             {
12 1     1 1 4467 my $class = shift;
13 1         3 my $self = {};
14 1         3 bless $self, $class;
15 1         7 $self->{config} = shift;
16 1         3 $self->{config}{nofinals} = 1;
17 1         3 $self->{pardef} = shift;
18 1         7 $self->{pars} = Config::Param->new($self->{config},$self->{pardef});
19 1         56 $self->{defpars} = dclone($self->{pars}{param});
20 1         9 return $self;
21             }
22              
23             sub init_with_args
24             {
25 1     1 1 7 my $self = shift;
26 1         2 my $args = shift;
27 1 50       3 $args = \@ARGV unless defined $args;
28 1         7 $self->{pars}->parse_args($args);
29 1         5 $self->{pars}->use_config_files();
30 1         7 $self->{pars}->apply_args();
31 1         2 my $good = (not @{$self->{pars}{errors}});
  1         3  
32 1         2 $self->{pars}{errors} = [];
33 1         3 return $good;
34             }
35              
36             sub store_defaults
37             {
38 1     1 1 6 my $self = shift;
39 1         38 $self->{defpars} = dclone($self->{pars}{param});
40             }
41              
42             sub load_defaults
43             {
44 1     1 1 743 my $self = shift;
45 1         23 $self->{pars}{param} = dclone($self->{defpars});
46             }
47              
48             sub param
49             {
50 7     7 1 1363 my $self = shift;
51             # Yes, it's a direct reference.
52 7         194 return $self->{pars}{param};
53             }
54              
55             sub load_file
56             {
57 1     1 1 4 my $self = shift;
58 1         2 my $file = shift;
59 1         5 $self->{pars}->parse_file($file);
60 1         2 my $good = (not @{$self->{pars}{errors}});
  1         3  
61 1         2 $self->{pars}{errors} = [];
62 1         3 return $good;
63             }
64              
65             sub store_file
66             {
67 1     1 1 709 my $self = shift;
68 1         2 my $file = shift;
69 1 50 33     6 $file = undef if defined $file and $file eq '';
70 1         2 my $fh = \*STDOUT;
71 1 50       4 if(defined $file)
72             {
73 1         10 $fh = IO::File->new();
74 1 50       49 $fh->open($file, '>') or return 0;
75             }
76 1         115 $self->{pars}->print_file($fh);
77 1         10 $fh->close();
78 1         53 my $good = (not @{$self->{pars}{errors}});
  1         4  
79 1         3 $self->{pars}{errors} = [];
80 1         5 return $good;
81             }
82              
83             1;
84              
85             __END__