File Coverage

blib/lib/Narada/Config.pm
Criterion Covered Total %
statement 63 72 87.5
branch 13 18 72.2
condition 3 9 33.3
subroutine 17 17 100.0
pod 4 4 100.0
total 100 120 83.3


line stmt bran cond sub pod time code
1             package Narada::Config;
2              
3 25     25   12514130 use warnings;
  25         47  
  25         1225  
4 25     25   141 use strict;
  25         53  
  25         607  
5 25     25   129 use Carp;
  25         48  
  25         2473  
6              
7             our $VERSION = 'v2.3.6';
8              
9 25     25   14968 use Export::Attrs;
  25         202007  
  25         168  
10 25     25   9760 use Narada;
  25         56  
  25         927  
11 25     25   974 use Path::Tiny 0.053;
  25         13518  
  25         2164  
12              
13 25   100 25   125 use constant NARADA => eval { local $SIG{__DIE__}; Narada::detect() } || q{};
  25         48  
  25         39  
14 25     25   124 use constant DB_DIR => NARADA eq 'narada-1' ? 'db' : 'mysql';
  25         44  
  25         1141  
15 25     25   96 use constant MAXPERM => 0666; ## no critic (ProhibitLeadingZeros)
  25         55  
  25         29578  
16              
17             my $VAR_NAME = qr{\A(?:(?![.][.]?/)[\w.-]+/)*(?![.][.]?\z)[\w.-]+\z}xms;
18              
19              
20             sub get_config :Export {
21 92     92 1 32847 my ($var) = @_;
22 92 100       337 croak 'Usage: get_config(NAME)' if @_ != 1;
23 88 100       1030 $var =~ /$VAR_NAME/xms or croak "Bad config: $var";
24 62         72 return undef if !NARADA; ## no critic (ProhibitExplicitReturnUndef)
25 59         283 return path("config/$var")->slurp_utf8;
26 25     25   149 }
  25         33  
  25         157  
27              
28             sub get_config_line :Export {
29 30     30 1 10670 my ($val) = get_config(@_);
30 28 100       7523 return $val if !defined $val;
31 26         133 $val =~ s/\n\s*\z//xms;
32 26 100       103 croak 'Config contain more than one line' if $val =~ /\n/xms;
33 24         115 return $val;
34 25     25   7901 }
  25         53  
  25         105  
35              
36             sub get_db_config :Export {
37 1     1 1 617 my %db;
38 1         2 $db{db} = eval { get_config_line(DB_DIR.'/db') };
  1         3  
39 1 50 33     7 if (!defined $db{db} || !length $db{db}) {
40 1         5 return;
41             }
42 0         0 $db{login}= get_config_line(DB_DIR.'/login');
43 0         0 $db{pass} = get_config_line(DB_DIR.'/pass');
44 0   0     0 $db{host} = eval { get_config_line(DB_DIR.'/host') } || q{};
45 0   0     0 $db{port} = eval { get_config_line(DB_DIR.'/port') } || q{};
46 0         0 $db{dsn_nodb} = 'dbi:mysql:';
47 0 0       0 $db{dsn_nodb} .= ';host='.$db{host} if $db{host}; ## no critic (ProhibitPostfixControls)
48 0 0       0 $db{dsn_nodb} .= ';port='.$db{port} if $db{port}; ## no critic (ProhibitPostfixControls)
49 0         0 $db{dsn} = $db{dsn_nodb}.';database='.$db{db};
50 0         0 return \%db;
51 25     25   9047 }
  25         53  
  25         94  
52              
53             sub set_config :Export {
54 39     39 1 28301 my ($var, $val) = @_;
55 39 100       254 croak 'Usage: set_config(NAME, VALUE)' if @_ != 2;
56 33 100       656 $var =~ /$VAR_NAME/xms or croak "Bad config: $var";
57 11         46 croak 'Narada::Config was loaded not in narada directory' if !NARADA;
58 10         95 my $cfg = path("config/$var");
59 10         553 $cfg->parent->mkpath;
60 10         2313 $cfg->spew_utf8($val);
61 10         9402 $cfg->chmod(MAXPERM & ~umask);
62 10         498 return;
63 25     25   8342 }
  25         37  
  25         104  
64              
65              
66             1; # Magic true value required at end of module
67             __END__