|
0
|
1 =head1 LICENSE
|
|
|
2
|
|
|
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and
|
|
|
4 Genome Research Limited. All rights reserved.
|
|
|
5
|
|
|
6 This software is distributed under a modified Apache license.
|
|
|
7 For license details, please see
|
|
|
8
|
|
|
9 http://www.ensembl.org/info/about/code_licence.html
|
|
|
10
|
|
|
11 =head1 CONTACT
|
|
|
12
|
|
|
13 Please email comments or questions to the public Ensembl
|
|
|
14 developers list at <dev@ensembl.org>.
|
|
|
15
|
|
|
16 Questions may also be sent to the Ensembl help desk at
|
|
|
17 <helpdesk@ensembl.org>.
|
|
|
18
|
|
|
19 =cut
|
|
|
20
|
|
|
21 =head1 NAME
|
|
|
22
|
|
|
23 Bio::EnsEMBL::Utils::ConversionSupport - Utility module for Vega release and
|
|
|
24 schema conversion scripts
|
|
|
25
|
|
|
26 =head1 SYNOPSIS
|
|
|
27
|
|
|
28 my $serverroot = '/path/to/ensembl';
|
|
|
29 my $suport = new Bio::EnsEMBL::Utils::ConversionSupport($serverroot);
|
|
|
30
|
|
|
31 # parse common options
|
|
|
32 $support->parse_common_options;
|
|
|
33
|
|
|
34 # parse extra options for your script
|
|
|
35 $support->parse_extra_options( 'string_opt=s', 'numeric_opt=n' );
|
|
|
36
|
|
|
37 # ask user if he wants to run script with these parameters
|
|
|
38 $support->confirm_params;
|
|
|
39
|
|
|
40 # see individual method documentation for more stuff
|
|
|
41
|
|
|
42 =head1 DESCRIPTION
|
|
|
43
|
|
|
44 This module is a collection of common methods and provides helper
|
|
|
45 functions for the Vega release and schema conversion scripts. Amongst
|
|
|
46 others, it reads options from a config file, parses commandline options
|
|
|
47 and does logging.
|
|
|
48
|
|
|
49 =head1 METHODS
|
|
|
50
|
|
|
51 =cut
|
|
|
52
|
|
|
53 package Bio::EnsEMBL::Utils::Logger;
|
|
|
54
|
|
|
55 use strict;
|
|
|
56 use warnings;
|
|
|
57 no warnings 'uninitialized';
|
|
|
58
|
|
|
59 use FindBin qw($Bin $Script);
|
|
|
60 use POSIX qw(strftime);
|
|
|
61 use Bio::EnsEMBL::Utils::Argument qw(rearrange);
|
|
|
62 use Bio::EnsEMBL::Utils::Exception qw(throw);
|
|
|
63 use Bio::EnsEMBL::Utils::ScriptUtils qw(parse_bytes);
|
|
|
64
|
|
|
65 my %level_defs = (
|
|
|
66 'error' => 1,
|
|
|
67 'warn' => 2,
|
|
|
68 'warning' => 2,
|
|
|
69 'info' => 3,
|
|
|
70 'debug' => 4,
|
|
|
71 'verbose' => 4,
|
|
|
72 );
|
|
|
73
|
|
|
74 my @reverse_level_defs = (undef, qw(error warning info debug));
|
|
|
75
|
|
|
76 =head2 new
|
|
|
77
|
|
|
78 Arg[1] : String $serverroot - root directory of your ensembl sandbox
|
|
|
79 Example : my $support = new Bio::EnsEMBL::Utils::ConversionSupport(
|
|
|
80 '/path/to/ensembl');
|
|
|
81 Description : constructor
|
|
|
82 Return type : Bio::EnsEMBL::Utils::ConversionSupport object
|
|
|
83 Exceptions : thrown on invalid loglevel
|
|
|
84 Caller : general
|
|
|
85
|
|
|
86 =cut
|
|
|
87
|
|
|
88 sub new {
|
|
|
89 my $caller = shift;
|
|
|
90 my $class = ref($caller) || $caller;
|
|
|
91
|
|
|
92 my ($logfile, $logauto, $logautobase, $logautoid, $logpath, $logappend,
|
|
|
93 $loglevel, $is_component) = rearrange(
|
|
|
94 ['LOGFILE', 'LOGAUTO', 'LOGAUTOBASE', 'LOGAUTOID', 'LOGPATH', 'LOGAPPEND',
|
|
|
95 'LOGLEVEL', 'IS_COMPONENT'], @_);
|
|
|
96
|
|
|
97 my $self = { '_warnings' => 0, };
|
|
|
98 bless ($self, $class);
|
|
|
99
|
|
|
100 # initialise
|
|
|
101 $self->logfile($logfile);
|
|
|
102 $self->logpath($logpath);
|
|
|
103 $self->logappend($logappend);
|
|
|
104 $self->is_component($is_component);
|
|
|
105
|
|
|
106 # automatic logfile creation
|
|
|
107 $self->logauto($logauto);
|
|
|
108 $logautoid ||= strftime("%Y%m%d-%H%M%S", localtime);
|
|
|
109 $self->log_auto_id($logautoid);
|
|
|
110 $self->create_auto_logfile($logautobase);
|
|
|
111
|
|
|
112 $loglevel ||= 'info';
|
|
|
113 if ($loglevel =~ /^\d+$/ and $loglevel > 0 and $loglevel < 5) {
|
|
|
114 $self->{'loglevel'} = $loglevel;
|
|
|
115 } elsif ($level_defs{lc($loglevel)}) {
|
|
|
116 $self->{'loglevel'} = $level_defs{lc($loglevel)};
|
|
|
117 } else {
|
|
|
118 throw('Unknown loglevel: $loglevel.');
|
|
|
119 }
|
|
|
120
|
|
|
121 return $self;
|
|
|
122 }
|
|
|
123
|
|
|
124
|
|
|
125 =head2 log_generic
|
|
|
126
|
|
|
127 Arg[1] : String $txt - the text to log
|
|
|
128 Arg[2] : Int $indent - indentation level for log message
|
|
|
129 Example : my $log = $support->log_filehandle;
|
|
|
130 $support->log('Log foo.\n', 1);
|
|
|
131 Description : Logs a message to the filehandle initialised by calling
|
|
|
132 $self->log_filehandle(). You can supply an indentation level
|
|
|
133 to get nice hierarchical log messages.
|
|
|
134 Return type : true on success
|
|
|
135 Exceptions : thrown when no filehandle can be obtained
|
|
|
136 Caller : general
|
|
|
137
|
|
|
138 =cut
|
|
|
139
|
|
|
140 sub log_generic {
|
|
|
141 my ($self, $txt, $indent, $stamped) = @_;
|
|
|
142
|
|
|
143 $indent ||= 0;
|
|
|
144 my $fh = $self->log_filehandle;
|
|
|
145
|
|
|
146 # append timestamp and memory usage to log text if requested
|
|
|
147 if ($stamped) {
|
|
|
148 $txt =~ s/^(\n*)(.*)(\n*)$/$2/;
|
|
|
149 $txt = sprintf("%-60s%20s", $txt, $self->time_and_mem);
|
|
|
150 $txt = $1.$txt.$3;
|
|
|
151 }
|
|
|
152
|
|
|
153 # strip off leading linebreaks so that indenting doesn't break
|
|
|
154 $txt =~ s/^(\n*)//;
|
|
|
155
|
|
|
156 # indent
|
|
|
157 $txt = $1." "x$indent . $txt;
|
|
|
158
|
|
|
159 print $fh "$txt";
|
|
|
160
|
|
|
161 return(1);
|
|
|
162 }
|
|
|
163
|
|
|
164
|
|
|
165 =head2 error
|
|
|
166
|
|
|
167 Arg[1] : String $txt - the error text to log
|
|
|
168 Arg[2] : Int $indent - indentation level for log message
|
|
|
169 Example : my $log = $support->log_filehandle;
|
|
|
170 $support->log_error('Log foo.\n', 1);
|
|
|
171 Description : Logs a message via $self->log and exits the script.
|
|
|
172 Return type : none
|
|
|
173 Exceptions : none
|
|
|
174 Caller : general
|
|
|
175
|
|
|
176 =cut
|
|
|
177
|
|
|
178 sub error {
|
|
|
179 my ($self, $txt, $indent, $stamped) = @_;
|
|
|
180
|
|
|
181 return(0) unless ($self->{'loglevel'} >= 1);
|
|
|
182
|
|
|
183 $txt = "ERROR: ".$txt;
|
|
|
184 $self->log_generic($txt, $indent, $stamped);
|
|
|
185
|
|
|
186 $self->log_generic("\nExiting prematurely.\n\n");
|
|
|
187 $self->log_generic("Runtime: ".$self->runtime." ".$self->date_and_mem."\n\n");
|
|
|
188
|
|
|
189 exit(1);
|
|
|
190 }
|
|
|
191
|
|
|
192
|
|
|
193 =head2 warning
|
|
|
194
|
|
|
195 Arg[1] : String $txt - the warning text to log
|
|
|
196 Arg[2] : Int $indent - indentation level for log message
|
|
|
197 Example : my $log = $support->log_filehandle;
|
|
|
198 $support->log_warning('Log foo.\n', 1);
|
|
|
199 Description : Logs a message via $self->log and increases the warning counter.
|
|
|
200 Return type : true on success
|
|
|
201 Exceptions : none
|
|
|
202 Caller : general
|
|
|
203
|
|
|
204 =cut
|
|
|
205
|
|
|
206 sub warning {
|
|
|
207 my ($self, $txt, $indent, $stamped) = @_;
|
|
|
208
|
|
|
209 return(0) unless ($self->{'loglevel'} >= 2);
|
|
|
210
|
|
|
211 $txt = "WARNING: " . $txt;
|
|
|
212 $self->log_generic($txt, $indent, $stamped);
|
|
|
213
|
|
|
214 $self->{'_warnings'}++;
|
|
|
215
|
|
|
216 return(1);
|
|
|
217 }
|
|
|
218
|
|
|
219
|
|
|
220 sub info {
|
|
|
221 my ($self, $txt, $indent, $stamped) = @_;
|
|
|
222
|
|
|
223 return(0) unless ($self->{'loglevel'} >= 3);
|
|
|
224
|
|
|
225 $self->log_generic($txt, $indent, $stamped);
|
|
|
226 return(1);
|
|
|
227 }
|
|
|
228
|
|
|
229
|
|
|
230 =head2 debug
|
|
|
231
|
|
|
232 Arg[1] : String $txt - the warning text to log
|
|
|
233 Arg[2] : Int $indent - indentation level for log message
|
|
|
234 Example : my $log = $support->log_filehandle;
|
|
|
235 $support->log_verbose('Log this verbose message.\n', 1);
|
|
|
236 Description : Logs a message via $self->log if --verbose option was used
|
|
|
237 Return type : TRUE on success, FALSE if not verbose
|
|
|
238 Exceptions : none
|
|
|
239 Caller : general
|
|
|
240
|
|
|
241 =cut
|
|
|
242
|
|
|
243 sub debug {
|
|
|
244 my ($self, $txt, $indent, $stamped) = @_;
|
|
|
245
|
|
|
246 return(0) unless ($self->{'loglevel'} >= 4);
|
|
|
247
|
|
|
248 $self->log_generic($txt, $indent, $stamped);
|
|
|
249 return(1);
|
|
|
250 }
|
|
|
251
|
|
|
252
|
|
|
253 sub log_progress {
|
|
|
254 my $self = shift;
|
|
|
255 my $name = shift;
|
|
|
256 my $curr = shift;
|
|
|
257 my $indent = shift;
|
|
|
258
|
|
|
259 throw("You must provide a name and the current value for your progress bar")
|
|
|
260 unless ($name and $curr);
|
|
|
261
|
|
|
262 # return if we haven't reached the next increment
|
|
|
263 return if ($curr < int($self->{'_progress'}->{$name}->{'next'}));
|
|
|
264
|
|
|
265 my $index = $self->{'_progress'}->{$name}->{'index'};
|
|
|
266 my $num_bins = $self->{'_progress'}->{$name}->{'numbins'};
|
|
|
267 my $percent = $index/$num_bins*100;
|
|
|
268
|
|
|
269 my $log_str;
|
|
|
270 $log_str .= ' 'x$indent if ($index == 0);
|
|
|
271 $log_str .= "\b"x4;
|
|
|
272 $log_str .= sprintf("%3s%%", $percent);
|
|
|
273 $log_str .= "\n" if ($curr == $self->{'_progress'}->{$name}->{'max_val'});
|
|
|
274
|
|
|
275 $self->info($log_str);
|
|
|
276
|
|
|
277 # increment counters
|
|
|
278 $self->{'_progress'}->{$name}->{'index'}++;
|
|
|
279 $self->{'_progress'}->{$name}->{'next'} += $self->{'_progress'}->{$name}->{'binsize'};
|
|
|
280 }
|
|
|
281
|
|
|
282
|
|
|
283 sub log_progressbar {
|
|
|
284 my $self = shift;
|
|
|
285 my $name = shift;
|
|
|
286 my $curr = shift;
|
|
|
287 my $indent = shift;
|
|
|
288
|
|
|
289 throw("You must provide a name and the current value for your progress bar")
|
|
|
290 unless ($name and $curr);
|
|
|
291
|
|
|
292 # return if we haven't reached the next increment
|
|
|
293 return if ($curr < int($self->{'_progress'}->{$name}->{'next'}));
|
|
|
294
|
|
|
295 my $index = $self->{'_progress'}->{$name}->{'index'};
|
|
|
296 my $num_bins = $self->{'_progress'}->{$name}->{'numbins'};
|
|
|
297 my $percent = $index/$num_bins*100;
|
|
|
298
|
|
|
299 my $log_str = "\r".(' 'x$indent)."[".('='x$index).(' 'x($num_bins-$index))."] ${percent}\%";
|
|
|
300 $log_str .= "\n" if ($curr == $self->{'_progress'}->{$name}->{'max_val'});
|
|
|
301
|
|
|
302 $self->info($log_str);
|
|
|
303
|
|
|
304 # increment counters
|
|
|
305 $self->{'_progress'}->{$name}->{'index'}++;
|
|
|
306 $self->{'_progress'}->{$name}->{'next'} += $self->{'_progress'}->{$name}->{'binsize'};
|
|
|
307 }
|
|
|
308
|
|
|
309
|
|
|
310 sub init_progress {
|
|
|
311 my $self = shift;
|
|
|
312 my $max = shift;
|
|
|
313 my $num_bins = shift || 50;
|
|
|
314
|
|
|
315 throw("You must provide the maximum value for your progress bar")
|
|
|
316 unless (defined($max));
|
|
|
317
|
|
|
318 # auto-generate a unique name for your progressbar
|
|
|
319 my $name = time . '_' . int(rand(1000));
|
|
|
320
|
|
|
321 # calculate bin size; we will use 50 bins (2% increments)
|
|
|
322 my $binsize = $max/$num_bins;
|
|
|
323
|
|
|
324 $self->{'_progress'}->{$name}->{'max_val'} = $max;
|
|
|
325 $self->{'_progress'}->{$name}->{'binsize'} = $binsize;
|
|
|
326 $self->{'_progress'}->{$name}->{'numbins'} = $num_bins;
|
|
|
327 $self->{'_progress'}->{$name}->{'next'} = 0;
|
|
|
328 $self->{'_progress'}->{$name}->{'index'} = 0;
|
|
|
329
|
|
|
330 return $name;
|
|
|
331 }
|
|
|
332
|
|
|
333
|
|
|
334 =head2 log_filehandle
|
|
|
335
|
|
|
336 Arg[1] : (optional) String $mode - file access mode
|
|
|
337 Example : my $log = $support->log_filehandle;
|
|
|
338 # print to the filehandle
|
|
|
339 print $log 'Lets start logging...\n';
|
|
|
340 # log via the wrapper $self->log()
|
|
|
341 $support->log('Another log message.\n');
|
|
|
342 Description : Returns a filehandle for logging (STDERR by default, logfile if
|
|
|
343 set from config or commandline). You can use the filehandle
|
|
|
344 directly to print to, or use the smart wrapper $self->log().
|
|
|
345 Logging mode (truncate or append) can be set by passing the
|
|
|
346 mode as an argument to log_filehandle(), or with the
|
|
|
347 --logappend commandline option (default: truncate)
|
|
|
348 Return type : Filehandle - the filehandle to log to
|
|
|
349 Exceptions : thrown if logfile can't be opened
|
|
|
350 Caller : general
|
|
|
351
|
|
|
352 =cut
|
|
|
353
|
|
|
354 sub log_filehandle {
|
|
|
355 my ($self, $mode) = @_;
|
|
|
356
|
|
|
357 unless ($self->{'_log_filehandle'}) {
|
|
|
358 $mode ||= '>';
|
|
|
359 $mode = '>>' if ($self->logappend);
|
|
|
360
|
|
|
361 my $fh = \*STDERR;
|
|
|
362
|
|
|
363 if (my $logfile = $self->logfile) {
|
|
|
364 if (my $logpath = $self->logpath) {
|
|
|
365 unless (-e $logpath) {
|
|
|
366 system("mkdir -p $logpath") == 0 or
|
|
|
367 throw("Can't create log dir $logpath: $!\n");
|
|
|
368 }
|
|
|
369
|
|
|
370 $logfile = "$logpath/".$self->logfile;
|
|
|
371 }
|
|
|
372
|
|
|
373 open($fh, "$mode", $logfile) or
|
|
|
374 throw("Unable to open $logfile for writing: $!");
|
|
|
375 }
|
|
|
376
|
|
|
377 $self->{'_log_filehandle'} = $fh;
|
|
|
378 }
|
|
|
379
|
|
|
380 return $self->{'_log_filehandle'};
|
|
|
381 }
|
|
|
382
|
|
|
383
|
|
|
384 =head2 extract_log_identifier
|
|
|
385
|
|
|
386 Arg[1] :
|
|
|
387 Example :
|
|
|
388 Description :
|
|
|
389 Return type :
|
|
|
390 Exceptions :
|
|
|
391 Caller :
|
|
|
392 Status :
|
|
|
393
|
|
|
394 =cut
|
|
|
395
|
|
|
396 sub extract_log_identifier {
|
|
|
397 my $self = shift;
|
|
|
398
|
|
|
399 if (my $logfile = $self->logfile) {
|
|
|
400 $logfile =~ /.+\.([^\.]+)\.log/;
|
|
|
401 return $1;
|
|
|
402 } else {
|
|
|
403 return undef;
|
|
|
404 }
|
|
|
405 }
|
|
|
406
|
|
|
407
|
|
|
408 =head2 init_log
|
|
|
409
|
|
|
410 Example : $support->init_log;
|
|
|
411 Description : Opens a filehandle to the logfile and prints some header
|
|
|
412 information to this file. This includes script name, date, user
|
|
|
413 running the script and parameters the script will be running
|
|
|
414 with.
|
|
|
415 Return type : Filehandle - the log filehandle
|
|
|
416 Exceptions : none
|
|
|
417 Caller : general
|
|
|
418
|
|
|
419 =cut
|
|
|
420
|
|
|
421 sub init_log {
|
|
|
422 my $self = shift;
|
|
|
423 my $params = shift;
|
|
|
424
|
|
|
425 # get a log filehandle
|
|
|
426 my $log = $self->log_filehandle;
|
|
|
427
|
|
|
428 # remember start time
|
|
|
429 $self->{'_start_time'} = time;
|
|
|
430
|
|
|
431 # don't log parameters if this script is run by another one
|
|
|
432 if ($self->logauto or ! $self->is_component) {
|
|
|
433 # print script name, date, user who is running it
|
|
|
434 my $hostname = `hostname`;
|
|
|
435 chomp $hostname;
|
|
|
436 my $script = "$hostname:$Bin/$Script";
|
|
|
437 my $user = `whoami`;
|
|
|
438 chomp $user;
|
|
|
439 $self->info("Script: $script\nDate: ".$self->date."\nUser: $user\n");
|
|
|
440
|
|
|
441 # print parameters the script is running with
|
|
|
442 if ($params) {
|
|
|
443 $self->info("Parameters:\n\n");
|
|
|
444 $self->info($params);
|
|
|
445 }
|
|
|
446 }
|
|
|
447
|
|
|
448 return $log;
|
|
|
449 }
|
|
|
450
|
|
|
451
|
|
|
452 =head2 finish_log
|
|
|
453
|
|
|
454 Example : $support->finish_log;
|
|
|
455 Description : Writes footer information to a logfile. This includes the
|
|
|
456 number of logged warnings, timestamp and memory footprint.
|
|
|
457 Return type : TRUE on success
|
|
|
458 Exceptions : none
|
|
|
459 Caller : general
|
|
|
460
|
|
|
461 =cut
|
|
|
462
|
|
|
463 sub finish_log {
|
|
|
464 my $self = shift;
|
|
|
465
|
|
|
466 $self->info("\nAll done for $Script.\n");
|
|
|
467 $self->info($self->warning_count." warnings. ");
|
|
|
468 $self->info("Runtime: ".$self->runtime." ".$self->date_and_mem."\n\n");
|
|
|
469
|
|
|
470 return(1);
|
|
|
471 }
|
|
|
472
|
|
|
473
|
|
|
474 sub runtime {
|
|
|
475 my $self = shift;
|
|
|
476
|
|
|
477 my $runtime = "n/a";
|
|
|
478
|
|
|
479 if ($self->{'_start_time'}) {
|
|
|
480 my $diff = time - $self->{'_start_time'};
|
|
|
481 my $sec = $diff % 60;
|
|
|
482 $diff = ($diff - $sec) / 60;
|
|
|
483 my $min = $diff % 60;
|
|
|
484 my $hours = ($diff - $min) / 60;
|
|
|
485
|
|
|
486 $runtime = "${hours}h ${min}min ${sec}sec";
|
|
|
487 }
|
|
|
488
|
|
|
489 return $runtime;
|
|
|
490 }
|
|
|
491
|
|
|
492
|
|
|
493 =head2 date_and_mem
|
|
|
494
|
|
|
495 Example : print LOG "Time, memory usage: ".$support->date_and_mem."\n";
|
|
|
496 Description : Prints a timestamp and the memory usage of your script.
|
|
|
497 Return type : String - timestamp and memory usage
|
|
|
498 Exceptions : none
|
|
|
499 Caller : general
|
|
|
500
|
|
|
501 =cut
|
|
|
502
|
|
|
503 sub date_and_mem {
|
|
|
504 my $date = strftime "%Y-%m-%d %T", localtime;
|
|
|
505 my $mem = `ps -p $$ -o vsz |tail -1`;
|
|
|
506 chomp $mem;
|
|
|
507 $mem = parse_bytes($mem*1000);
|
|
|
508 return "[$date, mem $mem]";
|
|
|
509 }
|
|
|
510
|
|
|
511
|
|
|
512 sub time_and_mem {
|
|
|
513 my $date = strftime "%T", localtime;
|
|
|
514 my $mem = `ps -p $$ -o vsz |tail -1`;
|
|
|
515 chomp $mem;
|
|
|
516 $mem = parse_bytes($mem*1000);
|
|
|
517 $mem =~ s/ //;
|
|
|
518 return "[$date|$mem]";
|
|
|
519 }
|
|
|
520
|
|
|
521
|
|
|
522 =head2 date
|
|
|
523
|
|
|
524 Example : print "Date: " . $support->date . "\n";
|
|
|
525 Description : Prints a nicely formatted timestamp (YYYY-DD-MM hh:mm:ss)
|
|
|
526 Return type : String - the timestamp
|
|
|
527 Exceptions : none
|
|
|
528 Caller : general
|
|
|
529
|
|
|
530 =cut
|
|
|
531
|
|
|
532 sub date {
|
|
|
533 return strftime "%Y-%m-%d %T", localtime;
|
|
|
534 }
|
|
|
535
|
|
|
536
|
|
|
537 =head2 mem
|
|
|
538
|
|
|
539 Example : print "Memory usage: " . $support->mem . "\n";
|
|
|
540 Description : Prints the memory used by your script. Not sure about platform
|
|
|
541 dependence of this call ...
|
|
|
542 Return type : String - memory usage
|
|
|
543 Exceptions : none
|
|
|
544 Caller : general
|
|
|
545
|
|
|
546 =cut
|
|
|
547
|
|
|
548 sub mem {
|
|
|
549 my $mem = `ps -p $$ -o vsz |tail -1`;
|
|
|
550 chomp $mem;
|
|
|
551 return $mem;
|
|
|
552 }
|
|
|
553
|
|
|
554
|
|
|
555 =head2 warning_count
|
|
|
556
|
|
|
557 Example : print LOG "There were ".$support->warnings." warnings.\n";
|
|
|
558 Description : Returns the number of warnings encountered while running the
|
|
|
559 script (the warning counter is increased by $self->log_warning).
|
|
|
560 Return type : Int - number of warnings
|
|
|
561 Exceptions : none
|
|
|
562 Caller : general
|
|
|
563
|
|
|
564 =cut
|
|
|
565
|
|
|
566 sub warning_count {
|
|
|
567 my $self = shift;
|
|
|
568 return $self->{'_warnings'};
|
|
|
569 }
|
|
|
570
|
|
|
571
|
|
|
572 =head2 logfile
|
|
|
573
|
|
|
574 Arg[1] :
|
|
|
575 Example :
|
|
|
576 Description : Getter and setter for the logfile
|
|
|
577 Return type :
|
|
|
578 Exceptions :
|
|
|
579 Caller :
|
|
|
580 Status :
|
|
|
581
|
|
|
582 =cut
|
|
|
583
|
|
|
584 sub logfile {
|
|
|
585 my $self = shift;
|
|
|
586 $self->{'_logfile'} = shift if (@_);
|
|
|
587 return $self->{'_logfile'};
|
|
|
588 }
|
|
|
589
|
|
|
590
|
|
|
591 =head2 log_auto_id
|
|
|
592
|
|
|
593 Arg[1] :
|
|
|
594 Example :
|
|
|
595 Description :
|
|
|
596 Return type :
|
|
|
597 Exceptions :
|
|
|
598 Caller :
|
|
|
599 Status :
|
|
|
600
|
|
|
601 =cut
|
|
|
602
|
|
|
603 sub log_auto_id {
|
|
|
604 my $self = shift;
|
|
|
605 $self->{'_log_auto_id'} = shift if (@_);
|
|
|
606 return $self->{'_log_auto_id'};
|
|
|
607 }
|
|
|
608
|
|
|
609
|
|
|
610 sub logauto {
|
|
|
611 my $self = shift;
|
|
|
612 $self->{'_log_auto'} = shift if (@_);
|
|
|
613 return $self->{'_log_auto'};
|
|
|
614 }
|
|
|
615
|
|
|
616
|
|
|
617 =head2 create_auto_logfile
|
|
|
618
|
|
|
619 Arg[1] :
|
|
|
620 Example :
|
|
|
621 Description :
|
|
|
622 Return type :
|
|
|
623 Exceptions :
|
|
|
624 Caller :
|
|
|
625 Status : At Risk
|
|
|
626 : under development
|
|
|
627
|
|
|
628 =cut
|
|
|
629
|
|
|
630 sub create_auto_logfile {
|
|
|
631 my $self = shift;
|
|
|
632 my $logautobase = shift;
|
|
|
633
|
|
|
634 # do nothing if automatic logfile generation isn't set
|
|
|
635 return unless ($self->logauto);
|
|
|
636
|
|
|
637 # an explicit logfile name overrides LOGAUTO
|
|
|
638 return if ($self->logfile);
|
|
|
639
|
|
|
640 # argument check
|
|
|
641 unless ($logautobase) {
|
|
|
642 throw('Need a base logfile name for auto-generating logfile.');
|
|
|
643 }
|
|
|
644
|
|
|
645 # create a logfile name
|
|
|
646 $self->logfile("${logautobase}_".$self->log_auto_id.".log");
|
|
|
647 }
|
|
|
648
|
|
|
649
|
|
|
650 =head2 logpath
|
|
|
651
|
|
|
652 Arg[1] :
|
|
|
653 Example :
|
|
|
654 Description :
|
|
|
655 Return type :
|
|
|
656 Exceptions :
|
|
|
657 Caller :
|
|
|
658 Status :
|
|
|
659
|
|
|
660 =cut
|
|
|
661
|
|
|
662 sub logpath {
|
|
|
663 my $self = shift;
|
|
|
664 $self->{'_logpath'} = shift if (@_);
|
|
|
665 return $self->{'_logpath'};
|
|
|
666 }
|
|
|
667
|
|
|
668
|
|
|
669 =head2 logappend
|
|
|
670
|
|
|
671 Arg[1] :
|
|
|
672 Example :
|
|
|
673 Description :
|
|
|
674 Return type :
|
|
|
675 Exceptions :
|
|
|
676 Caller :
|
|
|
677 Status :
|
|
|
678
|
|
|
679 =cut
|
|
|
680
|
|
|
681 sub logappend {
|
|
|
682 my $self = shift;
|
|
|
683 $self->{'_logappend'} = shift if (@_);
|
|
|
684 return $self->{'_logappend'};
|
|
|
685 }
|
|
|
686
|
|
|
687
|
|
|
688 =head2 is_component
|
|
|
689
|
|
|
690 Arg[1] :
|
|
|
691 Example :
|
|
|
692 Description :
|
|
|
693 Return type :
|
|
|
694 Exceptions :
|
|
|
695 Caller :
|
|
|
696 Status :
|
|
|
697
|
|
|
698 =cut
|
|
|
699
|
|
|
700 sub is_component {
|
|
|
701 my $self = shift;
|
|
|
702 $self->{'_is_component'} = shift if (@_);
|
|
|
703 return $self->{'_is_component'};
|
|
|
704 }
|
|
|
705
|
|
|
706
|
|
|
707 sub loglevel {
|
|
|
708 my $self = shift;
|
|
|
709 return $reverse_level_defs[$self->{'loglevel'}];
|
|
|
710 }
|
|
|
711
|
|
|
712
|
|
|
713 #
|
|
|
714 # deprecated methods (left here for backwards compatibility
|
|
|
715 #
|
|
|
716 sub log_error {
|
|
|
717 return $_[0]->error(@_);
|
|
|
718 }
|
|
|
719
|
|
|
720 sub log_warning {
|
|
|
721 return $_[0]->warning(@_);
|
|
|
722 }
|
|
|
723
|
|
|
724 sub log {
|
|
|
725 return $_[0]->info(@_);
|
|
|
726 }
|
|
|
727
|
|
|
728 sub log_verbose {
|
|
|
729 return $_[0]->debug(@_);
|
|
|
730 }
|
|
|
731
|
|
|
732 sub log_stamped {
|
|
|
733 return $_[0]->log(@_, 1);
|
|
|
734 }
|
|
|
735
|
|
|
736
|
|
|
737
|
|
|
738 1;
|
|
|
739
|
