File Coverage

blib/lib/App/Xssh/Config.pm
Criterion Covered Total %
statement 61 62 98.3
branch 15 18 83.3
condition n/a
subroutine 13 13 100.0
pod 5 5 100.0
total 94 98 95.9


line stmt bran cond sub pod time code
1             package App::Xssh::Config;
2              
3 6     6   88268 use strict;
  6         21  
  6         182  
4 6     6   31 use warnings;
  6         12  
  6         150  
5              
6 6     6   586 use Moose;
  6         468387  
  6         55  
7 6     6   50778 use Config::General;
  6         97668  
  6         387  
8              
9 6     6   3023 use version; our $VERSION = qv("v1.1.0");
  6         11131  
  6         38  
10              
11             =head1 NAME
12              
13             App::Xssh::Config - Encapsulates the configuration for xssh - using Config::General
14              
15             =head1 SYNOPSYS
16              
17             use App::Xssh::Config;
18            
19             my $config = App::Xssh::Config->new();
20             my $data = $config->read();
21            
22             $config->add(["location","path","setting"],"value");
23              
24             print $config->show();
25             $config->write();
26             =cut
27              
28             =head1 METHODS
29              
30             =over
31              
32             =item new()
33              
34             Construcor, just used to provide an object with access to the methods
35             =cut
36              
37             sub _configFilename {
38 15     15   2269 return "$ENV{HOME}/.xsshrc";
39             }
40              
41             sub _openConfig {
42 13     13   24 my ($self) = @_;
43              
44 13 100       39 if ( ! $self->{ConfigGeneral} ) {
45 6         18 my $filename = _configFilename();
46              
47 6 100       148 if ( ! -f $filename ) {
48 5 50       16868 if ( ! open(my $temp, ">", $filename) ) {
49 0         0 return;
50             }
51             }
52 6         101 $self->{ConfigGeneral} = Config::General->new($filename);
53             }
54              
55 13         4744 return $self->{ConfigGeneral};
56             }
57              
58             =item read()
59              
60             Reads the config file into memory, returns a hashref pointing to the config data
61             =cut
62             sub read {
63 30     30 1 345 my ($self) = @_;
64              
65 30 100       104 if ( ! $self->{data} ) {
66 6 50       29 if ( my $conf = $self->_openConfig() ) {
67 6         46 $self->{data} = { $conf->getall() };
68             }
69             }
70              
71 30         120 return $self->{data};
72             }
73              
74             =item add($path,$value)
75              
76             Adds a data to the existing config data - in memory.
77              
78             =over
79              
80             =item $path
81              
82             An arrayref to the location of the atrribute to be stored.
83              
84             =item $value
85              
86             A string to be stored at that location.
87              
88             =back
89             =cut
90             sub add {
91 13     13 1 3567 my ($self,$path,$value) = @_;
92              
93 13         31 my $attr = pop @$path;
94              
95 13         40 my $config = $self->read();
96 13         31 for my $key ( @$path ) {
97 25 100       69 if ( ! defined($config->{$key}) ) {
98 18         45 $config->{$key} = {};
99             }
100 25         52 $config = $config->{$key};
101             }
102 13         50 $config->{$attr} = $value;
103             }
104              
105             =item delete($path)
106              
107             Deletes data from the existing config data - in memory.
108              
109             =over
110              
111             =item $path
112              
113             An arrayref to the location of the atrribute to be deleted.
114              
115             =back
116             =cut
117             sub delete {
118 3     3 1 9 my ($self,$path) = @_;
119              
120 3         18 my $attr = pop @$path;
121              
122 3         11 my $config = $self->read();
123 3         9 for my $key ( @$path ) {
124 6 100       15 if ( ! defined($config->{$key}) ) {
125 2         5 $config->{$key} = {};
126             }
127 6         11 $config = $config->{$key};
128             }
129 3         9 delete $config->{$attr};
130             }
131              
132             =item show()
133              
134             Wanders through the config data, and returns a string to describe the
135             data hierachy
136             =cut
137             sub show {
138 1     1 1 1686 my ($self) = @_;
139              
140             my $sub = sub {
141 6     6   10 my ($sub,$prefix,$data) = @_;
142              
143 6         9 my $rv = "";
144 6         19 for my $key ( sort keys %$data ) {
145 9 100       19 if ( ref($data->{$key}) ) {
146 5         12 $rv .= "$prefix$key\n";
147 5         14 $rv .= $sub->($sub,"$prefix ",$data->{$key});
148             } else {
149 4         10 $rv .= "$prefix$key: $data->{$key}\n";
150             }
151             }
152 6         24 return $rv;
153 1         8 };
154              
155 1         5 my $data = $self->read();
156 1         4 return $sub->($sub,"",$data);
157             }
158              
159             =item write()
160              
161             Writes the current config data back to a config file on disk. Completely overwrites the existinng file.
162             =cut
163             sub write{
164 7     7 1 16 my ($self) = @_;
165              
166 7         14 my $data = $self->read();
167 7 50       17 if ( my $conf = $self->_openConfig() ) {
168 7         16 $conf->save_file(_configFilename(),$data);
169 7         4795 return 1;
170             }
171             }
172              
173             =back
174              
175             =head1 COPYRIGHT & LICENSE
176              
177             Copyright 2010-2019 Evan Giles.
178              
179             This module is free software; you can redistribute it and/or modify it
180             under the same terms as Perl itself.
181             =cut
182              
183             1; # End of App::Xssh::Config