line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Presto::Config; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:MPERRY'; |
3
|
|
|
|
|
|
|
$App::Presto::Config::VERSION = '0.010'; |
4
|
|
|
|
|
|
|
# ABSTRACT: Manage configuration for a given endpoint |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
13911
|
use Moo; |
|
1
|
|
|
|
|
9262
|
|
|
1
|
|
|
|
|
5
|
|
7
|
1
|
|
|
1
|
|
1558
|
use JSON qw(decode_json encode_json); |
|
1
|
|
|
|
|
10413
|
|
|
1
|
|
|
|
|
3
|
|
8
|
1
|
|
|
1
|
|
548
|
use File::HomeDir; |
|
1
|
|
|
|
|
3692
|
|
|
1
|
|
|
|
|
54
|
|
9
|
1
|
|
|
1
|
|
5
|
use File::Path 2.08 qw(make_path); |
|
1
|
|
|
|
|
14
|
|
|
1
|
|
|
|
|
628
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
has endpoint => ( |
12
|
|
|
|
|
|
|
is => 'rw', |
13
|
|
|
|
|
|
|
required => 1, |
14
|
|
|
|
|
|
|
trigger => sub { delete shift->{endpoint_dir} } |
15
|
|
|
|
|
|
|
); |
16
|
|
|
|
|
|
|
has config => ( |
17
|
|
|
|
|
|
|
is => 'lazy', |
18
|
|
|
|
|
|
|
clearer => 'reload', |
19
|
|
|
|
|
|
|
isa => sub { die "not a HashRef" if ref($_[0]) ne 'HASH'; }, |
20
|
|
|
|
|
|
|
); |
21
|
|
|
|
|
|
|
sub _build_config { |
22
|
2
|
|
|
2
|
|
396
|
my $self = shift; |
23
|
2
|
|
|
|
|
5
|
my $config_file = $self->file('config.json'); |
24
|
2
|
100
|
|
|
|
69
|
if (! -e $config_file ) { |
25
|
1
|
|
|
|
|
13
|
warn "creating new config file: $config_file\n"; |
26
|
1
|
50
|
|
|
|
58
|
open( my $fh, '>', $config_file ) or die "Unable to open $config_file for writing: $!"; |
27
|
1
|
|
|
|
|
16
|
print $fh encode_json({}); |
28
|
1
|
|
|
|
|
33
|
close $fh; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
2
|
|
|
|
|
3
|
my $config; |
32
|
|
|
|
|
|
|
eval { |
33
|
2
|
|
|
|
|
4
|
local $/; |
34
|
2
|
50
|
|
|
|
45
|
open( my $fh, '<', $config_file ) or die "Unable to open $config_file for reading: $!"; |
35
|
2
|
|
|
|
|
26
|
my $json_text = <$fh>; |
36
|
2
|
|
50
|
|
|
9
|
$config = decode_json( $json_text || '{}' ); |
37
|
2
|
|
|
|
|
17
|
1; |
38
|
2
|
50
|
|
|
|
3
|
} or do { |
39
|
0
|
|
|
|
|
0
|
warn "Ignoring invalid config file $config_file: $@\n"; |
40
|
0
|
|
|
|
|
0
|
$config = {}; |
41
|
|
|
|
|
|
|
}; |
42
|
2
|
|
|
|
|
37
|
return $config; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
has endpoint_dir => ( |
46
|
|
|
|
|
|
|
is => 'lazy', |
47
|
|
|
|
|
|
|
); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub _build_endpoint_dir { |
50
|
6
|
|
|
6
|
|
1142
|
my $self = shift; |
51
|
6
|
|
66
|
|
|
19
|
my $root = $ENV{APP_REST_CLI_DIR} || sprintf('%s/.app-presto', File::HomeDir->my_home); |
52
|
6
|
|
|
|
|
81
|
(my $endpoint_dir = lc $self->endpoint) =~ s/\W+/-/g; |
53
|
6
|
|
|
|
|
56
|
my $dir = sprintf( '%s/%s', $root, $endpoint_dir); |
54
|
6
|
100
|
|
|
|
88
|
if(!-d $dir){ |
55
|
3
|
|
|
|
|
70
|
warn "creating directory $dir\n"; |
56
|
3
|
|
|
|
|
518
|
make_path($dir); |
57
|
|
|
|
|
|
|
} |
58
|
6
|
|
|
|
|
38
|
return $dir; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub file { |
62
|
6
|
|
|
6
|
0
|
984
|
my $self = shift; |
63
|
6
|
|
|
|
|
13
|
(my $file = shift) =~ s{^[\./]+}{}g; # remove leading dots or slashes |
64
|
6
|
|
|
|
|
92
|
return sprintf('%s/%s', $self->endpoint_dir, $file); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
sub is_set { |
68
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
69
|
0
|
|
|
|
|
0
|
my $key = shift; |
70
|
0
|
|
|
|
|
0
|
return exists $self->config->{$key}; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
sub set { |
73
|
4
|
|
|
4
|
0
|
1346
|
my $self = shift; |
74
|
4
|
|
|
|
|
4
|
my $key = shift; |
75
|
4
|
|
|
|
|
4
|
my $value = shift; |
76
|
4
|
100
|
|
|
|
9
|
if($key eq 'endpoint'){ |
77
|
2
|
|
|
|
|
38
|
return $self->endpoint($value); |
78
|
|
|
|
|
|
|
} |
79
|
2
|
100
|
|
|
|
5
|
if(!defined $value){ |
80
|
1
|
|
|
|
|
20
|
delete $self->config->{$key}; |
81
|
|
|
|
|
|
|
} else { |
82
|
1
|
|
|
|
|
3
|
$self->config->{$key} = $value; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
eval { |
85
|
2
|
|
|
|
|
5
|
$self->write_config; |
86
|
2
|
|
|
|
|
6
|
1; |
87
|
2
|
50
|
|
|
|
12
|
} or do { |
88
|
0
|
|
|
|
|
0
|
warn "unable to persist config: $@\n"; |
89
|
|
|
|
|
|
|
}; |
90
|
2
|
|
|
|
|
2
|
return; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
sub unset { |
93
|
1
|
|
|
1
|
0
|
429
|
my $self = shift; |
94
|
1
|
|
|
|
|
3
|
return $self->set($_[0],undef); |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
sub get { |
98
|
3
|
|
|
3
|
0
|
952
|
my $self = shift; |
99
|
3
|
|
|
|
|
4
|
my $key = shift; |
100
|
3
|
100
|
|
|
|
10
|
return $self->endpoint if $key eq 'endpoint'; |
101
|
2
|
50
|
|
|
|
41
|
return exists $self->config->{$key} ? $self->config->{$key} : undef; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub keys { |
105
|
2
|
|
|
2
|
0
|
343
|
my $self = shift; |
106
|
2
|
|
|
|
|
3
|
return keys %{ $self->config }; |
|
2
|
|
|
|
|
36
|
|
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub write_config { |
110
|
2
|
|
|
2
|
0
|
2
|
my $self = shift; |
111
|
2
|
|
|
|
|
14
|
my $config_file = $self->file('config.json'); |
112
|
2
|
50
|
|
|
|
114
|
open(my $fh, '>', $config_file) or die "Unable to open $config_file for writing: $!"; |
113
|
2
|
|
|
|
|
38
|
print $fh encode_json($self->config); |
114
|
2
|
|
|
|
|
60
|
close $fh; |
115
|
2
|
|
|
|
|
6
|
return; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my %DEFAULTS = ( |
119
|
|
|
|
|
|
|
binmode => 'utf8', |
120
|
|
|
|
|
|
|
pretty_printer => 'JSON', |
121
|
|
|
|
|
|
|
deserialize_response => 1, |
122
|
|
|
|
|
|
|
); |
123
|
|
|
|
|
|
|
sub init_defaults { |
124
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
125
|
0
|
|
|
|
|
|
foreach my $k(CORE::keys %DEFAULTS){ |
126
|
0
|
0
|
|
|
|
|
unless($self->is_set($k)){ |
127
|
0
|
|
|
|
|
|
$self->set($k, $DEFAULTS{$k}); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
} |
130
|
0
|
|
|
|
|
|
return; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
1; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
__END__ |