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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
package Iurt::Util;
use base qw(Exporter);
use strict;
our @EXPORT = qw(
plog_init
plog
pdie
ssh_setup
ssh
sout
sget
sput
);
my ($plog_name, $plog_file, $plog_level, $plog_color);
=head2 LOG HELPERS
=over 8
=item plog_init($program_name, $logfile)
=item plog_init($program_name, $logfile, $level)
Initialize plog with the program name, log file and optional log level.
If not specified, the log level will be set to 9999.
=cut
my %plog_ctr = (
red => "\x1b[31m",
green => "\x1b[32m",
yellow => "\x1b[33m",
blue => "\x1b[34m",
magenta => "\x1b[35m",
cyan => "\x1b[36m",
grey => "\x1b[37m",
bold => "\x1b[1m",
normal => "\x1b[0m",
);
my @plog_prefix = (
"",
"E: ",
"W: ",
"*: ",
"F: ",
"O: ",
"N: ",
"I: ",
"D: ",
);
# FIXME: remove one of ERROR or ERR, check and fix everywhere else
my %plog_level = (
NONE => 0,
ERROR => 1,
ERR => 1,
WARN => 2,
MSG => 3,
FAIL => 4,
OK => 5,
NOTIFY => 6,
INFO => 7,
DEBUG => 8,
);
sub plog_init {
$plog_name = shift;
$plog_file = shift;
$plog_level = shift @_ || 9999;
$plog_color = shift @_ || 0;
$plog_level = 9999 if $ENV{PLOG_DEBUG};
$plog_color = 0 unless -t fileno $plog_file;
foreach (@plog_prefix) { $_ .= "[$plog_name] " }
if ($plog_color) {
$plog_prefix[1] .= "$plog_ctr{bold}$plog_ctr{red}";
$plog_prefix[2] .= "$plog_ctr{bold}$plog_ctr{yellow}";
$plog_prefix[3] .= $plog_ctr{bold};
$plog_prefix[4] .= $plog_ctr{red};
$plog_prefix[5] .= $plog_ctr{green};
$plog_prefix[6] .= $plog_ctr{cyan};
$plog_prefix[8] .= $plog_ctr{yellow};
}
1;
}
=item plog($message)
=item plog($level, @message)
Print a log message in the format "program: I<message>\n" to the log
file specified in a call to plog_init(). If a level is specified,
the message will be printed only if the level is greater or equal the
level set with plog_init().
=back
=cut
sub plog {
my $level = $#_ ? shift : 'INFO';
$level = $plog_level{$level};
my ($p, $e) = ($plog_prefix[$level], ($plog_color ? $plog_ctr{normal} : ""));
print $plog_file "$p@_$e\n" if $plog_level >= $level;
}
sub pdie {
plog('ERR', "@_");
die $@;
}
=head2 SSH HELPERS
=over 8
=item ssh_setup($options, $user, $host)
Set up ssh connections with the specified options, user and remote
host. Return an ssh handle to be used in ssh-based operations.
=cut
sub ssh_setup {
my $opt = shift;
my $user = shift;
my $host = shift;
my @conf = ($opt, $user, $host);
\@conf;
}
=item ssh($handle, @commmand)
Open an ssh connection with parameters specified in ssh_setup() and
execute I<@command>. Return the command execution status.
=cut
# This is currently implemented using direct calls to ssh/scp because.
# according to Warly's comments in ulri, using the perl SSH module
# gives us some performance problems
sub ssh {
my $conf = shift;
my ($opt, $user, $host) = @$conf;
system("ssh $opt -x $user\@$host @_");
}
=item sout($handle, @commmand)
Open an ssh connection with parameters specified in ssh_setup() and
execute I<@command>. Return the command output.
=cut
sub sout {
my $conf = shift;
my ($opt, $user, $host) = @$conf;
`ssh $opt -x $user\@$host @_ 2>/dev/null`;
}
=item sget($handle, $from, $to)
Get a file using scp, from the remote location I<$from> to the
local location I<$to>, using host and user specified in ssh_setup().
=cut
sub sget {
my $conf = shift;
my ($_opt, $user, $host) = @$conf;
system('scp', '-q', '-rc', 'arcfour', "$user\@$host:$_[0]", $_[1]);
}
=item sput($handle, $from, $to)
Send a file using scp, from a local location I<$from> to the remote
location I<$to>, using host and user specified in ssh_setup().
=back
=cut
sub sput {
my $conf = shift;
my ($_opt, $user, $host) = @$conf;
system('scp', '-q', '-rc', 'arcfour', $_[0], "$user\@$host:$_[1]");
}
=back
=cut
1;
|
