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   54313 use Config::Param;
  1         2  
  1         56  
4 1     1   386 use IO::File;
  1         7242  
  1         93  
5 1     1   548 use Storable qw(dclone);
  1         2558  
  1         470  
6              
7             our $VERSION = '4.000004'; # updated by release script
8             $VERSION = eval $VERSION;
9              
10             sub new
11             {
12 1     1 1 777 my $class = shift;
13 1         2 my $self = {};
14 1         2 bless $self, $class;
15 1         5 $self->{config} = shift;
16 1         3 $self->{config}{nofinals} = 1;
17 1         2 $self->{pardef} = shift;
18 1         5 $self->{pars} = Config::Param->new($self->{config},$self->{pardef});
19 1         40 $self->{defpars} = dclone($self->{pars}{param});
20 1         4 return $self;
21             }
22              
23             sub init_with_args
24             {
25 1     1 1 6 my $self = shift;
26 1         1 my $args = shift;
27 1 50       4 $args = \@ARGV unless defined $args;
28 1         3 $self->{pars}->parse_args($args);
29 1         4 $self->{pars}->use_config_files();
30 1         4 $self->{pars}->apply_args();
31 1         2 my $good = (not @{$self->{pars}{errors}});
  1         2  
32 1         3 $self->{pars}{errors} = [];
33 1         2 return $good;
34             }
35              
36             sub store_defaults
37             {
38 1     1 1 4 my $self = shift;
39 1         34 $self->{defpars} = dclone($self->{pars}{param});
40             }
41              
42             sub load_defaults
43             {
44 1     1 1 913 my $self = shift;
45 1         23 $self->{pars}{param} = dclone($self->{defpars});
46             }
47              
48             sub param
49             {
50 7     7 1 1314 my $self = shift;
51             # Yes, it's a direct reference.
52 7         217 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 864 my $self = shift;
68 1         3 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       3 if(defined $file)
72             {
73 1         6 $fh = IO::File->new();
74 1 50       37 $fh->open($file, '>') or return 0;
75             }
76 1         98 $self->{pars}->print_file($fh);
77 1         9 $fh->close();
78 1         51 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__