1 # Copyright (c) 2010-2012 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or
4 # modify it under the terms of the GNU General Public License
5 # as published by the Free Software Foundation; either version 2
6 # of the License, or (at your option) any later version.
8 # This program is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13 # You should have received a copy of the GNU General Public License along
14 # with this program; if not, write to the Free Software Foundation, Inc.,
15 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 # Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
18 # Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
21 package Amanda::Report::human;
30 use Amanda::Config qw(:getconf config_dir_relative);
31 use Amanda::Util qw(:constants quote_string );
34 use Amanda::Debug qw( debug );
35 use Amanda::Util qw( quote_string );
39 ## constants that define the column specification output format.
41 use constant COLSPEC_NAME => 0; # column name; used internally
42 use constant COLSPEC_PRE_SPACE => 1; # prefix spaces
43 use constant COLSPEC_WIDTH => 2; # column width
44 use constant COLSPEC_PREC => 3; # post-decimal precision
45 use constant COLSPEC_MAXWIDTH => 4; # resize if set
46 use constant COLSPEC_FORMAT => 5; # sprintf format
47 use constant COLSPEC_TITLE => 6; # column title
49 use constant PROGRAM_ORDER =>
50 qw(amdump planner amflush amvault driver dumper chunker taper reporter);
61 : ( ($q = $a / $b) > 99999.95 ) ? "#####"
62 : ( $q > 999.95 ) ? sprintf( "%5.0f", $q )
63 : sprintf( "%5.1f", $q );
72 : ( ($q = $a / $b) > 9999999.95 ) ? "#######"
73 : ( $q > 99999.95 ) ? sprintf( "%7.0f", $q )
74 : sprintf( "%7.1f", $q );
79 my ( $a, $b, $col ) = @_;
82 : sprintf( $col->[5], $col->[2], $col->[3], ( $a / $b ) );
87 my ( $format, @args ) = @_;
89 formline( $format, @args );
95 my ( $max, @args ) = @_; # first element starts as max
97 foreach my $elt (@args) {
98 $max = $elt if $elt > $max;
105 my ( $min, @args ) = @_; # first element starts as min
107 foreach my $elt (@args) {
108 $min = $elt if $elt < $min;
116 $sec += 30; # round up
117 my ( $hr, $mn ) = ( int( $sec / ( 60 * 60 ) ), int( $sec / 60 ) % 60 );
118 return sprintf( '%d:%02d', $hr, $mn );
124 $sec += 0.5; # round up
125 my ( $mn, $sc ) = ( int( $sec / (60) ), int( $sec % 60 ) );
126 return sprintf( '%d:%02d', $mn, $sc );
131 # return $val/$unit_divisor as a a floating-point number
134 my ($val, %params) = @_;
136 return $params{'zero'} if ($val == 0 and exists $params{'zero'});
138 # $orig_size and $out_size are bigints, which must be stringified to cast
139 # them to floats. We need floats, because they round nicely. This is
140 # ugly and hard to track down.
141 my $flval = $val.".0";
142 my $flunit = $self->{'unit_div'}.".0";
143 return $flval / $flunit;
150 my ($class, $report, $fh, $config_name, $logfname) = @_;
155 config_name => $config_name,
156 logfname => $logfname,
159 disp_unit => getconf($CNF_DISPLAYUNIT),
160 unit_div => getconf_unit_divisor(),
166 dumpdisks => [ 0, 0 ], # full_count, incr_count
167 tapedisks => [ 0, 0 ],
168 tapeparts => [ 0, 0 ],
171 if (defined $report) {
173 my (@errors, @stranges, @notes);
176 map { @{ $report->get_program_info($_, "errors", []) }; }
178 ## prepend program name to notes lines.
179 foreach my $program (PROGRAM_ORDER) {
181 map { "$program: $_" }
182 @{ $report->get_program_info($program, "notes", []) };
185 $self->{errors} = \@errors;
186 $self->{notes} = \@notes;
196 my $fh = $self->{fh};
197 my $report = $self->{report};
199 # TODO: the hashes are a cheap fix. fix these.
200 my @dles = $report->get_dles();
201 my $full_stats = $self->{full_stats};
202 my $incr_stats = $self->{incr_stats};
203 my $total_stats = $self->{total_stats};
204 my $dumpdisks = $self->{dumpdisks};
205 my $tapedisks = $self->{tapedisks};
206 my $tapeparts = $self->{tapeparts};
208 ## initialize all relevant fields to 0
209 map { $incr_stats->{$_} = $full_stats->{$_} = 0; }
210 qw/dumpdisk_count tapedisk_count tapepart_count outsize origsize
211 tapesize coutsize corigsize taper_time dumper_time/;
213 foreach my $dle_entry (@dles) {
215 # $dle_entry = [$hostname, $disk]
216 my $dle = $report->get_dle_info(@$dle_entry);
217 my $alldumps = $dle->{'dumps'};
219 while( my ($timestamp, $tries) = each %$alldumps ) {
220 foreach my $try ( @$tries ) {
222 my $level = exists $try->{dumper} ? $try->{dumper}{'level'} :
223 exists $try->{taper} ? $try->{taper}{'level'} :
225 my $stats = ($level > 0) ? $incr_stats : $full_stats;
227 # compute out size, skipping flushes (tries without a dumper run)
229 if (exists $try->{dumper}
230 && exists $try->{chunker} && defined $try->{chunker}->{kb}
231 && ( $try->{chunker}{status} eq 'success'
232 || $try->{chunker}{status} eq 'partial')) {
233 $outsize = $try->{chunker}->{kb};
234 } elsif (exists $try->{dumper}
235 && exists $try->{taper} && defined $try->{taper}->{kb}
236 && ( $try->{taper}{status} eq 'done'
237 || $try->{taper}{status} eq 'partial')) {
238 $outsize = $try->{taper}->{kb};
241 # compute orig size, again skipping flushes
243 if ( exists $try->{dumper}
244 && ( $try->{dumper}{status} eq 'success'
245 || $try->{dumper}{status} eq 'strange')) {
247 $origsize = $try->{dumper}{orig_kb};
248 $stats->{dumper_time} += $try->{dumper}{sec};
249 $stats->{dumpdisk_count}++; # count this as a dumped filesystem
250 $dumpdisks->[$try->{dumper}{'level'}]++; #by level count
251 } elsif (exists $try->{dumper}
252 && exists $try->{taper} && defined $try->{taper}->{kb}
253 && ( $try->{taper}{status} eq 'done'
254 || $try->{taper}{status} eq 'partial')) {
255 # orig_kb doesn't always exist (older logfiles)
256 if ($try->{taper}->{orig_kb}) {
257 $origsize = $try->{taper}->{orig_kb};
261 if ( exists $try->{taper}
262 && ( $try->{taper}{status} eq 'done'
263 || $try->{taper}{status} eq 'partial')) {
265 $stats->{tapesize} += $try->{taper}{kb};
266 $stats->{taper_time} += $try->{taper}{sec};
267 $stats->{tapepart_count} += @{ $try->{taper}{parts} }
268 if $try->{taper}{parts};
269 $stats->{tapedisk_count}++;
271 $tapedisks->[ $try->{taper}{level} ]++; #by level count
272 $tapeparts->[$try->{taper}{level}] += @{ $try->{taper}{parts} }
273 if $try->{taper}{parts};
276 # add those values to the stats
277 $stats->{'origsize'} += $origsize;
278 $stats->{'outsize'} += $outsize;
280 # if the sizes differ, then we have a compressed dump, so also add it to
282 $stats->{'corigsize'} += $origsize;
283 $stats->{'coutsize'} += $outsize;
288 %$total_stats = map { $_ => $incr_stats->{$_} + $full_stats->{$_} }
291 $total_stats->{planner_time} =
292 $report->get_program_info("planner", "time", 0);
294 if ($report->get_flag("got_finish")) {
295 $total_stats->{total_time} =
296 $report->get_program_info("driver", "time", 0)
297 || $report->get_program_info("amflush", "time", 0);
299 $total_stats->{total_time} =
300 $total_stats->{taper_time} + $total_stats->{planner_time};
303 $total_stats->{idle_time} =
304 ( $total_stats->{total_time} - $total_stats->{planner_time} ) -
305 $total_stats->{taper_time};
307 # TODO: tape info is very sparse. There either needs to be a
308 # function that collects and fills in tape info post-processing in
309 # Amanda::Report, or it needs to be done here.
313 sub print_human_amreport
315 my ( $self, $fh ) = @_;
318 || confess "error: no file handle given to print_human_amreport\n";
320 ## collect statistics
321 $self->calculate_stats();
323 ## print the basic info header
324 $self->print_header();
326 ## print out statements about past and predicted tape usage
327 $self->output_tapeinfo();
329 ## print out error messages from the run
330 $self->output_error_summaries();
332 ## print out aggregated statistics for the whole dump
333 $self->output_stats();
335 ## print out statistics for each tape used
336 $self->output_tape_stats();
338 ## print out all errors & comments
339 $self->output_details();
341 ## print out dump statistics per DLE
342 $self->output_summary();
346 "(brought to you by Amanda version $Amanda::Constants::VERSION)\n";
355 my $report = $self->{report};
356 my $fh = $self->{fh};
357 my $config_name = $self->{config_name};
359 my $hostname = $report->{hostname};
360 my $org = getconf($CNF_ORG);
362 # TODO: this should be a shared method somewhere
363 my $timestamp = $report->get_timestamp();
364 my ($year, $month, $day) = ($timestamp =~ m/^(\d\d\d\d)(\d\d)(\d\d)/);
365 my $date = POSIX::strftime('%B %e, %Y', 0, 0, 0, $day, $month - 1, $year - 1900);
366 $date =~ s/ / /g; # get rid of intervening space
368 print $fh "*** THE DUMPS DID NOT FINISH PROPERLY!\n\n"
369 unless ($report->{flags}{got_finish});
371 my $header_format = <<EOF;
372 @<<<<<<<: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
376 print $fh swrite($header_format, "Hostname", $hostname);
377 print $fh swrite($header_format, "Org", $org);
378 print $fh swrite($header_format, "Config", $config_name);
379 print $fh swrite($header_format, "Date", $date);
389 my $report = $self->{report};
390 my $fh = $self->{fh};
391 my $logfname = $self->{logfname};
393 my $taper = $report->get_program_info("taper");
394 my $tapes = $taper->{tapes} || {};
395 my $tape_labels = $taper->{tape_labels} || [];
397 my %full_stats = %{ $self->{full_stats} };
398 my %incr_stats = %{ $self->{incr_stats} };
399 my %total_stats = %{ $self->{total_stats} };
401 if (getconf($CNF_REPORT_USE_MEDIA) and @$tape_labels > 0) {
403 # slightly different sentence depending on the run type
405 if ($report->get_flag("amflush_run")) {
406 $tapelist_str = "The dumps were flushed ";
407 } elsif ($report->get_flag("amvault_run")) {
408 $tapelist_str = "The dumps were vaulted ";
410 $tapelist_str = "These dumps were ";
412 $tapelist_str .= (@$tape_labels > 1) ? "to tapes " : "to tape ";
413 $tapelist_str .= join(", ", @$tape_labels) . ".\n";
414 print $fh $tapelist_str;
418 $report->get_program_info("taper", "tape_error", undef)) {
420 if ($report->get_program_info("taper", "failure_from", undef) eq "config") {
421 # remove leading [ and trailling ]
422 $tape_error =~ s/^\[//;
423 $tape_error =~ s/\]$//;
424 print $fh "Not using all tapes because $tape_error.\n";
426 print $fh "*** A TAPE ERROR OCCURRED: $tape_error.\n";
428 #$tape_error =~ s{^no-tape }{};
431 ## if this is a historical report, do not generate holding disk
432 ## information. If this dump is the most recent, output holding
434 if ($report->get_flag("historical")) {
435 print $fh "Some dumps may have been left in the holding disk.\n\n"
436 if $report->get_flag("degraded_mode")
440 my @holding_list = Amanda::Holding::get_files_for_flush();
442 foreach my $holding_file (@holding_list) {
443 $h_size += (0 + Amanda::Holding::file_size($holding_file, 1));
447 sprintf("%.0f%s", $self->tounits($h_size), $self->{disp_unit});
451 "There are $h_size_u of dumps left in the holding disk.\n";
453 (getconf($CNF_AUTOFLUSH))
454 ? print $fh "They will be flushed on the next run.\n\n"
455 : print $fh "Run amflush to flush them to tape.\n\n";
457 } elsif ($report->get_flag("degraded_mode")) {
458 print $fh "No dumps are left in the holding disk.\n\n";
462 if (getconf($CNF_REPORT_NEXT_MEDIA)) {
464 my $run_tapes = getconf($CNF_RUNTAPES);
468 ? print $fh "The next $run_tapes tapes Amanda expects to use are: "
469 : print $fh "The next tape Amanda expects to use is: ";
473 foreach my $i ( 0 .. ( $run_tapes - 1 ) ) {
475 if ( my $tape_label =
476 Amanda::Tapelist::get_last_reusable_tape_label($i) ) {
479 print $fh ", " if !$first;
480 print $fh "$nb_new_tape new tape"
481 . ( $nb_new_tape > 1 ? "s" : "" );
496 print $fh ", " if !$first;
497 print $fh "$nb_new_tape new tape"
498 . ( $nb_new_tape > 1 ? "s" : "" );
502 my $new_tapes = Amanda::Tapelist::list_new_tapes(getconf($CNF_RUNTAPES));
503 print $fh "$new_tapes\n" if $new_tapes;
509 sub output_error_summaries
512 my $errors = $self->{errors};
513 my $report = $self->{report};
515 my @dles = $report->get_dles();
517 my @fatal_failures = ();
518 my @error_failures = ();
519 my @missing_failures = ();
520 my @driver_failures = ();
521 my @planner_failures = ();
522 my @dump_failures = ();
525 foreach my $program (PROGRAM_ORDER) {
527 push @fatal_failures,
528 map { "$program: FATAL $_" }
529 @{ $report->get_program_info($program, "fatal", []) };
530 push @error_failures,
531 map { "$program: ERROR $_" }
532 @{ $report->get_program_info($program, "errors", []) };
535 foreach my $dle_entry (@dles) {
537 my ($hostname, $disk) = @$dle_entry;
538 my $alldumps = $report->get_dle_info(@$dle_entry, "dumps");
539 my $dle = $report->get_dle_info($hostname, $disk);
540 my $qdisk = quote_string($disk);
542 if ($report->get_flag('results_missing') and
543 !defined($alldumps->{$report->{run_timestamp}}) and
546 push @missing_failures, "$hostname $qdisk RESULTS MISSING";
549 if ( exists $dle->{driver}
550 && exists $dle->{driver}->{error}) {
551 push @driver_failures, "$hostname $qdisk lev $dle->{driver}->{level} FAILED $dle->{driver}->{error}";
554 if ( exists $dle->{planner}
555 && exists $dle->{planner}->{error}) {
556 push @planner_failures, "$hostname $qdisk lev $dle->{planner}->{level} FAILED $dle->{planner}->{error}";
559 while( my ($timestamp, $tries) = each %$alldumps ) {
561 foreach my $try (@$tries) {
562 if (exists $try->{dumper} &&
563 $try->{dumper}->{status} &&
564 $try->{dumper}->{status} eq 'fail') {
565 push @dump_failures, "$hostname $qdisk lev $try->{dumper}->{level} FAILED $try->{dumper}->{error}";
568 if (exists $try->{chunker} &&
569 $try->{chunker}->{status} eq 'fail') {
570 push @dump_failures, "$hostname $qdisk lev $try->{chunker}->{level} FAILED $try->{chunker}->{error}";
573 if ( exists $try->{taper}
574 && ( $try->{taper}->{status} eq 'fail'
575 || ( $try->{taper}->{status} eq 'partial'))) {
577 $flush = "FAILED" if exists $try->{dumper} && !exists $try->{chunker};
578 if ($flush ne "FLUSH" or !defined $try->{taper}->{failure_from}
579 or $try->{taper}->{failure_from} ne 'config') {
580 if ($try->{taper}->{status} eq 'partial') {
581 # if the error message is omitted, then the taper only got a partial
582 # dump from the dumper/chunker, rather than failing with a taper error
583 my $errmsg = $try->{taper}{error} || "successfully taped a partial dump";
584 $flush = "partial taper: $errmsg";
586 $flush .= " " . $try->{taper}{error};
589 push @dump_failures, "$hostname $qdisk lev $try->{taper}->{level} $flush";
594 # detect retried dumps
596 && exists $try->{dumper}
597 && ( $try->{dumper}->{status} eq "success"
598 || $try->{dumper}->{status} eq "strange")
599 && ( !exists $try->{chunker}
600 || $try->{chunker}->{status} eq "success")
601 && ( !exists $try->{taper}
602 || $try->{taper}->{status} eq "done")) {
603 push @dump_failures, "$hostname $qdisk lev $try->{dumper}->{level} was successfully retried";
607 # detect dumps re-flushed from holding
609 && !exists $try->{dumper}
610 && !exists $try->{chunker}
611 && exists $try->{taper}
612 && $try->{taper}->{status} eq "done") {
613 push @dump_failures, "$hostname $qdisk lev $try->{taper}->{level} was successfully re-flushed";
618 "$hostname $qdisk lev $try->{dumper}->{level} STRANGE (see below)"
619 if (defined $try->{dumper}
620 && $try->{dumper}->{status} eq 'strange');
624 push @failures, @fatal_failures, @error_failures, @missing_failures,
625 @driver_failures, @planner_failures, @dump_failures;
627 $self->print_if_def(\@failures, "FAILURE DUMP SUMMARY:");
628 $self->print_if_def(\@stranges, "STRANGE DUMP SUMMARY:");
638 # start at level 1 - don't include fulls
639 foreach my $i (1 .. (@$count - 1)) {
640 push @lc, "$i:$count->[$i]" if defined $count->[$i] and $count->[$i] > 0;
642 return join(' ', @lc);
648 my $fh = $self->{fh};
649 my $report = $self->{report};
655 Total Full Incr. Level:#
656 -------- -------- -------- --------
659 my $st_format = <<EOF;
660 @<<<<<<<<<<<<<<<<<<<<<<@>>>>>>>> @>>>>>>>> @>>>>>>>> @<<<<<<<<<<<<<<<<<<
663 # TODO: the hashes are a cheap fix. fix these.
664 my $full_stats = $self->{full_stats};
665 my $incr_stats = $self->{incr_stats};
666 my $total_stats = $self->{total_stats};
668 my ( $ttyp, $tt, $tapesize, $marksize );
669 $ttyp = getconf($CNF_TAPETYPE);
670 $tt = lookup_tapetype($ttyp) if $ttyp;
672 if ( $ttyp && $tt ) {
674 $tapesize = "".tapetype_getconf( $tt, $TAPETYPE_LENGTH );
675 $marksize = "".tapetype_getconf( $tt, $TAPETYPE_FILEMARK );
678 # these values should never be zero; assign defaults
679 $tapesize = 100 * 1024 * 1024 if !$tapesize;
680 $marksize = 1 * 1024 * 1024 if !$marksize;
686 "Estimate Time (hrs:min)",
687 hrmn( $total_stats->{planner_time} ),
693 "Run Time (hrs:min)",
694 hrmn( $total_stats->{total_time} ),
700 "Dump Time (hrs:min)",
701 hrmn( $total_stats->{dumper_time} ),
702 hrmn( $full_stats->{dumper_time} ),
703 hrmn( $incr_stats->{dumper_time} ),
710 sprintf( "%8.1f", $total_stats->{outsize}/1024 ),
711 sprintf( "%8.1f", $full_stats->{outsize}/1024 ),
712 sprintf( "%8.1f", $incr_stats->{outsize}/1024 ),
718 "Original Size (meg)",
719 sprintf( "%8.1f", $total_stats->{origsize}/1024 ),
720 sprintf( "%8.1f", $full_stats->{origsize}/1024 ),
721 sprintf( "%8.1f", $incr_stats->{origsize}/1024 ),
725 my $comp_size = sub {
727 return divzero(100 * $stats->{outsize}, $stats->{origsize});
732 "Avg Compressed Size (%)",
733 $comp_size->($total_stats),
734 $comp_size->($full_stats),
735 $comp_size->($incr_stats),
742 sprintf("%4d", $total_stats->{dumpdisk_count}),
743 sprintf("%4d", $full_stats->{dumpdisk_count}),
744 sprintf("%4d", $incr_stats->{dumpdisk_count}),
745 (has_incrementals($self->{dumpdisks}) ? by_level_count($self->{dumpdisks}) : "")
750 "Avg Dump Rate (k/s)",
751 divzero_wide( $total_stats->{outsize}, $total_stats->{dumper_time} ),
752 divzero_wide( $full_stats->{outsize}, $full_stats->{dumper_time} ),
753 divzero_wide( $incr_stats->{outsize}, $incr_stats->{dumper_time} ),
760 "Tape Time (hrs:min)",
761 hrmn( $total_stats->{taper_time} ),
762 hrmn( $full_stats->{taper_time} ),
763 hrmn( $incr_stats->{taper_time} ),
770 sprintf( "%8.1f", $total_stats->{tapesize}/1024 ),
771 sprintf( "%8.1f", $full_stats->{tapesize}/1024 ),
772 sprintf( "%8.1f", $incr_stats->{tapesize}/1024 ),
776 my $tape_usage = sub {
781 ($stat_ref->{tapedisk_count} + $stat_ref->{tapepart_count}) +
782 $stat_ref->{tapesize}
791 $tape_usage->($total_stats),
792 $tape_usage->($full_stats),
793 $tape_usage->($incr_stats),
798 my @incr_dle = @{$self->{tapedisks}};
799 foreach my $level (1 .. $#incr_dle) {
800 $nb_incr_dle += $incr_dle[$level];
805 $self->{tapedisks}[0] + $nb_incr_dle,
806 $self->{tapedisks}[0],
809 (has_incrementals($self->{tapedisks}))
810 ? by_level_count($self->{tapedisks})
815 # NOTE: only print out the per-level tapeparts if there are
816 # incremental tapeparts
820 sprintf("%4d", $total_stats->{tapepart_count}),
821 sprintf("%4d", $full_stats->{tapepart_count}),
822 sprintf("%4d", $incr_stats->{tapepart_count}),
824 $self->{tapeparts}[1] > 0
825 ? by_level_count($self->{tapeparts})
832 "Avg Tp Write Rate (k/s)",
833 divzero_wide( $total_stats->{tapesize}, $total_stats->{taper_time} ),
834 divzero_wide( $full_stats->{tapesize}, $full_stats->{taper_time} ),
835 divzero_wide( $incr_stats->{tapesize}, $incr_stats->{taper_time} ),
847 for ($a = 1; $a < @$array; $a+=1) {
848 return 1 if $array->[$a] > 0;
853 sub output_tape_stats
856 my $fh = $self->{fh};
857 my $report = $self->{report};
859 my $taper = $report->get_program_info("taper");
860 my $tapes = $taper->{tapes} || {};
861 my $tape_labels = $taper->{tape_labels} || [];
863 # if no tapes used, do nothing
864 return if (!@$tape_labels);
866 my $label_length = 19;
867 foreach my $label (@$tape_labels) {
868 $label_length = length($label) if length($label) > $label_length;
871 . '<' x ($label_length - 1)
872 . "@>>>> @>>>>>>>>>>> @>>>>> @>>>> @>>>>\n";
874 print $fh "USAGE BY TAPE:\n";
875 print $fh swrite($ts_format, "Label", "Time", "Size", "%", "DLEs", "Parts");
877 my $tapetype_name = getconf($CNF_TAPETYPE);
878 my $tapetype = lookup_tapetype($tapetype_name);
879 my $tapesize = "" . tapetype_getconf($tapetype, $TAPETYPE_LENGTH);
880 my $marksize = "" . tapetype_getconf($tapetype, $TAPETYPE_FILEMARK);
882 foreach my $label (@$tape_labels) {
884 my $tape = $tapes->{$label};
886 my $tapeused = $tape->{'kb'};
887 $tapeused += $marksize * (1 + $tape->{'files'});
892 hrmn($tape->{time}), # time
893 sprintf("%.0f", $self->tounits($tape->{kb})) . $self->{disp_unit}, # size
894 divzero(100 * $tapeused, $tapesize), # % usage
895 int($tape->{dle}), # # of dles
896 int($tape->{files}) # # of parts
905 ## takes no arguments
907 my $fh = $self->{fh};
908 my $errors = $self->{errors};
909 my $notes = $self->{notes};
910 my $report = $self->{report};
911 my $stranges = $report->{stranges};
913 my $disp_unit = $self->{disp_unit};
915 my @failed_dump_details;
916 my @strange_dump_details;
918 my @dles = $report->get_dles();
920 foreach my $dle_entry (@dles) {
922 my ($hostname, $disk) = @$dle_entry;
923 my $dle = $report->get_dle_info(@$dle_entry);
924 my $alldumps = $dle->{'dumps'} || {};
925 my $qdisk = quote_string($disk);
928 while( my ($timestamp, $tries) = each %$alldumps ) {
929 foreach my $try (@$tries) {
932 # check for failed dumper details
934 if (defined $try->{dumper}
935 && $try->{dumper}->{status} eq 'fail') {
937 push @failed_dump_details,
938 "/-- $hostname $qdisk lev $try->{dumper}->{level} FAILED $try->{dumper}->{error}",
939 @{ $try->{dumper}->{errors} },
942 if ($try->{dumper}->{nb_errors} > 100) {
943 my $nb = $try->{dumper}->{nb_errors} - 100;
945 push @failed_dump_details,
946 "$nb lines follow, see the corresponding log.* file for the complete list",
952 # check for strange dumper details
954 if (defined $try->{dumper}
955 && $try->{dumper}->{status} eq 'strange') {
957 push @strange_dump_details,
958 "/-- $hostname $qdisk lev $try->{dumper}->{level} STRANGE",
959 @{ $try->{dumper}->{stranges} },
962 if ($try->{dumper}->{nb_stranges} > 100) {
963 my $nb = $try->{dumper}->{nb_stranges} - 100;
964 push @strange_dump_details,
965 "$nb lines follow, see the corresponding log.* file for the complete list",
970 # note: copied & modified from calculate_stats.
972 exists $try->{dumper}
973 && exists $try->{chunker}
974 && defined $try->{chunker}->{kb}
975 && ( $try->{chunker}{status} eq 'success'
976 || $try->{chunker}{status} eq 'partial')
978 $outsize = $try->{chunker}->{kb};
980 exists $try->{dumper}
981 && exists $try->{taper}
982 && defined $try->{taper}->{kb}
983 && ( $try->{taper}{status} eq 'done'
984 || $try->{taper}{status} eq 'partial')
986 $outsize = $try->{taper}->{kb};
992 # check for bad estimates
995 if (exists $dle->{estimate} && defined $outsize) {
996 my $est = $dle->{estimate};
999 "big estimate: $hostname $qdisk $dle->{estimate}{level}",
1000 sprintf(' est: %.0f%s out %.0f%s',
1001 $self->tounits($est->{ckb}), $disp_unit,
1002 $self->tounits($outsize), $disp_unit)
1003 if (defined $est->{'ckb'} && ($est->{ckb} * .9 > $outsize)
1004 && ($est->{ckb} - $outsize > 1.0e5));
1008 $self->print_if_def(\@failed_dump_details, "FAILED DUMP DETAILS:");
1009 $self->print_if_def(\@strange_dump_details, "STRANGE DUMP DETAILS:");
1010 $self->print_if_def($notes, "NOTES:");
1018 ## takes no arguments
1020 my $fh = $self->{fh};
1021 my $report = $self->{report};
1025 sort { ( $a->[0] cmp $b->[0] ) || ( $a->[1] cmp $b->[1] ) }
1026 $report->get_dles();
1028 ## set the col_spec, which is the configuration for the summary
1030 my $col_spec = $self->set_col_spec();
1032 ## collect all the output line specs (see get_summary_info)
1033 my @summary_linespecs = ();
1034 foreach my $dle (@dles) {
1035 push @summary_linespecs, $self->get_summary_info($dle, $report, $col_spec);
1038 # shift off the first element of each tuple
1039 my @summary_linedata =
1040 map { my @x = @$_; shift @x; [ @x ] } @summary_linespecs;
1042 ## get the summary format. this is based on col_spec, but may
1043 ## expand maxwidth columns if they have large fields. Note that
1044 ## this modifies $col_spec in place. Ordering is important: the summary
1045 ## format must be generated before the others.
1046 my $title_format = get_summary_format($col_spec, 'title', @summary_linedata);
1047 my $summary_format = get_summary_format($col_spec, 'full', @summary_linedata);
1048 my $missing_format = get_summary_format($col_spec, 'missing', @summary_linedata);
1049 my $noflush_format = get_summary_format($col_spec, 'noflush', @summary_linedata);
1050 my $nodump_PARTIAL_format = get_summary_format($col_spec, 'nodump-PARTIAL', @summary_linedata);
1051 my $nodump_FAILED_format = get_summary_format($col_spec, 'nodump-FAILED', @summary_linedata);
1052 my $nodump_FLUSH_format = get_summary_format($col_spec, 'nodump-FLUSH', @summary_linedata);
1053 my $nodump_NOT_FLUSHED_format = get_summary_format($col_spec, 'nodump-NOT FLUSHED', @summary_linedata);
1054 my $skipped_format = get_summary_format($col_spec, 'skipped', @summary_linedata);
1056 ## print the header names
1058 $col_spec->[0]->[COLSPEC_WIDTH] +
1059 $col_spec->[1]->[COLSPEC_PRE_SPACE] +
1060 $col_spec->[1]->[COLSPEC_WIDTH] +
1061 $col_spec->[2]->[COLSPEC_PRE_SPACE] +
1062 $col_spec->[2]->[COLSPEC_WIDTH];
1064 $col_spec->[3]->[COLSPEC_WIDTH] +
1065 $col_spec->[4]->[COLSPEC_PRE_SPACE] +
1066 $col_spec->[4]->[COLSPEC_WIDTH] +
1067 $col_spec->[5]->[COLSPEC_PRE_SPACE] +
1068 $col_spec->[5]->[COLSPEC_WIDTH] +
1069 $col_spec->[6]->[COLSPEC_PRE_SPACE] +
1070 $col_spec->[6]->[COLSPEC_WIDTH] +
1071 $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1072 $col_spec->[7]->[COLSPEC_WIDTH];
1074 $col_spec->[8]->[COLSPEC_WIDTH] +
1075 $col_spec->[9]->[COLSPEC_PRE_SPACE] +
1076 $col_spec->[9]->[COLSPEC_WIDTH];
1079 ## use perl's ancient formatting support for the header, since we get free string
1081 my $summary_header_format =
1082 ' ' x ($col_spec->[0]->[COLSPEC_PRE_SPACE] +
1083 $hdl + $col_spec->[4]->[COLSPEC_PRE_SPACE])
1084 . '@' . '|' x ($ds - 1)
1085 . ' ' x $col_spec->[9]->[COLSPEC_PRE_SPACE]
1086 . '@'. '|' x ($ts - 1) . "\n";
1087 my $summary_header = swrite($summary_header_format, "DUMPER STATS", "TAPER STATS");
1089 my $summary_dashes =
1090 ' ' x $col_spec->[0]->[COLSPEC_PRE_SPACE]
1092 . ' ' x $col_spec->[4]->[COLSPEC_PRE_SPACE]
1094 . ' ' x $col_spec->[9]->[COLSPEC_PRE_SPACE]
1097 print $fh "DUMP SUMMARY:\n";
1098 print $fh $summary_header;
1099 print $fh sprintf($title_format, map { $_->[COLSPEC_TITLE] } @$col_spec);
1100 print $fh $summary_dashes;
1102 ## write out each output line
1103 for (@summary_linespecs) {
1104 my ($type, @data) = @$_;
1105 if ($type eq 'full') {
1106 print $fh sprintf($summary_format, @data);
1107 } elsif ($type eq 'nodump-PARTIAL') {
1108 print $fh sprintf($nodump_PARTIAL_format, @data);
1109 } elsif ($type eq 'nodump-FAILED') {
1110 print $fh sprintf($nodump_FAILED_format, @data);
1111 } elsif ($type eq 'nodump-FLUSH') {
1112 print $fh sprintf($nodump_FLUSH_format, @data);
1113 } elsif ($type eq 'nodump-NOT FLUSHED') {
1114 debug("nodump_NOT_FLUSHED_format; $nodump_NOT_FLUSHED_format");
1115 debug("data: " . Data::Dumper::Dumper(\@data));
1116 print $fh sprintf($nodump_NOT_FLUSHED_format, @data);
1117 } elsif ($type eq 'missing') {
1118 print $fh sprintf($missing_format, @data[0..2]);
1119 } elsif ($type eq 'noflush') {
1120 print $fh sprintf($noflush_format, @data[0..2]);
1121 } elsif ($type eq 'skipped') {
1122 print $fh sprintf($skipped_format, @data[0..2]);
1130 ## output_summary helper functions. mostly for formatting, but some
1131 ## for data collection. Returns an 12-tuple matching one of
1133 ## ('full', host, disk, level, orig, out, comp%, dumptime, dumprate,
1134 ## tapetime, taperate, taperpartial)
1135 ## ('missing', host, disk, '' ..) # MISSING -----
1136 ## ('noflush', host, disk, '' ..) # NO FILE TO FLUSH ------
1137 ## ('nodump-$msg', host, disk, level, '', out, '--', '',
1138 ## '', tapetime, taperate, taperpartial) # ... {FLUSH|NOT FLUSHED|FAILED|PARTIAL} ...
1139 ## ('skipped', host, disk, '' ..) # SKIPPED -----
1141 ## the taperpartial column is not covered by the columnspec, and "hangs off"
1142 ## the right side. It's usually empty, but set to " PARTIAL" when the taper
1143 ## write was partial
1145 sub get_summary_info
1148 my ( $dle, $report, $col_spec ) = @_;
1149 my ( $hostname, $disk ) = @$dle;
1152 my $dle_info = $report->get_dle_info(@$dle);
1154 my $tail_quote_trunc = sub {
1155 my ($str, $len) = @_;
1157 my $q_str = quote_string($str);
1160 if (length($q_str) > $len) {
1162 $qt_str = substr($q_str, length($q_str) - $len, $len);
1163 if ($q_str eq $str) {
1166 $qt_str =~ s{^..}{"-};
1176 ($col_spec->[1]->[COLSPEC_MAXWIDTH])
1177 ? quote_string($disk)
1178 : $tail_quote_trunc->($disk, $col_spec->[1]->[COLSPEC_WIDTH]);
1180 my $alldumps = $dle_info->{'dumps'};
1181 if (($dle_info->{'planner'} &&
1182 $dle_info->{'planner'}->{'status'} eq 'fail') or
1183 ($dle_info->{'driver'} &&
1184 $dle_info->{'driver'}->{'status'} eq 'fail')) {
1185 # Do not report driver error if we have a try
1186 if (!exists $alldumps->{$report->{'run_timestamp'}}) {
1188 push @rv, 'nodump-FAILED';
1189 push @rv, $hostname;
1190 push @rv, $disk_out;
1191 push @rv, ("",) x 9;
1194 } elsif ($dle_info->{'planner'} &&
1195 $dle_info->{'planner'}->{'status'} eq 'skipped') {
1197 push @rv, 'skipped';
1198 push @rv, $hostname;
1199 push @rv, $disk_out;
1200 push @rv, ("",) x 8;
1202 } elsif (keys %{$alldumps} == 0) {
1204 push @rv, $report->get_flag("amflush_run")? 'nodump-NOT FLUSHED' : 'missing';
1205 push @rv, $hostname;
1206 push @rv, $disk_out;
1207 push @rv, ("",) x 9;
1211 while( my ($timestamp, $tries) = each %$alldumps ) {
1212 my $last_try = $tries->[-1];
1214 exists $last_try->{taper} ? $last_try->{taper}{level}
1215 : exists $last_try->{chunker} ? $last_try->{chunker}{level}
1216 : $last_try->{dumper}{level};
1218 my $orig_size = undef;
1220 # find the try with the successful dumper entry
1222 foreach my $try (@$tries) {
1223 if ( exists $try->{dumper}
1224 && exists $try->{dumper}{status}
1225 && ( $try->{dumper}{status} eq "success"
1226 || $try->{dumper}{status} eq "strange")) {
1227 $dumper = $try->{dumper};
1231 $orig_size = $dumper->{orig_kb}
1234 my ( $out_size, $dump_time, $dump_rate, $tape_time, $tape_rate ) = (0) x 5;
1235 my $tape_failure_from = '';
1236 my ($dumper_status) = "";
1237 my $saw_dumper = 0; # no dumper will mean this was a flush
1238 my $taper_partial = 0; # was the last taper run partial?
1240 ## Use this loop to set values
1241 foreach my $try ( @$tries ) {
1243 ## find the outsize for the output summary
1246 exists $try->{taper}
1247 && ( $try->{taper}{status} eq "done"
1248 || $try->{taper}{status} eq "part+partial" )
1251 $orig_size = $try->{taper}{orig_kb} if !defined($orig_size);
1252 $out_size = $try->{taper}{kb};
1253 $tape_time = $try->{taper}{sec};
1254 $tape_rate = $try->{taper}{kps};
1255 $tape_failure_from = $try->{taper}{failure_from};
1256 } elsif ( exists $try->{taper}
1257 && ( $try->{taper}{status} eq "partial" ) ) {
1260 $orig_size = $try->{taper}{orig_kb} if !defined($orig_size);
1261 $out_size = $try->{taper}{kb};
1262 $tape_time = $try->{taper}{sec} if !$tape_time;
1263 $tape_rate = $try->{taper}{kps} if !$tape_rate;
1264 $tape_failure_from = $try->{taper}{failure_from};
1265 } elsif (exists $try->{taper} && ( $try->{taper}{status} eq "fail")) {
1268 $tape_failure_from = $try->{taper}{failure_from};
1272 exists $try->{chunker}
1273 && ( $try->{chunker}{status} eq "success"
1274 || $try->{chunker}{status} eq "partial" )
1276 $out_size = $try->{chunker}{kb};
1280 exists $try->{dumper}) {
1281 $out_size = $try->{dumper}{kb};
1284 if ( exists $try->{dumper}) {
1286 $dumper_status = $try->{dumper}{status};
1289 ## find the dump time
1290 if ( exists $try->{dumper}
1291 && exists $try->{dumper}{status}
1292 && ( $try->{dumper}{status} eq "success"
1293 || $try->{dumper}{status} eq "strange")) {
1295 $dump_time = $try->{dumper}{sec};
1296 $dump_rate = $try->{dumper}{kps};
1300 # sometimes the driver logs an orig_size of -1, which makes the
1301 # compression percent very large and negative
1302 $orig_size = 0 if (defined $orig_size && $orig_size < 0);
1304 # pre-format the compression column, with '--' replacing 100% (i.e.,
1307 if (!defined $orig_size || $orig_size == $out_size) {
1308 $compression = '--';
1311 divzero_col((100 * $out_size), $orig_size, $col_spec->[5]);
1314 ## simple formatting macros
1316 my $fmt_col_field = sub {
1317 my ( $column, $data ) = @_;
1320 $col_spec->[$column]->[COLSPEC_FORMAT],
1321 $col_spec->[$column]->[COLSPEC_WIDTH],
1322 $col_spec->[$column]->[COLSPEC_PREC], $data
1326 my $format_space = sub {
1327 my ( $column, $data ) = @_;
1329 return sprintf("%*s",$col_spec->[$column]->[COLSPEC_WIDTH], $data);
1334 if ( !$orig_size && !$out_size && ((!defined($tape_time) || !$tape_time) && !defined($tape_failure_from))) {
1335 push @rv, $report->get_flag("amflush_run")? 'noflush' : 'missing';
1336 push @rv, $hostname;
1337 push @rv, $disk_out;
1338 push @rv, ("",) x 8;
1339 } elsif ($saw_dumper and ($dumper_status eq 'success' or $dumper_status eq 'strange')) {
1341 push @rv, $hostname;
1342 push @rv, $disk_out;
1343 push @rv, $fmt_col_field->(2, $level);
1344 push @rv, $orig_size ? $fmt_col_field->(3, $self->tounits($orig_size)) : '';
1345 push @rv, $out_size ? $fmt_col_field->(4, $self->tounits($out_size)) : '';
1346 push @rv, $compression;
1347 push @rv, $dump_time ? $fmt_col_field->(6, mnsc($dump_time)) : "PARTIAL";
1348 push @rv, $dump_rate ? $fmt_col_field->(7, $dump_rate) : "";
1349 if (defined $tape_failure_from and $tape_failure_from eq 'config') {
1350 push @rv, $format_space->(8,"");
1351 push @rv, $format_space->(9,"");
1353 push @rv, $fmt_col_field->(8,
1354 (defined $tape_time) ?
1355 $tape_time ? mnsc($tape_time) : ""
1357 push @rv, (defined $tape_rate) ?
1359 $fmt_col_field->(9, $tape_rate)
1360 : $format_space->(9, "")
1361 : $format_space->(9, "FAILED");
1363 push @rv, $taper_partial? " PARTIAL" : ""; # column 10
1365 my $message = $saw_dumper?
1366 ($dumper_status eq 'failed') ? 'FAILED' : 'PARTIAL'
1367 : (defined $tape_failure_from and
1368 $tape_failure_from eq 'config') ? 'NOT FLUSHED'
1370 push @rv, "nodump-$message";
1371 push @rv, $hostname;
1372 push @rv, $disk_out;
1373 push @rv, $fmt_col_field->(2, $level);
1374 push @rv, $orig_size ? $fmt_col_field->(4, $self->tounits($orig_size)) :'';
1375 push @rv, $out_size ? $fmt_col_field->(4, $self->tounits($out_size)) : '';
1376 push @rv, $compression;
1379 if (defined $tape_failure_from and $tape_failure_from eq 'config') {
1380 push @rv, $format_space->(8,"");
1381 push @rv, $format_space->(9,"");
1382 next if !$report->get_flag("amflush_run"); # do not print a line for flush with config error
1384 push @rv, $fmt_col_field->(8,
1385 (defined $tape_time) ?
1386 $tape_time ? mnsc($tape_time) : ""
1388 push @rv, (defined $tape_rate) ?
1390 $fmt_col_field->(9, $tape_rate)
1391 : $format_space->(9, "")
1392 : $format_space->(9, "FAILED");
1394 push @rv, $taper_partial? " PARTIAL" : "";
1401 sub get_summary_format
1403 my ($col_spec, $type, @summary_lines) = @_;
1404 my @col_format = ();
1406 if ($type eq 'full' || $type eq 'title') {
1407 foreach my $i ( 0 .. ( @$col_spec - 1 ) ) {
1409 get_summary_col_format( $i, $col_spec->[$i],
1410 map { $_->[$i] } @summary_lines );
1413 # first two columns are the same
1414 foreach my $i ( 0 .. 1 ) {
1416 get_summary_col_format( $i, $col_spec->[$i],
1417 map { $_->[$i] } @summary_lines );
1420 # some of these have a lovely text rule, just to be difficult
1422 $col_spec->[3]->[COLSPEC_WIDTH] +
1423 $col_spec->[4]->[COLSPEC_PRE_SPACE] +
1424 $col_spec->[4]->[COLSPEC_WIDTH] +
1425 $col_spec->[5]->[COLSPEC_PRE_SPACE] +
1426 $col_spec->[5]->[COLSPEC_WIDTH] +
1427 $col_spec->[6]->[COLSPEC_PRE_SPACE] +
1428 $col_spec->[6]->[COLSPEC_WIDTH] +
1429 $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1430 $col_spec->[7]->[COLSPEC_WIDTH] +
1431 $col_spec->[8]->[COLSPEC_PRE_SPACE] +
1432 $col_spec->[8]->[COLSPEC_WIDTH] +
1433 $col_spec->[9]->[COLSPEC_PRE_SPACE] +
1434 $col_spec->[9]->[COLSPEC_WIDTH];
1436 if ($type eq 'missing') {
1437 # add a blank level column and the space for the origkb column
1438 push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1439 push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1440 push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1441 my $str = "MISSING ";
1442 $str .= '-' x ($rulewidth - length($str));
1443 push @col_format, $str;
1444 } elsif ($type eq 'noflush') {
1445 # add a blank level column and the space for the origkb column
1446 push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1447 push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1448 push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1450 my $str = "NO FILE TO FLUSH ";
1451 $str .= '-' x ($rulewidth - length($str));
1452 push @col_format, $str;
1453 } elsif ($type =~ /^nodump-(.*)$/) {
1456 # nodump has level, origkb, outkb, and comp% although origkb is usually blank and
1458 foreach my $i ( 2 .. 5 ) {
1460 get_summary_col_format( $i, $col_spec->[$i],
1461 map { $_->[$i] } @summary_lines );
1464 # and then the message is centered across columns 6 and 7, which are both blank
1465 push @col_format, ' ' x $col_spec->[6]->[COLSPEC_PRE_SPACE];
1467 $col_spec->[6]->[COLSPEC_WIDTH] +
1468 $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1469 $col_spec->[7]->[COLSPEC_WIDTH];
1471 my $str = ' ' x (($width - length($msg))/2);
1473 $str .= ' ' x ($width - length($str));
1474 push @col_format, $str;
1475 push @col_format, "%s%s"; # consume empty columns 6 and 7
1477 # and finally columns 8 and 9 as usual
1478 foreach my $i ( 8 .. 9 ) {
1480 get_summary_col_format( $i, $col_spec->[$i],
1481 map { $_->[$i] } @summary_lines );
1483 } elsif ($type eq 'skipped') {
1484 # add a blank level column and the space for the origkb column
1485 push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1486 push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1487 push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1488 my $str = "SKIPPED ";
1489 $str .= '-' x ($rulewidth - length($str));
1490 push @col_format, $str;
1494 # and format the hidden 10th column. This is not part of the columnspec,
1495 # so its width is not counted in any of the calculations here.
1496 push @col_format, "%s" if $type ne 'title';
1498 return join( "", @col_format ) . "\n";
1501 sub get_summary_col_format
1503 my ( $i, $col, @entries ) = @_;
1505 my $col_width = $col->[COLSPEC_WIDTH];
1506 my $left_align = ($i == 0 || $i == 1); # first 2 cols left-aligned
1507 my $limit_width = ($i == 0 || $i == 1); # and not allowed to overflow
1509 ## if necessary, resize COLSPEC_WIDTH to the maximum widht
1511 if ($col->[COLSPEC_MAXWIDTH]) {
1513 push @entries, $col->[COLSPEC_TITLE];
1514 my $strmax = max( map { length $_ } @entries );
1515 $col_width = max($strmax, $col_width);
1516 # modify the spec in place, so the headers and
1517 # whatnot all add up .. yuck!
1518 $col->[COLSPEC_WIDTH] = $col_width;
1521 # put together a "%s" format for this column
1522 my $rv = ' ' x $col->[COLSPEC_PRE_SPACE]; # space on left
1524 $rv .= '-' if $left_align;
1526 $rv .= ".$col_width" if $limit_width;
1530 ## col_spec functions. I want to deprecate this stuff so bad it hurts.
1535 my $report = $self->{report};
1536 my $disp_unit = $self->{disp_unit};
1538 $self->{col_spec} = [
1539 [ "HostName", 0, 12, 12, 1, "%-*.*s", "HOSTNAME" ],
1540 [ "Disk", 1, 11, 11, 1, "%-*.*s", "DISK" ],
1541 [ "Level", 1, 1, 1, 1, "%*.*d", "L" ],
1542 [ "OrigKB", 1, 7, 0, 1, "%*.*f", "ORIG-" . $disp_unit . "B" ],
1543 [ "OutKB", 1, 7, 0, 1, "%*.*f", "OUT-" . $disp_unit . "B" ],
1544 [ "Compress", 1, 6, 1, 1, "%*.*f", "COMP%" ],
1545 [ "DumpTime", 1, 7, 7, 1, "%*.*s", "MMM:SS" ],
1546 [ "DumpRate", 1, 6, 1, 1, "%*.*f", "KB/s" ],
1547 [ "TapeTime", 1, 6, 6, 1, "%*.*s", "MMM:SS" ],
1548 [ "TapeRate", 1, 6, 1, 1, "%*.*f", "KB/s" ]
1551 $self->apply_col_spec_override();
1552 return $self->{col_spec};
1555 sub apply_col_spec_override
1558 my $col_spec = $self->{col_spec};
1560 my %col_spec_override = $self->read_col_spec_override();
1562 foreach my $col (@$col_spec) {
1563 if ( my $col_override = $col_spec_override{ $col->[COLSPEC_NAME] } ) {
1564 my $override_col_val_if_def = sub {
1565 my ( $field, $or_num ) = @_;
1566 if ( defined $col_override->[$or_num]
1567 && !( $col_override->[$or_num] eq "" ) ) {
1568 $col->[$field] = $col_override->[$or_num];
1572 $override_col_val_if_def->( COLSPEC_PRE_SPACE, 0 );
1573 $override_col_val_if_def->( COLSPEC_WIDTH, 1 );
1574 $override_col_val_if_def->( COLSPEC_PREC, 2 );
1575 $override_col_val_if_def->( COLSPEC_MAXWIDTH, 3 );
1580 sub read_col_spec_override
1584 my $col_spec_str = getconf($CNF_COLUMNSPEC) || return;
1585 my %col_spec_override = ();
1586 my $col_spec = $self->{col_spec};
1588 foreach (split(",", $col_spec_str)) {
1590 $_ =~ m/^(\w+) # field name
1591 =([-:\d]+) # field values
1593 or confess "error: malformed columnspec string:$col_spec_str";
1598 foreach my $col (@$col_spec) {
1599 if (lc $field eq lc $col->[0]) {
1605 die("Invalid field name: $field");
1608 my @field_values = split ':', $2;
1611 confess "error: malformed columnspec string:$col_spec_str"
1612 if (@field_values > 3);
1614 # all values *should* be in the right place. If not enough
1615 # were given, pad the array.
1616 push @field_values, "" while (@field_values < 4);
1618 # if the second value is negative, that means MAXWIDTH=1, so
1619 # sort that out now. Yes, this is pretty ugly. Imagine this in C!
1620 if ($field_values[1] ne '') {
1621 if ($field_values[1] =~ /^-/) {
1622 $field_values[1] =~ s/^-//;
1623 $field_values[3] = 1;
1625 $field_values[3] = 0;
1629 $col_spec_override{$field} = \@field_values;
1632 return %col_spec_override;
1637 my ($self, $msgs, $header) = @_;
1638 my $fh = $self->{fh};
1640 @$msgs or return; # do not print section if no messages
1642 print $fh "$header\n";
1643 foreach my $msg (@$msgs) {
1644 print $fh " $msg\n";