File Coverage

lib/Ubic/Settings/ConfigFile.pm
Criterion Covered Total %
statement 9 32 28.1
branch 0 14 0.0
condition n/a
subroutine 3 5 60.0
pod 2 2 100.0
total 14 53 26.4


line stmt bran cond sub pod time code
1             package Ubic::Settings::ConfigFile;
2             $Ubic::Settings::ConfigFile::VERSION = '1.60';
3 26     26   81 use strict;
  26         21  
  26         1103  
4 26     26   69 use warnings;
  26         21  
  26         494  
5              
6             # ABSTRACT: single ubic config file
7              
8              
9 26     26   71 use Params::Validate qw(:all);
  26         20  
  26         10612  
10              
11             sub read {
12 0     0 1   my ($class, $file) = validate_pos(@_, 1, { type => SCALAR });
13 0 0         unless (-e $file) {
14 0           die "Config file '$file' not found";
15             }
16              
17 0 0         open my $fh, '<', $file or die "Can't open '$file': $!";
18              
19 0           my $config = {};
20 0           while (my $line = <$fh>) {
21 0           chomp $line;
22 0           my ($key, $value) = $line =~ /^(\w+)\s*=\s*(.*)$/;
23 0           $config->{$key} = $value;
24             }
25              
26 0 0         close $fh or die "Can't close '$file': $!";
27              
28 0           return $config;
29             }
30              
31             sub write {
32 0     0 1   my ($class, $file, $config) = validate_pos(@_, 1, { type => SCALAR }, { type => HASHREF });
33              
34 0           my $content = "";
35              
36 0           for my $key (sort keys %$config) {
37 0           my $value = $config->{$key};
38 0 0         if ($value =~ /\n/) {
39 0           die "Invalid config line '$key = $value', values can't contain line breaks";
40             }
41 0           $content .= "$key = $value\n";
42             }
43              
44             # we open file after content is prepared, so that file is not removed if something fails
45             # TODO - should we write to tmp file first?
46 0 0         open my $fh, '>', $file or die "Can't open '$file': $!";
47 0 0         print {$fh} $content or die "Can't write to '$file': $!; sorry, old config removed!";
  0            
48 0 0         close $fh or die "Can't close '$file': $!";
49              
50 0           return;
51             }
52              
53              
54             1;
55              
56             __END__