File Coverage

blib/lib/XAS/Lib/App.pm
Criterion Covered Total %
statement 15 75 20.0
branch 0 8 0.0
condition n/a
subroutine 5 27 18.5
pod 8 8 100.0
total 28 118 23.7


line stmt bran cond sub pod time code
1             package XAS::Lib::App;
2              
3             our $VERSION = '0.05';
4              
5 1     1   751 use Try::Tiny;
  1         1  
  1         57  
6 1     1   4 use Pod::Usage;
  1         1  
  1         77  
7 1     1   462 use Hash::Merge;
  1         1835  
  1         41  
8 1     1   654 use Getopt::Long;
  1         7019  
  1         5  
9              
10             use XAS::Class
11 1         19 debug => 0,
12             version => $VERSION,
13             base => 'XAS::Base',
14             mixin => 'XAS::Lib::Mixins::Handlers',
15             import => 'CLASS',
16             utils => 'dotid',
17             filesystem => 'File',
18             vars => {
19             PARAMS => {
20             -throws => { optional => 1, default => undef },
21             -facility => { optional => 1, default => undef },
22             -priority => { optional => 1, default => undef },
23             }
24             }
25 1     1   151 ;
  1         2  
26              
27             #use Data::Dumper;
28              
29             # ----------------------------------------------------------------------
30             # Public Methods
31             # ----------------------------------------------------------------------
32              
33             sub signal_handler {
34 0     0 1   my $signal = shift;
35              
36 0           my $ex = XAS::Exception->new(
37             type => 'xas.lib.app.signal_handler',
38             info => 'process interrupted by signal ' . $signal
39             );
40              
41 0           $ex->throw();
42              
43             }
44              
45             sub define_signals {
46 0     0 1   my $self = shift;
47              
48 0           $SIG{'INT'} = \&signal_handler;
49 0           $SIG{'QUIT'} = \&signal_handler;
50              
51             }
52              
53             sub define_pidfile {
54 0     0 1   my $self = shift;
55              
56             }
57              
58             sub define_daemon {
59 0     0 1   my $self = shift;
60              
61             }
62              
63             sub run {
64 0     0 1   my $self = shift;
65              
66 0           my $rc = 0;
67              
68             try {
69              
70 0     0     $self->define_signals();
71 0           $self->define_daemon();
72 0           $self->define_pidfile();
73              
74 0           $self->main();
75              
76             } catch {
77              
78 0     0     my $ex = $_;
79              
80 0           $rc = $self->exit_handler($ex);
81              
82 0           };
83              
84 0           return $rc;
85              
86             }
87              
88             sub main {
89 0     0 1   my $self = shift;
90              
91 0           $self->log->warn('You need to override main()');
92              
93             }
94              
95             sub options {
96 0     0 1   my $self = shift;
97              
98 0           return {};
99              
100             }
101              
102             # ----------------------------------------------------------------------
103             # Private Methods
104             # ----------------------------------------------------------------------
105              
106             sub init {
107 0     0 1   my $class = shift;
108              
109 0           my $self = $class->SUPER::init(@_);
110              
111 0 0         if (defined($self->throws)) {
112              
113 0           $self->env->throws($self->throws);
114 0           $self->class->throws($self->throws);
115              
116             }
117              
118 0 0         if (defined($self->priority)) {
119              
120 0           $self->env->priority($self->priority);
121              
122             }
123              
124 0 0         if (defined($self->facility)) {
125              
126 0           $self->env->facility($self->facility);
127              
128             }
129              
130 0           my $options = $self->options();
131 0           my $defaults = $self->_default_options();
132              
133 0           $self->_parse_cmdline($defaults, $options);
134              
135 0           return $self;
136              
137             }
138              
139             sub _default_options {
140 0     0     my $self = shift;
141              
142 0           my $version = $self->CLASS->VERSION;
143 0           my $script = $self->env->script;
144              
145             return {
146 0     0     'alerts!' => sub { $self->env->alerts($_[1]); },
147 0     0     'help|h|?' => sub { pod2usage(-verbose => 0, -exitstatus => 0); },
148 0     0     'manual' => sub { pod2usage(-verbose => 2, -exitstatus => 0); },
149 0     0     'version' => sub { printf("%s - v%s\n", $script, $version); exit 0; },
  0            
150             'debug' => sub {
151 0     0     $self->env->xdebug(1);
152 0           $self->log->level('debug', 1);
153             },
154             'priority=s' => sub {
155 0     0     $self->env->priority($_[1]);
156             },
157             'facility=s' => sub {
158 0     0     $self->env->facility($_[1]);
159             },
160             'log-file=s' => sub {
161 0     0     my $logfile = File($_[1]);
162 0           $self->env->log_type('file');
163 0           $self->env->log_file($logfile);
164 0           $self->log->activate();
165             },
166             'log-type=s' => sub {
167 0     0     $self->env->log_type($_[1]);
168 0           $self->log->activate();
169             },
170             'log-facility=s' => sub {
171 0     0     $self->env->log_facility($_[1]);
172             },
173 0           };
174              
175             }
176              
177             sub _parse_cmdline {
178 0     0     my ($self, $defaults, $optional) = @_;
179              
180 0           my $hm = Hash::Merge->new('RIGHT_PRECEDENT');
181 0           my %options = %{ $hm->merge($defaults, $optional) };
  0            
182              
183 0 0         GetOptions(%options) or pod2usage(-verbose => 0, -exitstatus => 1);
184              
185             }
186              
187             1;
188              
189             __END__