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   12901783 use warnings;
  25         226  
  25         1385  
4 25     25   209 use strict;
  25         97  
  25         919  
5 25     25   152 use Carp;
  25         68  
  25         2833  
6              
7             our $VERSION = 'v2.3.8';
8              
9 25     25   13317 use Export::Attrs;
  25         200758  
  25         155  
10 25     25   9768 use Narada;
  25         67  
  25         950  
11 25     25   795 use Path::Tiny 0.053;
  25         11837  
  25         2318  
12              
13 25   100 25   181 use constant NARADA => eval { local $SIG{__DIE__}; Narada::detect() } || q{};
  25         51  
  25         47  
14 25     25   177 use constant DB_DIR => NARADA eq 'narada-1' ? 'db' : 'mysql';
  25         53  
  25         1173  
15 25     25   140 use constant MAXPERM => 0666; ## no critic (ProhibitLeadingZeros)
  25         50  
  25         7788  
16              
17             my $VAR_NAME = qr{\A(?:(?![.][.]?/)[\w.-]+/)*(?![.][.]?\z)[\w.-]+\z}xms;
18              
19              
20             sub get_config :Export {
21 92     92 1 43213 my ($var) = @_;
22 92 100       306 croak 'Usage: get_config(NAME)' if @_ != 1;
23 88 100       1054 $var =~ /$VAR_NAME/xms or croak "Bad config: $var";
24 62         118 return undef if !NARADA; ## no critic (ProhibitExplicitReturnUndef)
25 59         306 return path("config/$var")->slurp_utf8;
26 25     25   181 }
  25         43  
  25         201  
27              
28             sub get_config_line :Export {
29 30     30 1 11513 my ($val) = get_config(@_);
30 28 100       8647 return $val if !defined $val;
31 26         150 $val =~ s/\n\s*\z//xms;
32 26 100       100 croak 'Config contain more than one line' if $val =~ /\n/xms;
33 24         132 return $val;
34 25     25   7688 }
  25         93  
  25         103  
35              
36             sub get_db_config :Export {
37 1     1 1 712 my %db;
38 1         2 $db{db} = eval { get_config_line(DB_DIR.'/db') };
  1         4  
39 1 50 33     6 if (!defined $db{db} || !length $db{db}) {
40 1         4 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   10165 }
  25         56  
  25         112  
52              
53             sub set_config :Export {
54 39     39 1 29130 my ($var, $val) = @_;
55 39 100       192 croak 'Usage: set_config(NAME, VALUE)' if @_ != 2;
56 33 100       491 $var =~ /$VAR_NAME/xms or croak "Bad config: $var";
57 11         39 croak 'Narada::Config was loaded not in narada directory' if !NARADA;
58 10         105 my $cfg = path("config/$var");
59 10         664 $cfg->parent->mkpath;
60 10         2526 $cfg->spew_utf8($val);
61 10         8185 $cfg->chmod(MAXPERM & ~umask);
62 10         370 return;
63 25     25   9064 }
  25         98  
  25         159  
64              
65              
66             1; # Magic true value required at end of module
67             __END__