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   69222 use Config::Param;
  1         4  
  1         37  
4 1     1   513 use IO::File;
  1         8565  
  1         113  
5 1     1   648 use Storable qw(dclone);
  1         3194  
  1         539  
6              
7             our $VERSION = '4.000005'; # updated by release script
8             $VERSION = eval $VERSION;
9              
10             sub new
11             {
12 1     1 1 967 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         2 $self->{pardef} = shift;
18 1         8 $self->{pars} = Config::Param->new($self->{config},$self->{pardef});
19 1         43 $self->{defpars} = dclone($self->{pars}{param});
20 1         5 return $self;
21             }
22              
23             sub init_with_args
24             {
25 1     1 1 13 my $self = shift;
26 1         2 my $args = shift;
27 1 50       5 $args = \@ARGV unless defined $args;
28 1         6 $self->{pars}->parse_args($args);
29 1         5 $self->{pars}->use_config_files();
30 1         4 $self->{pars}->apply_args();
31 1         1 my $good = (not @{$self->{pars}{errors}});
  1         7  
32 1         4 $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         50 $self->{defpars} = dclone($self->{pars}{param});
40             }
41              
42             sub load_defaults
43             {
44 1     1 1 907 my $self = shift;
45 1         28 $self->{pars}{param} = dclone($self->{defpars});
46             }
47              
48             sub param
49             {
50 7     7 1 1290 my $self = shift;
51             # Yes, it's a direct reference.
52 7         292 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         4  
61 1         3 $self->{pars}{errors} = [];
62 1         2 return $good;
63             }
64              
65             sub store_file
66             {
67 1     1 1 905 my $self = shift;
68 1         3 my $file = shift;
69 1 50 33     7 $file = undef if defined $file and $file eq '';
70 1         5 my $fh = \*STDOUT;
71 1 50       3 if(defined $file)
72             {
73 1         8 $fh = IO::File->new();
74 1 50       48 $fh->open($file, '>') or return 0;
75             }
76 1         157 $self->{pars}->print_file($fh);
77 1         12 $fh->close();
78 1         57 my $good = (not @{$self->{pars}{errors}});
  1         5  
79 1         4 $self->{pars}{errors} = [];
80 1         4 return $good;
81             }
82              
83             1;
84              
85             __END__