1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
package App::Ping903;
use strict;
use warnings;
use Getopt::Long qw(:config gnu_getopt no_ignore_case require_order);
use Pod::Man;
use Pod::Usage;
use Pod::Find qw(pod_where);
use Net::Ping903;
use App::Ping903::Command ':exit_codes';
our $VERSION = '0.4.90';
my $DEFAULT_URL = 'http://localhost:8080';
sub new {
my $class = shift;
my $config_file;
my $url;
my $config = {};
GetOptions(
'shorthelp|?' => sub {
pod2usage(-input => pod_where({-inc => 1}, __PACKAGE__),
-verbose => 99,
-sections => [qw(NAME SYNOPSIS COMMANDS)],
-exitstatus => EX_OK)
},
'help' => sub {
pod2usage(-exitstatus => EX_OK,
-input => pod_where({-inc => 1}, __PACKAGE__),
-verbose => 2)
},
'usage' => sub {
pod2usage(-exitstatus => EX_OK,
-input => pod_where({-inc => 1}, __PACKAGE__),
-verbose => 0)
},
'config|c=s' => \$config_file,
'url|u=s' => \$url
) or exit(EX_USAGE);
if ($config_file) {
if (-f $config_file) {
$config = $class->readconfig($config_file);
} else {
die "configuration file $config_file does not exists\n";
}
} else {
$config_file = '/etc/ping903.conf';
if (-f $config_file) {
$config = $class->readconfig($config_file);
}
}
if ($url) {
$config->{baseurl} = $url;
} elsif (!$config->{baseurl}) {
$config->{baseurl} = $DEFAULT_URL;
}
unless ($config->{baseurl} =~ m{^https?://}) {
$config->{baseurl} = "http://$url";
}
my $agent = new Net::Ping903($config->{baseurl});
my $com = shift @ARGV;
die "no command name\n" unless $com;
my $modname = __PACKAGE__ . '::Command::' . $com;
my $modpath = $modname;
$modpath =~ s{::}{/}g;
$modpath .= '.pm';
my $cmd;
eval {
require $modpath;
$cmd = $modname->new($com, $agent);
};
if ($@) {
if ($@ =~ /Can't locate $modpath/) {
die "unknown command: $com\n"
}
die $@;
}
return $cmd;
}
sub readconfig {
my ($class, $file) = @_;
my $config = {};
if (open(my $fh, '<', $file)) {
while (<$fh>) {
chomp;
s/^\s+//;
s/\s+$//;
next if /^(#.*)?$/;
if (m{^listen\s+(.+)$}) {
$config->{baseurl} = $1;
last;
}
}
close $fh;
} else {
die "$file: file doesn't exist\n";
}
return $config;
}
1;
=head1 NAME
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 OPTIONS
|
