git.gag.com Git - debian/amanda/blob - perl/Amanda/Report/human.pm

   1 # Copyright (c) 2010 Zmanda, Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or modify it
   4 # under the terms of the GNU General Public License version 2 as published
   5 # by the Free Software Foundation.
   6 #
   7 # This program is distributed in the hope that it will be useful, but
   8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   9 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  10 # for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along
  13 # with this program; if not, write to the Free Software Foundation, Inc.,
  14 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  15 #
  16 # Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
  17 # Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
  18 #
  19
  20 package Amanda::Report::human;
  21
  22 use strict;
  23 use warnings;
  24
  25 use POSIX;
  26 use Data::Dumper;
  27
  28 use Amanda::Config qw(:getconf config_dir_relative);
  29 use Amanda::Util qw(:constants quote_string );
  30 use Amanda::Holding;
  31 use Amanda::Tapelist;
  32 use Amanda::Debug qw( debug );
  33 use Amanda::Util qw( quote_string );
  34
  35 use Amanda::Report;
  36
  37 ## constants that define the column specification output format.
  38
  39 use constant COLSPEC_NAME      => 0;    # column name; used internally
  40 use constant COLSPEC_PRE_SPACE => 1;    # prefix spaces
  41 use constant COLSPEC_WIDTH     => 2;    # column width
  42 use constant COLSPEC_PREC      => 3;    # post-decimal precision
  43 use constant COLSPEC_MAXWIDTH  => 4;    # resize if set
  44 use constant COLSPEC_FORMAT    => 5;    # sprintf format
  45 use constant COLSPEC_TITLE     => 6;    # column title
  46
  47 use constant PROGRAM_ORDER =>
  48   qw(amdump planner amflush driver dumper chunker taper reporter);
  49
  50
  51 ## helper functions
  52
  53 sub divzero
  54 {
  55     my ( $a, $b ) = @_;
  56     my $q;
  57     return
  58         ( $b == 0 )              ? "-- "
  59       : ( ($q = $a / $b) > 99999.95 ) ? "#####"
  60       : ( $q > 999.95 ) ? sprintf( "%5.0f", $q )
  61       :                   sprintf( "%5.1f", $q );
  62 }
  63
  64 sub divzero_wide
  65 {
  66     my ( $a, $b ) = @_;
  67     my $q;
  68     return
  69         ( $b == 0 )              ? "-- "
  70       : ( ($q = $a / $b) > 9999999.95 ) ? "#######"
  71       : ( $q > 99999.95 ) ? sprintf( "%7.0f", $q )
  72       :                     sprintf( "%7.1f", $q );
  73 }
  74
  75 sub divzero_col
  76 {
  77     my ( $a, $b, $col ) = @_;
  78     return ( $b == 0 )
  79       ? "-- "
  80       : sprintf( $col->[5], $col->[2], $col->[3], ( $a / $b ) );
  81 }
  82
  83 sub swrite
  84 {
  85     my ( $format, @args ) = @_;
  86     local $^A = "";
  87     formline( $format, @args );
  88     return $^A;
  89 }
  90
  91 sub max
  92 {
  93     my ( $max, @args ) = @_;    # first element starts as max
  94
  95     foreach my $elt (@args) {
  96         $max = $elt if $elt > $max;
  97     }
  98     return $max;
  99 }
 100
 101 sub min
 102 {
 103     my ( $min, @args ) = @_;    # first element starts as min
 104
 105     foreach my $elt (@args) {
 106         $min = $elt if $elt < $min;
 107     }
 108     return $min;
 109 }
 110
 111 sub hrmn
 112 {
 113     my ($sec) = @_;
 114     $sec += 30; # round up
 115     my ( $hr, $mn ) = ( int( $sec / ( 60 * 60 ) ), int( $sec / 60 ) % 60 );
 116     return sprintf( '%d:%02d', $hr, $mn );
 117 }
 118
 119 sub mnsc
 120 {
 121     my ($sec) = @_;
 122     $sec += 0.5; # round up
 123     my ( $mn, $sc ) = ( int( $sec / (60) ), int( $sec % 60 ) );
 124     return sprintf( '%d:%02d', $mn, $sc );
 125 }
 126
 127 ## helper methods
 128
 129 # return $val/$unit_divisor as a a floating-point number
 130 sub tounits {
 131     my $self = shift;
 132     my ($val, %params) = @_;
 133
 134     return $params{'zero'} if ($val == 0 and exists $params{'zero'});
 135
 136     # $orig_size and $out_size are bigints, which must be stringified to cast
 137     # them to floats.  We need floats, because they round nicely.  This is
 138     # ugly and hard to track down.
 139     my $flval = $val.".0";
 140     my $flunit = $self->{'unit_div'}.".0";
 141     return $flval / $flunit;
 142 }
 143
 144 ## class functions
 145
 146 sub new
 147 {
 148     my ($class, $report, $fh, $config_name, $logfname) = @_;
 149
 150     my $self = {
 151         report      => $report,
 152         fh          => $fh,
 153         config_name => $config_name,
 154         logfname    => $logfname,
 155
 156         ## config info
 157         disp_unit => getconf($CNF_DISPLAYUNIT),
 158         unit_div  => getconf_unit_divisor(),
 159
 160         ## statistics
 161         incr_stats  => {},
 162         full_stats  => {},
 163         total_stats => {},
 164         dumpdisks   => [ 0, 0 ],    # full_count, incr_count
 165         tapedisks   => [ 0, 0 ],
 166         tapeparts  => [ 0, 0 ],
 167     };
 168
 169     if (defined $report) {
 170
 171         my (@errors, @stranges, @notes);
 172
 173         @errors =
 174           map { @{ $report->get_program_info($_, "errors", []) }; }
 175           PROGRAM_ORDER;
 176         ## prepend program name to notes lines.
 177         foreach my $program (PROGRAM_ORDER) {
 178             push @notes,
 179               map { "$program: $_" }
 180               @{ $report->get_program_info($program, "notes", []) };
 181         }
 182
 183         $self->{errors} = \@errors;
 184         $self->{notes}  = \@notes;
 185     }
 186
 187     bless $self, $class;
 188     return $self;
 189 }
 190
 191 sub calculate_stats
 192 {
 193     my ($self) = @_;
 194     my $fh     = $self->{fh};
 195     my $report = $self->{report};
 196
 197     # TODO: the hashes are a cheap fix.  fix these.
 198     my @dles        = $report->get_dles();
 199     my $full_stats  = $self->{full_stats};
 200     my $incr_stats  = $self->{incr_stats};
 201     my $total_stats = $self->{total_stats};
 202     my $dumpdisks   = $self->{dumpdisks};
 203     my $tapedisks   = $self->{tapedisks};
 204     my $tapeparts  = $self->{tapeparts};
 205
 206     ## initialize all relevant fields to 0
 207     map { $incr_stats->{$_} = $full_stats->{$_} = 0; }
 208       qw/dumpdisk_count tapedisk_count tapepart_count outsize origsize
 209       tapesize coutsize corigsize taper_time dumper_time/;
 210
 211     foreach my $dle_entry (@dles) {
 212
 213         # $dle_entry = [$hostname, $disk]
 214         my $dle = $report->get_dle_info(@$dle_entry);
 215
 216         foreach my $try ( @{ $dle->{tries} } ) {
 217
 218             my $level = exists $try->{dumper} ? $try->{dumper}{'level'} :
 219                         exists $try->{taper} ? $try->{taper}{'level'} :
 220                         0;
 221             my $stats = ($level > 0) ? $incr_stats : $full_stats;
 222
 223             # compute out size, skipping flushes (tries without a dumper run)
 224             my $outsize = 0;
 225             if (exists $try->{dumper}
 226                 && exists $try->{chunker} && defined $try->{chunker}->{kb}
 227                 && ( $try->{chunker}{status} eq 'success'
 228                   || $try->{chunker}{status} eq 'partial')) {
 229                 $outsize = $try->{chunker}->{kb};
 230             } elsif (exists $try->{dumper}
 231                 && exists $try->{taper} && defined $try->{taper}->{kb}
 232                 && (   $try->{taper}{status} eq 'done'
 233                     || $try->{taper}{status} eq 'partial')) {
 234                 $outsize = $try->{taper}->{kb};
 235             }
 236
 237             # compute orig size, again skipping flushes
 238             my $origsize = 0;
 239             if ( exists $try->{dumper}
 240                 && (   $try->{dumper}{status} eq 'success'
 241                     || $try->{dumper}{status} eq 'strange')) {
 242
 243                 $origsize = $try->{dumper}{orig_kb};
 244                 $stats->{dumper_time} += $try->{dumper}{sec};
 245                 $stats->{dumpdisk_count}++; # count this as a dumped filesystem
 246                 $dumpdisks->[$try->{dumper}{'level'}]++; #by level count
 247             } elsif (exists $try->{dumper}
 248                 && exists $try->{taper} && defined $try->{taper}->{kb}
 249                 && (   $try->{taper}{status} eq 'done'
 250                     || $try->{taper}{status} eq 'partial')) {
 251                 # orig_kb doesn't always exist (older logfiles)
 252                 if ($try->{taper}->{orig_kb}) {
 253                     $origsize = $try->{taper}->{orig_kb};
 254                 }
 255             }
 256
 257             if ( exists $try->{taper}
 258                 && ( $try->{taper}{status} eq 'done'
 259                   || $try->{taper}{status} eq 'partial')) {
 260
 261                 $stats->{tapesize}   += $try->{taper}{kb};
 262                 $stats->{taper_time} += $try->{taper}{sec};
 263                 $stats->{tapepart_count} += @{ $try->{taper}{parts} }
 264                     if $try->{taper}{parts};
 265                 $stats->{tapedisk_count}++;
 266
 267                 $tapedisks->[ $try->{taper}{level} ]++;    #by level count
 268                 $tapeparts->[$try->{taper}{level}] += @{ $try->{taper}{parts} }
 269                     if $try->{taper}{parts};
 270             }
 271
 272             # add those values to the stats
 273             $stats->{'origsize'} += $origsize;
 274             $stats->{'outsize'} += $outsize;
 275
 276             # if the sizes differ, then we have a compressed dump, so also add it to
 277             # c{out,orig}size
 278             $stats->{'corigsize'} += $origsize;
 279             $stats->{'coutsize'} += $outsize;
 280         }
 281     }
 282
 283     %$total_stats = map { $_ => $incr_stats->{$_} + $full_stats->{$_} }
 284       keys %$incr_stats;
 285
 286     $total_stats->{planner_time} =
 287       $report->get_program_info("planner", "time", 0);
 288
 289     if ($report->get_flag("got_finish")) {
 290         $total_stats->{total_time} =
 291              $report->get_program_info("driver",  "time", 0)
 292           || $report->get_program_info("amflush", "time", 0);
 293     } else {
 294         $total_stats->{total_time} =
 295           $total_stats->{taper_time} + $total_stats->{planner_time};
 296     }
 297
 298     $total_stats->{idle_time} =
 299       ( $total_stats->{total_time} - $total_stats->{planner_time} ) -
 300       $total_stats->{taper_time};
 301
 302     # TODO: tape info is very sparse.  There either needs to be a
 303     # function that collects and fills in tape info post-processing in
 304     # Amanda::Report, or it needs to be done here.
 305     return;
 306 }
 307
 308 sub print_human_amreport
 309 {
 310     my ( $self, $fh ) = @_;
 311
 312     $fh ||= $self->{fh}
 313       || die "error: no file handle given to print_human_amreport\n";
 314
 315     ## collect statistics
 316     $self->calculate_stats();
 317
 318     ## print the basic info header
 319     $self->print_header();
 320
 321     ## print out statements about past and predicted tape usage
 322     $self->output_tapeinfo();
 323
 324     ## print out error messages from the run
 325     $self->output_error_summaries();
 326
 327     ## print out aggregated statistics for the whole dump
 328     $self->output_stats();
 329
 330     ## print out statistics for each tape used
 331     $self->output_tape_stats();
 332
 333     ## print out all errors & comments
 334     $self->output_details();
 335
 336     ## print out dump statistics per DLE
 337     $self->output_summary();
 338
 339     ## footer
 340     print $fh
 341       "(brought to you by Amanda version $Amanda::Constants::VERSION)\n";
 342
 343     return;
 344 }
 345
 346 sub print_header
 347 {
 348     my ($self) = @_;
 349
 350     my $report      = $self->{report};
 351     my $fh          = $self->{fh};
 352     my $config_name = $self->{config_name};
 353
 354     my $hostname = $report->{hostname};
 355     my $org      = getconf($CNF_ORG);
 356
 357     # TODO: this should be a shared method somewhere
 358     my $timestamp = $report->get_timestamp();
 359     my ($year, $month, $day) = ($timestamp =~ m/^(\d\d\d\d)(\d\d)(\d\d)/);
 360     my $date  = POSIX::strftime('%B %e, %Y', 0, 0, 0, $day, $month - 1, $year - 1900);
 361     $date =~ s/  / /g; # get rid of intervening space
 362
 363     print $fh "*** THE DUMPS DID NOT FINISH PROPERLY!\n\n"
 364       unless ($report->{flags}{got_finish});
 365
 366     my $header_format = <<EOF;
 367 @<<<<<<<: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<...
 368 EOF
 369
 370     if ($hostname) {
 371         print $fh swrite($header_format, "Hostname", $hostname);
 372         print $fh swrite($header_format, "Org",      $org);
 373         print $fh swrite($header_format, "Config",   $config_name);
 374         print $fh swrite($header_format, "Date",     $date);
 375         print $fh "\n";
 376     }
 377
 378     return;
 379 }
 380
 381 sub output_tapeinfo
 382 {
 383     my ($self)   = @_;
 384     my $report   = $self->{report};
 385     my $fh       = $self->{fh};
 386     my $logfname = $self->{logfname};
 387
 388     my $taper       = $report->get_program_info("taper");
 389     my $tapes       = $taper->{tapes}       || {};
 390     my $tape_labels = $taper->{tape_labels} || [];
 391
 392     my %full_stats  = %{ $self->{full_stats} };
 393     my %incr_stats  = %{ $self->{incr_stats} };
 394     my %total_stats = %{ $self->{total_stats} };
 395
 396     if (@$tape_labels > 0) {
 397
 398         # slightly different sentence for amflush and amdump
 399         my $tapelist_str;
 400         if ($report->get_flag("amflush_run")) {
 401             $tapelist_str = "The dumps were flushed ";
 402         } else {
 403             $tapelist_str = "These dumps were ";
 404         }
 405         $tapelist_str .= (@$tape_labels > 1) ? "to tapes " : "to tape ";
 406         $tapelist_str .= join(", ", @$tape_labels) . ".\n";
 407         print $fh $tapelist_str;
 408     }
 409
 410     if (my $tape_error =
 411         $report->get_program_info("taper", "tape_error", undef)) {
 412
 413         $tape_error =~ s{^no-tape }{};
 414         if ($tape_error =~ /^\[CONFIG:/) {
 415             $tape_error =~ s/^\[CONFIG://;
 416             $tape_error =~ s/\]$//;
 417             print $fh "Not using all tapes because $tape_error.\n";
 418         } else {
 419             print $fh "*** A TAPE ERROR OCCURRED: $tape_error.\n";
 420         }
 421     }
 422
 423     ## if this is a historical report, do not generate holding disk
 424     ## information.  If this dump is the most recent, output holding
 425     ## disk info.
 426     if ($report->get_flag("historical")) {
 427         print $fh "Some dumps may have been left in the holding disk.\n\n"
 428           if $report->get_flag("degraded_mode")
 429
 430     } else {
 431
 432         my @holding_list = Amanda::Holding::get_files_for_flush();
 433         my $h_size = 0;
 434         foreach my $holding_file (@holding_list) {
 435             $h_size += (0 + Amanda::Holding::file_size($holding_file, 1));
 436         }
 437
 438         my $h_size_u =
 439           sprintf("%.0f%s", $self->tounits($h_size), $self->{disp_unit});
 440
 441         if ($h_size > 0) {
 442             print $fh
 443               "There are $h_size_u of dumps left in the holding disk.\n";
 444
 445             (getconf($CNF_AUTOFLUSH))
 446               ? print $fh "They will be flushed on the next run.\n\n"
 447               : print $fh "Run amflush to flush them to tape.\n\n";
 448
 449         } elsif ($report->get_flag("degraded_mode")) {
 450             print $fh "No dumps are left in the holding disk.\n\n";
 451         }
 452     }
 453
 454     my $nb_new_tape = 0;
 455     my $run_tapes   = getconf($CNF_RUNTAPES);
 456
 457     if ($run_tapes) {
 458         ($run_tapes > 1)
 459           ? print $fh "The next $run_tapes tapes Amanda expects to use are: "
 460           : print $fh "The next tape Amanda expects to use is: ";
 461     }
 462
 463     my $first = 1;
 464     foreach my $i ( 0 .. ( $run_tapes - 1 ) ) {
 465
 466         if ( my $tape_label =
 467             Amanda::Tapelist::get_last_reusable_tape_label($i) ) {
 468
 469             print $fh
 470                 $first ? "" : ", ",
 471                 $tape_label;
 472             $first = 0;
 473         } else {
 474             $nb_new_tape++;
 475         }
 476     }
 477
 478     if ($nb_new_tape) {
 479         print $fh ", " if !$first;
 480         print $fh "$nb_new_tape new tape"
 481           . ( $nb_new_tape > 1 ? "s" : "" );
 482     }
 483     print $fh ".\n";
 484
 485     my $new_tapes = Amanda::Tapelist::list_new_tapes(getconf($CNF_RUNTAPES));
 486     print $fh "$new_tapes\n" if $new_tapes;
 487
 488     return;
 489 }
 490
 491 sub output_error_summaries
 492 {
 493     my ($self)   = @_;
 494     my $errors   = $self->{errors};
 495     my $report   = $self->{report};
 496
 497     my @dles     = $report->get_dles();
 498     my @failures = ();
 499     my @fatal_failures = ();
 500     my @error_failures = ();
 501     my @missing_failures = ();
 502     my @driver_failures = ();
 503     my @planner_failures = ();
 504     my @dump_failures = ();
 505     my @stranges = ();
 506
 507     foreach my $program (PROGRAM_ORDER) {
 508
 509         push @fatal_failures,
 510           map { "$program: FATAL $_" }
 511           @{ $report->get_program_info($program, "fatal", []) };
 512         push @error_failures,
 513           map { "$program: ERROR $_" }
 514           @{ $report->get_program_info($program, "errors", []) };
 515     }
 516
 517     foreach my $dle_entry (@dles) {
 518
 519         my ($hostname, $disk) = @$dle_entry;
 520         my $tries = $report->get_dle_info(@$dle_entry, "tries");
 521         my $dle = $report->get_dle_info($hostname, $disk);
 522         my $qdisk = quote_string($disk);
 523         my $failed = 0;
 524
 525         if ($report->get_flag('results_missing') and !@$tries and
 526             !$dle->{planner}) {
 527             push @missing_failures, "$hostname $qdisk RESULTS MISSING";
 528         }
 529
 530         if (   exists $dle->{driver}
 531             && exists $dle->{driver}->{error}) {
 532             push @driver_failures, "$hostname $qdisk lev $dle->{driver}->{level}  FAILED $dle->{driver}->{error}";
 533         }
 534
 535         if (   exists $dle->{planner}
 536             && exists $dle->{planner}->{error}) {
 537             push @planner_failures, "$hostname $qdisk lev $dle->{planner}->{level}  FAILED $dle->{planner}->{error}";
 538         }
 539
 540         foreach my $try (@$tries) {
 541             if (exists $try->{dumper} &&
 542                 $try->{dumper}->{status} eq 'fail') {
 543                 push @dump_failures, "$hostname $qdisk lev $try->{dumper}->{level}  FAILED $try->{dumper}->{error}";
 544                 $failed = 1;
 545             }
 546             if (exists $try->{chunker} &&
 547                 $try->{chunker}->{status} eq 'fail') {
 548                 push @dump_failures, "$hostname $qdisk lev $try->{chunker}->{level}  FAILED $try->{chunker}->{error}";
 549                 $failed = 1;
 550             }
 551             if (   exists $try->{taper}
 552                 && (   $try->{taper}->{status} eq 'fail'
 553                     || (   $try->{taper}->{status} eq 'partial'))) {
 554             #&& defined $try->{taper}->{error}
 555             #&& $try->{taper}->{error} ne ""))) {
 556                 my $flush = "FLUSH";
 557                 $flush = "FAILED" if exists $try->{dumper} && !exists $try->{chunker};
 558                 if ($flush ne "FLUSH" or $try->{taper}->{error} !~ /CONFIG:/) {
 559                     if ($try->{taper}->{status} eq 'partial') {
 560                         # if the error message is omitted, then the taper only got a partial
 561                         # dump from the dumper/chunker, rather than failing with a taper error
 562                         my $errmsg = $try->{taper}{error} || "successfully taped a partial dump";
 563                         $flush = "partial taper: $errmsg";
 564                     } else {
 565                         $flush .= " " . $try->{taper}{error};
 566                     }
 567
 568                     push @dump_failures, "$hostname $qdisk lev $try->{taper}->{level}  $flush";
 569                     $failed = 1;
 570                 }
 571             }
 572             if (   $failed
 573                 && exists $try->{dumper}
 574                 && $try->{dumper}->{status} eq "success"
 575                 && (   !exists $try->{chunker}
 576                     || $try->{chunker}->{status} eq "success")
 577                 && (   !exists $try->{taper}
 578                     || $try->{taper}->{status} eq "done")) {
 579                 push @dump_failures, "$hostname $qdisk lev $try->{dumper}->{level}  was successfully retried";
 580             }
 581
 582             push @stranges,
 583 "$hostname $qdisk lev $try->{dumper}->{level}  STRANGE (see below)"
 584               if (defined $try->{dumper}
 585                 && $try->{dumper}->{status} eq 'strange');
 586         }
 587     }
 588     push @failures, @fatal_failures, @error_failures, @missing_failures,
 589                     @driver_failures, @planner_failures, @dump_failures;
 590
 591     $self->print_if_def(\@failures, "FAILURE DUMP SUMMARY:");
 592     $self->print_if_def(\@stranges, "STRANGE DUMP SUMMARY:");
 593
 594     return;
 595 }
 596
 597 sub by_level_count
 598 {
 599     my ($count) = @_;
 600     my @lc;
 601
 602     # start at level 1 - don't include fulls
 603     foreach my $i (1 .. (@$count - 1)) {
 604         push @lc, "$i:$count->[$i]" if $count->[$i] > 0;
 605     }
 606     return '(' . join(' ', @lc) . ')';
 607 }
 608
 609 sub output_stats
 610 {
 611     my ($self) = @_;
 612     my $fh     = $self->{fh};
 613     my $report = $self->{report};
 614
 615     my $header = <<EOF;
 616
 617
 618 STATISTICS:
 619                           Total       Full      Incr.
 620                         --------   --------   --------
 621 EOF
 622
 623     my $st_format = <<EOF;
 624 @<<<<<<<<<<<<<<<<<<<<<<@>>>>>>>>  @>>>>>>>>  @>>>>>>>>  @<<<<<<<<<<<<<<<<<<
 625 EOF
 626
 627     # TODO: the hashes are a cheap fix.  fix these.
 628     my $full_stats  = $self->{full_stats};
 629     my $incr_stats  = $self->{incr_stats};
 630     my $total_stats = $self->{total_stats};
 631
 632     my ( $ttyp, $tt, $tapesize, $marksize );
 633     $ttyp = getconf($CNF_TAPETYPE);
 634     $tt = lookup_tapetype($ttyp) if $ttyp;
 635
 636     if ( $ttyp && $tt ) {
 637
 638         $tapesize = "".tapetype_getconf( $tt, $TAPETYPE_LENGTH );
 639         $marksize = "".tapetype_getconf( $tt, $TAPETYPE_FILEMARK );
 640     }
 641
 642     # these values should never be zero; assign defaults
 643     $tapesize = 100 * 1024 * 1024 if !$tapesize;
 644     $marksize = 1 * 1024 * 1024   if !$marksize;
 645
 646     print $fh $header;
 647
 648     print $fh swrite(
 649         $st_format,
 650         "Estimate Time (hrs:min)",
 651         hrmn( $total_stats->{planner_time} ),
 652         "", "", ""
 653     );
 654
 655     print $fh swrite(
 656         $st_format,
 657         "Run Time (hrs:min)",
 658         hrmn( $total_stats->{total_time} ),
 659         "", "", ""
 660     );
 661
 662     print $fh swrite(
 663         $st_format,
 664         "Dump Time (hrs:min)",
 665         hrmn( $total_stats->{dumper_time} ),
 666         hrmn( $full_stats->{dumper_time} ),
 667         hrmn( $incr_stats->{dumper_time} ), ""
 668     );
 669
 670     print $fh swrite(
 671         $st_format,
 672         "Output Size (meg)",
 673         sprintf( "%8.1f", $total_stats->{outsize}/1024 ),
 674         sprintf( "%8.1f", $full_stats->{outsize}/1024 ),
 675         sprintf( "%8.1f", $incr_stats->{outsize}/1024 ),
 676         "",
 677     );
 678
 679     print $fh swrite(
 680         $st_format,
 681         "Original Size (meg)",
 682         sprintf( "%8.1f", $total_stats->{origsize}/1024 ),
 683         sprintf( "%8.1f", $full_stats->{origsize}/1024 ),
 684         sprintf( "%8.1f", $incr_stats->{origsize}/1024 ),
 685         "",
 686     );
 687
 688     my $comp_size = sub {
 689         my ($stats) = @_;
 690         return divzero(100 * $stats->{outsize}, $stats->{origsize});
 691     };
 692
 693     print $fh swrite(
 694         $st_format,
 695         "Avg Compressed Size (%)",
 696         $comp_size->($total_stats),
 697         $comp_size->($full_stats),
 698         $comp_size->($incr_stats),
 699         ($self->{dumpdisks}[1] > 0 ? "(level:#disks ...)" : "")
 700     );
 701
 702     print $fh swrite(
 703         $st_format,
 704         "Filesystems Dumped",
 705         sprintf("%4d", $total_stats->{dumpdisk_count}),
 706         sprintf("%4d", $full_stats->{dumpdisk_count}),
 707         sprintf("%4d", $incr_stats->{dumpdisk_count}),
 708         ($self->{dumpdisks}[1] > 0 ? by_level_count($self->{dumpdisks}) : "")
 709     );
 710
 711     print $fh swrite(
 712         $st_format,
 713         "Avg Dump Rate (k/s)",
 714         divzero_wide( $total_stats->{outsize}, $total_stats->{dumper_time} ),
 715         divzero_wide( $full_stats->{outsize},  $full_stats->{dumper_time} ),
 716         divzero_wide( $incr_stats->{outsize},  $incr_stats->{dumper_time} ),
 717         ""
 718     );
 719     print $fh "\n";
 720
 721     print $fh swrite(
 722         $st_format,
 723         "Tape Time (hrs:min)",
 724         hrmn( $total_stats->{taper_time} ),
 725         hrmn( $full_stats->{taper_time} ),
 726         hrmn( $incr_stats->{taper_time} ), ""
 727     );
 728
 729     print $fh swrite(
 730         $st_format,
 731         "Tape Size (meg)",
 732         sprintf( "%8.1f", $total_stats->{tapesize}/1024 ),
 733         sprintf( "%8.1f", $full_stats->{tapesize}/1024 ),
 734         sprintf( "%8.1f", $incr_stats->{tapesize}/1024 ),
 735         ""
 736     );
 737
 738     my $tape_usage = sub {
 739         my ($stat_ref) = @_;
 740         return divzero(
 741             100 * (
 742                 $marksize *
 743                   ($stat_ref->{tapedisk_count} + $stat_ref->{tapepart_count}) +
 744                   $stat_ref->{tapesize}
 745             ),
 746             $tapesize
 747         );
 748     };
 749
 750     print $fh swrite(
 751         $st_format,
 752         "Tape Used (%)",
 753         $tape_usage->($total_stats),
 754         $tape_usage->($full_stats),
 755         $tape_usage->($incr_stats),
 756         ($self->{tapedisks}[1] > 0 ? "(level:#disks ...)" : "")
 757     );
 758
 759     print $fh swrite(
 760         $st_format,
 761         "Filesystems Taped",
 762         $self->{tapedisks}[0] + $self->{tapedisks}[1],
 763         $self->{tapedisks}[0],
 764         $self->{tapedisks}[1],
 765         (
 766             ($self->{tapedisks}[1] > 0)
 767             ? by_level_count($self->{tapedisks})
 768             : ""
 769         )
 770     );
 771
 772     print $fh swrite($st_format, "", "", "", "", "(level:#parts ...)")
 773       if $incr_stats->{tapepart_count} > 0;
 774
 775     # NOTE: only print out the per-level tapeparts if there are
 776     # incremental tapeparts
 777     print $fh swrite(
 778         $st_format,
 779         "Parts Taped",
 780         sprintf("%4d", $total_stats->{tapepart_count}),
 781         sprintf("%4d", $full_stats->{tapepart_count}),
 782         sprintf("%4d", $incr_stats->{tapepart_count}),
 783         (
 784             $self->{tapeparts}[1] > 0
 785             ? by_level_count($self->{tapeparts})
 786             : ""
 787         )
 788     );
 789
 790     print $fh swrite(
 791         $st_format,
 792         "Avg Tp Write Rate (k/s)",
 793         divzero_wide( $total_stats->{tapesize}, $total_stats->{taper_time} ),
 794         divzero_wide( $full_stats->{tapesize},  $full_stats->{taper_time} ),
 795         divzero_wide( $incr_stats->{tapesize},  $incr_stats->{taper_time} ),
 796         ""
 797     );
 798
 799     print $fh "\n";
 800     return;
 801 }
 802
 803 sub output_tape_stats
 804 {
 805     my ($self) = @_;
 806     my $fh     = $self->{fh};
 807     my $report = $self->{report};
 808
 809     my $taper       = $report->get_program_info("taper");
 810     my $tapes       = $taper->{tapes}       || {};
 811     my $tape_labels = $taper->{tape_labels} || [];
 812
 813     # if no tapes used, do nothing
 814     return if (!@$tape_labels);
 815
 816     my $label_length = 19;
 817     foreach my $label (@$tape_labels) {
 818         $label_length = length($label) if length($label) > $label_length;
 819     }
 820     my $ts_format = "  @"
 821       . '<' x ($label_length - 1)
 822       . "@>>>> @>>>>>>>>>>> @>>>>> @>>>> @>>>>\n";
 823
 824     print $fh "USAGE BY TAPE:\n";
 825     print $fh swrite($ts_format, "Label", "Time", "Size", "%", "Nb", "Nc");
 826
 827     my $tapetype_name = getconf($CNF_TAPETYPE);
 828     my $tapetype      = lookup_tapetype($tapetype_name);
 829     my $tapesize      = "" . tapetype_getconf($tapetype, $TAPETYPE_LENGTH);
 830     my $marksize      = "" . tapetype_getconf($tapetype, $TAPETYPE_FILEMARK);
 831
 832     foreach my $label (@$tape_labels) {
 833
 834         my $tape = $tapes->{$label};
 835
 836         my $tapeused = $tape->{'kb'};
 837         $tapeused += $marksize * (1 + $tape->{'files'});
 838
 839         print $fh swrite(
 840             $ts_format,
 841             $label,
 842             hrmn($tape->{time}),                               # time
 843             sprintf("%.0f", $self->tounits($tape->{kb})) . $self->{disp_unit},  # size
 844             divzero(100 * $tapeused, $tapesize),    # % usage
 845             int($tape->{dle}),                        # Nb of dles
 846             int($tape->{files})                       # Nb of parts
 847         );
 848     }
 849     print $fh "\n";
 850     return;
 851 }
 852
 853 sub output_details
 854 {
 855     ## takes no arguments
 856     my ($self)   = @_;
 857     my $fh       = $self->{fh};
 858     my $errors   = $self->{errors};
 859     my $notes    = $self->{notes};
 860     my $report   = $self->{report};
 861     my $stranges = $report->{stranges};
 862
 863     my $disp_unit = $self->{disp_unit};
 864
 865     my @failed_dump_details;
 866     my @strange_dump_details;
 867
 868     my @dles = $report->get_dles();
 869
 870     foreach my $dle_entry (@dles) {
 871
 872         my ($hostname, $disk) = @$dle_entry;
 873         my $dle     = $report->get_dle_info(@$dle_entry);
 874         my $tries   = $dle->{tries} || [];
 875         my $qdisk   = quote_string($disk);
 876         my $outsize = undef;
 877
 878         foreach my $try (@$tries) {
 879
 880             #
 881             # check for failed dumper details
 882             #
 883             if (defined $try->{dumper}
 884                 && $try->{dumper}->{status} eq 'fail') {
 885
 886                 push @failed_dump_details,
 887 "/-- $hostname $qdisk lev $try->{dumper}->{level} FAILED $try->{dumper}->{error}",
 888                   @{ $try->{dumper}->{errors} },
 889                   "\\--------";
 890
 891                 if ($try->{dumper}->{nb_errors} > 100) {
 892                     my $nb = $try->{dumper}->{nb_errors} - 100;
 893
 894                     push @failed_dump_details,
 895 "$nb lines follow, see the corresponding log.* file for the complete list",
 896                       "\\--------";
 897                 }
 898             }
 899
 900             #
 901             # check for strange dumper details
 902             #
 903             if (defined $try->{dumper}
 904                 && $try->{dumper}->{status} eq 'strange') {
 905
 906                 push @strange_dump_details,
 907                   "/-- $hostname $qdisk lev $try->{dumper}->{level} STRANGE",
 908                   @{ $try->{dumper}->{stranges} },
 909                   "\\--------";
 910
 911                 if ($try->{dumper}->{nb_stranges} > 100) {
 912                     my $nb = $try->{dumper}->{nb_stranges} - 100;
 913                     push @strange_dump_details,
 914 "$nb lines follow, see the corresponding log.* file for the complete list",
 915                       "\\--------";
 916                 }
 917             }
 918
 919             # note: copied & modified from calculate_stats.
 920             if (
 921                    exists $try->{dumper}
 922                 && exists $try->{taper}
 923                 && defined $try->{taper}->{kb}
 924                 && (   $try->{taper}{status} eq 'done'
 925                     || $try->{taper}{status} eq 'partial')
 926               ) {
 927                 $outsize = $try->{taper}->{kb};
 928             } elsif (
 929                 exists $try->{dumper}
 930                 && exists $try->{chunker}
 931                 && defined $try->{chunker}->{kb}
 932                 && (   $try->{chunker}{status} eq 'success'
 933                     || $try->{chunker}{status} eq 'partial')
 934               ) {
 935                 $outsize = $try->{chunker}->{kb};
 936             }
 937         }    # end try loop
 938
 939         #
 940         # check for bad estimates
 941         #
 942
 943         if (exists $dle->{estimate} && defined $outsize) {
 944             my $est = $dle->{estimate};
 945
 946             push @$notes,
 947               "big estimate: $hostname $qdisk $dle->{estimate}{level}",
 948               sprintf('                est: %.0f%s    out %.0f%s',
 949                 $est->{ckb}, $disp_unit, $outsize, $disp_unit)
 950               if ( ($est->{ckb} * .9 > $outsize)
 951                 && ($est->{ckb} - $outsize > 1.0e5));
 952         }
 953     }
 954
 955     $self->print_if_def(\@failed_dump_details,  "FAILED DUMP DETAILS:");
 956     $self->print_if_def(\@strange_dump_details, "STRANGE DUMP DETAILS:");
 957     $self->print_if_def($notes,                 "NOTES:");
 958
 959     print $fh "\n";
 960     return;
 961 }
 962
 963 sub output_summary
 964 {
 965     ## takes no arguments
 966     my ($self) = @_;
 967     my $fh     = $self->{fh};
 968     my $report = $self->{report};
 969
 970     ## get the dles
 971     my @dles =
 972       sort { ( $a->[0] cmp $b->[0] ) || ( $a->[1] cmp $b->[1] ) }
 973       $report->get_dles();
 974
 975     ## set the col_spec, which is the configuration for the summary
 976     ## output.
 977     my $col_spec = $self->set_col_spec();
 978
 979     ## collect all the output line specs (see get_summary_info)
 980     my @summary_linespecs =
 981       map { [ $self->get_summary_info($_, $report, $col_spec) ] } @dles;
 982     # shift off the first element of each tuple
 983     my @summary_linedata =
 984       map { my @x = @$_; shift @x; [ @x ] } @summary_linespecs;
 985
 986     ## get the summary format. this is based on col_spec, but may
 987     ## expand maxwidth columns if they have large fields.  Note that
 988     ## this modifies $col_spec in place.  Ordering is important: the summary
 989     ## format must be generated before the others.
 990     my $title_format = get_summary_format($col_spec, 'title', @summary_linedata);
 991     my $summary_format = get_summary_format($col_spec, 'full', @summary_linedata);
 992     my $missing_format = get_summary_format($col_spec, 'missing', @summary_linedata);
 993     my $noflush_format = get_summary_format($col_spec, 'noflush', @summary_linedata);
 994     my $nodump_PARTIAL_format = get_summary_format($col_spec, 'nodump-PARTIAL', @summary_linedata);
 995     my $nodump_FAILED_format = get_summary_format($col_spec, 'nodump-FAILED', @summary_linedata);
 996     my $nodump_FLUSH_format = get_summary_format($col_spec, 'nodump-FLUSH', @summary_linedata);
 997
 998     ## print the header names
 999     my $hdl =
1000       $col_spec->[0]->[COLSPEC_WIDTH] +
1001       $col_spec->[1]->[COLSPEC_PRE_SPACE] +
1002       $col_spec->[1]->[COLSPEC_WIDTH] +
1003       $col_spec->[2]->[COLSPEC_PRE_SPACE] +
1004       $col_spec->[2]->[COLSPEC_WIDTH];
1005     my $ds =
1006       $col_spec->[3]->[COLSPEC_WIDTH] +
1007       $col_spec->[4]->[COLSPEC_PRE_SPACE] +
1008       $col_spec->[4]->[COLSPEC_WIDTH] +
1009       $col_spec->[5]->[COLSPEC_PRE_SPACE] +
1010       $col_spec->[5]->[COLSPEC_WIDTH] +
1011       $col_spec->[6]->[COLSPEC_PRE_SPACE] +
1012       $col_spec->[6]->[COLSPEC_WIDTH] +
1013       $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1014       $col_spec->[7]->[COLSPEC_WIDTH];
1015     my $ts =
1016       $col_spec->[8]->[COLSPEC_WIDTH] +
1017       $col_spec->[9]->[COLSPEC_PRE_SPACE] +
1018       $col_spec->[9]->[COLSPEC_WIDTH];
1019
1020
1021     ## use perl's ancient formatting support for the header, since we get free string
1022     ## centering..
1023     my $summary_header_format =
1024       ' ' x ($col_spec->[0]->[COLSPEC_PRE_SPACE] +
1025           $hdl + $col_spec->[4]->[COLSPEC_PRE_SPACE])
1026       . '@' . '|' x ($ds - 1)
1027       . ' ' x $col_spec->[9]->[COLSPEC_PRE_SPACE]
1028       . '@'. '|' x ($ts - 1) . "\n";
1029     my $summary_header = swrite($summary_header_format, "DUMPER STATS", "TAPER STATS");
1030
1031     my $summary_dashes =
1032         ' ' x $col_spec->[0]->[COLSPEC_PRE_SPACE]
1033       . '-' x $hdl
1034       . ' ' x $col_spec->[4]->[COLSPEC_PRE_SPACE]
1035       . '-' x $ds
1036       . ' ' x $col_spec->[9]->[COLSPEC_PRE_SPACE]
1037       . '-' x $ts . "\n";
1038
1039     print $fh "DUMP SUMMARY:\n";
1040     print $fh $summary_header;
1041     print $fh sprintf($title_format, map { $_->[COLSPEC_TITLE] } @$col_spec);
1042     print $fh $summary_dashes;
1043
1044     ## write out each output line
1045     for (@summary_linespecs) {
1046         my ($type, @data) = @$_;
1047         if ($type eq 'full') {
1048             print $fh sprintf($summary_format, @data);
1049         } elsif ($type eq 'nodump-PARTIAL') {
1050             print $fh sprintf($nodump_PARTIAL_format, @data);
1051         } elsif ($type eq 'nodump-FAILED') {
1052             print $fh sprintf($nodump_FAILED_format, @data);
1053         } elsif ($type eq 'nodump-FLUSH') {
1054             print $fh sprintf($nodump_FLUSH_format, @data);
1055         } elsif ($type eq 'missing') {
1056             print $fh sprintf($missing_format, @data[0..2]);
1057         } elsif ($type eq 'noflush') {
1058             print $fh sprintf($noflush_format, @data[0..2]);
1059         }
1060     }
1061
1062     print $fh "\n";
1063     return;
1064 }
1065
1066 ## output_summary helper functions.  mostly for formatting, but some
1067 ## for data collection.  Returns an 12-tuple matching one of
1068 ##
1069 ##  ('full', host, disk, level, orig, out, comp%, dumptime, dumprate,
1070 ##    tapetime, taperate, taperpartial)
1071 ##  ('missing', host, disk, '' ..) # MISSING -----
1072 ##  ('noflush', host, disk, '' ..) # NO FILE TO FLUSH ------
1073 ##  ('nodump-$msg', host, disk, level, '', out, '--', '',
1074 ##          '', tapetime, taperate, taperpartial)  # ... {FLUSH|FAILED|PARTIAL} ...
1075 ##
1076 ## the taperpartial column is not covered by the columnspec, and "hangs off"
1077 ## the right side.  It's usually empty, but set to " PARTIAL" when the taper
1078 ## write was partial
1079
1080 sub get_summary_info
1081 {
1082     my $self = shift;
1083     my ( $dle, $report, $col_spec ) = @_;
1084     my ( $hostname, $disk ) = @$dle;
1085
1086     my $dle_info = $report->get_dle_info(@$dle);
1087
1088     my $tail_quote_trunc = sub {
1089         my ($str, $len) = @_;
1090
1091         my $q_str = quote_string($str);
1092         my $qt_str;
1093
1094         if (length($q_str) > $len) {
1095
1096             $qt_str = substr($q_str, length($q_str) - $len, $len);
1097             if ($q_str eq $str) {
1098                 $qt_str =~ s{^.}{-}
1099             } else {
1100                 $qt_str =~ s{^..}{"-};
1101             }
1102         } else {
1103             $qt_str = $q_str;
1104         }
1105
1106         return $qt_str;
1107     };
1108
1109     my $disk_out =
1110       ($col_spec->[1]->[COLSPEC_MAXWIDTH])
1111       ? quote_string($disk)
1112       : $tail_quote_trunc->($disk, $col_spec->[1]->[COLSPEC_WIDTH]);
1113
1114     my $last_try = $dle_info->{tries}->[-1];
1115     my $level =
1116         exists $last_try->{taper}   ? $last_try->{taper}{level}
1117       : exists $last_try->{chunker} ? $last_try->{chunker}{level}
1118       :                               $last_try->{dumper}{level};
1119
1120     my $orig_size = undef;
1121
1122     # find the try with the successful dumper entry
1123     my $dumper = undef;
1124     foreach my $try ( @{ $dle_info->{tries} } ) {
1125         if ( exists $try->{dumper}
1126             && exists $try->{dumper}{status}
1127             && (   $try->{dumper}{status} eq "success"
1128                 || $try->{dumper}{status} eq "strange")) {
1129             $dumper = $try->{dumper};
1130             last;
1131         }
1132     }
1133     $orig_size = $dumper->{orig_kb}
1134         if defined $dumper;
1135
1136     my ( $out_size, $dump_time, $dump_rate, $tape_time, $tape_rate ) = (0) x 5;
1137     my ($dumper_status) = "";
1138     my $saw_dumper = 0; # no dumper will mean this was a flush
1139     my $taper_partial = 0; # was the last taper run partial?
1140
1141     ## Use this loop to set values
1142     foreach my $try ( @{ $dle_info->{tries} } ) {
1143
1144         ## find the outsize for the output summary
1145
1146         if (
1147             exists $try->{taper}
1148             && (   $try->{taper}{status} eq "done"
1149                 || $try->{taper}{status} eq "part+partial" )
1150           ) {
1151             $taper_partial = 0;
1152             $orig_size = $try->{taper}{orig_kb} if !defined($orig_size);
1153             $out_size  = $try->{taper}{kb};
1154             $tape_time = $try->{taper}{sec};
1155             $tape_rate = $try->{taper}{kps};
1156         } elsif ( exists $try->{taper}
1157             && ( $try->{taper}{status} eq "partial" ) ) {
1158
1159             $taper_partial = 1;
1160             $orig_size = $try->{taper}{orig_kb} if !defined($orig_size);
1161             $out_size  = $try->{taper}{kb};
1162             $tape_time = $try->{taper}{sec} if !$tape_time;
1163             $tape_rate = $try->{taper}{kps} if !$tape_rate;
1164         } elsif (exists $try->{taper} && ( $try->{taper}{status} eq "fail")) {
1165             if ($try->{taper}{error} =~ /CONFIG:/) {
1166                 $tape_time = 0;
1167                 $tape_rate = 0;
1168             } else {
1169                 $tape_time = undef;
1170                 $tape_rate = undef;
1171             }
1172         }
1173
1174         if (!$out_size &&
1175             exists $try->{chunker}
1176             && (   $try->{chunker}{status} eq "success"
1177                 || $try->{chunker}{status} eq "partial" )
1178           ) {
1179             $out_size = $try->{chunker}{kb};
1180         }
1181
1182         if (!$out_size &&
1183             exists $try->{dumper}) {
1184             $out_size = $try->{dumper}{kb};
1185         }
1186
1187         if ( exists $try->{dumper}) {
1188             $saw_dumper = 1;
1189             $dumper_status = $try->{dumper}{status};
1190         }
1191
1192         ## find the dump time
1193         if ( exists $try->{dumper}
1194             && exists $try->{dumper}{status}
1195             && (   $try->{dumper}{status} eq "success"
1196                 || $try->{dumper}{status} eq "strange")) {
1197
1198             $dump_time = $try->{dumper}{sec};
1199             $dump_rate = $try->{dumper}{kps};
1200         }
1201     }
1202
1203     my $compression;
1204     if (!defined $orig_size) {
1205         $compression = 100;
1206     } else {
1207         $compression =
1208           divzero_col((100 * $out_size), $orig_size, $col_spec->[5]);
1209     }
1210
1211     ## simple formatting macros
1212
1213     my $fmt_col_field = sub {
1214         my ( $column, $data ) = @_;
1215
1216         return sprintf(
1217             $col_spec->[$column]->[COLSPEC_FORMAT],
1218             $col_spec->[$column]->[COLSPEC_WIDTH],
1219             $col_spec->[$column]->[COLSPEC_PREC], $data
1220         );
1221     };
1222
1223     my $format_space = sub {
1224         my ( $column, $data ) = @_;
1225
1226         return sprintf("%*s",$col_spec->[$column]->[COLSPEC_WIDTH], $data);
1227     };
1228
1229     my @rv;
1230
1231     if ( !$orig_size && !$out_size && (!defined($tape_time) || !$tape_time)) {
1232         push @rv, $report->get_flag("amflush_run")? 'noflush' : 'missing';
1233         push @rv, $hostname;
1234         push @rv, $disk_out;
1235         push @rv, ("",) x 8;
1236         return @rv;
1237     }
1238
1239     if ($saw_dumper and ($dumper_status eq 'success' or $dumper_status eq 'strange')) {
1240         push @rv, "full";
1241         push @rv, $hostname;
1242         push @rv, $disk_out;
1243         push @rv, $fmt_col_field->(2, $level);
1244         push @rv, $orig_size ? $fmt_col_field->(3, $self->tounits($orig_size)) : '';
1245         push @rv, $out_size ? $fmt_col_field->(4, $self->tounits($out_size)) : '';
1246         push @rv, ($compression == 100) ? '-- ' : $fmt_col_field->(5, $compression);
1247         push @rv, $dump_time ? $fmt_col_field->(6, mnsc($dump_time)) : "PARTIAL";
1248         push @rv, $dump_rate ? $fmt_col_field->(7, $dump_rate) : "";
1249         push @rv, $fmt_col_field->(8,
1250                 (defined $tape_time) ?
1251                         $tape_time ? mnsc($tape_time) : ""
1252                       : "FAILED");
1253         push @rv, (defined $tape_rate) ?
1254             $tape_rate ?
1255                 $fmt_col_field->(9, $tape_rate)
1256               : $format_space->(9, "")
1257           : $format_space->(9, "FAILED");
1258         push @rv, $taper_partial? " PARTIAL" : ""; # column 10
1259     } else {
1260         my $message = $saw_dumper?
1261                         ($dumper_status eq 'failed') ? 'FAILED' : 'PARTIAL'
1262                       : 'FLUSH';
1263         push @rv, "nodump-$message";
1264         push @rv, $hostname;
1265         push @rv, $disk_out;
1266         push @rv, $fmt_col_field->(2, $level);
1267         push @rv, $orig_size ? $fmt_col_field->(4, $self->tounits($orig_size)) :'';
1268         push @rv, $out_size ? $fmt_col_field->(4, $self->tounits($out_size)) : '';
1269         push @rv, ($compression == 100) ? '-- ' : $fmt_col_field->(5, $compression);
1270         push @rv, '';
1271         push @rv, '';
1272         push @rv, $fmt_col_field->(8,
1273                 (defined $tape_time) ?
1274                         $tape_time ? mnsc($tape_time) : ""
1275                       : "FAILED");
1276         push @rv, (defined $tape_rate) ?
1277             $tape_rate ?
1278                 $fmt_col_field->(9, $tape_rate)
1279               : $format_space->(9, "")
1280           : $format_space->(9, "FAILED");
1281         push @rv, $taper_partial? " PARTIAL" : "";
1282     }
1283     return @rv;
1284 }
1285
1286 sub get_summary_format
1287 {
1288     my ($col_spec, $type, @summary_lines) = @_;
1289     my @col_format = ();
1290
1291     if ($type eq 'full' || $type eq 'title') {
1292         foreach my $i ( 0 .. ( @$col_spec - 1 ) ) {
1293             push @col_format,
1294               get_summary_col_format( $i, $col_spec->[$i],
1295                 map { $_->[$i] } @summary_lines );
1296         }
1297     } else {
1298         # first two columns are the same
1299         foreach my $i ( 0 .. 1 ) {
1300             push @col_format,
1301               get_summary_col_format( $i, $col_spec->[$i],
1302                 map { $_->[$i] } @summary_lines );
1303         }
1304
1305         # some of these have a lovely text rule, just to be difficult
1306         my $rulewidth =
1307             $col_spec->[3]->[COLSPEC_WIDTH] +
1308             $col_spec->[4]->[COLSPEC_PRE_SPACE] +
1309             $col_spec->[4]->[COLSPEC_WIDTH] +
1310             $col_spec->[5]->[COLSPEC_PRE_SPACE] +
1311             $col_spec->[5]->[COLSPEC_WIDTH] +
1312             $col_spec->[6]->[COLSPEC_PRE_SPACE] +
1313             $col_spec->[6]->[COLSPEC_WIDTH] +
1314             $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1315             $col_spec->[7]->[COLSPEC_WIDTH] +
1316             $col_spec->[8]->[COLSPEC_PRE_SPACE] +
1317             $col_spec->[8]->[COLSPEC_WIDTH] +
1318             $col_spec->[9]->[COLSPEC_PRE_SPACE] +
1319             $col_spec->[9]->[COLSPEC_WIDTH];
1320
1321         if ($type eq 'missing') {
1322             # add a blank level column and the space for the origkb column
1323             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1324             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1325             push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1326             my $str = "MISSING ";
1327             $str .= '-' x ($rulewidth - length($str));
1328             push @col_format, $str;
1329         } elsif ($type eq 'noflush') {
1330             # add a blank level column and the space for the origkb column
1331             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1332             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1333             push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1334
1335             my $str = "NO FILE TO FLUSH ";
1336             $str .= '-' x ($rulewidth - length($str));
1337             push @col_format, $str;
1338         } elsif ($type =~ /^nodump-(.*)$/) {
1339             my $msg = $1;
1340
1341             # nodump has level, origkb, outkb, and comp% although origkb is usually blank and
1342             # comp% is "--".
1343             foreach my $i ( 2 .. 5 ) {
1344                 push @col_format,
1345                   get_summary_col_format( $i, $col_spec->[$i],
1346                     map { $_->[$i] } @summary_lines );
1347             }
1348
1349             # and then the message is centered across columns 6 and 7, which are both blank
1350             push @col_format, ' ' x $col_spec->[6]->[COLSPEC_PRE_SPACE];
1351             my $width =
1352                 $col_spec->[6]->[COLSPEC_WIDTH] +
1353                 $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1354                 $col_spec->[7]->[COLSPEC_WIDTH];
1355
1356             my $str = ' ' x (($width - length($msg))/2);
1357             $str .= $msg;
1358             $str .= ' ' x ($width - length($str));
1359             push @col_format, $str;
1360             push @col_format, "%s%s"; # consume empty columns 6 and 7
1361
1362             # and finally columns 8 and 9 as usual
1363             foreach my $i ( 8 .. 9 ) {
1364                 push @col_format,
1365                   get_summary_col_format( $i, $col_spec->[$i],
1366                     map { $_->[$i] } @summary_lines );
1367             }
1368         }
1369     }
1370
1371     # and format the hidden 10th column.  This is not part of the columnspec,
1372     # so its width is not counted in any of the calculations here.
1373     push @col_format, "%s" if $type ne 'title';
1374
1375     return join( "", @col_format ) . "\n";
1376 }
1377
1378 sub get_summary_col_format
1379 {
1380     my ( $i, $col, @entries ) = @_;
1381
1382     my $col_width = $col->[COLSPEC_WIDTH];
1383     my $left_align = ($i == 0 || $i == 1); # first 2 cols left-aligned
1384     my $limit_width = ($i == 0 || $i == 1); # and not allowed to overflow
1385
1386     ## if necessary, resize COLSPEC_WIDTH to the maximum widht
1387     ## of any row
1388     if ($col->[COLSPEC_MAXWIDTH]) {
1389
1390         push @entries, $col->[COLSPEC_TITLE];
1391         my $strmax = max( map { length $_ } @entries );
1392         $col_width = max($strmax, $col_width);
1393         # modify the spec in place, so the headers and
1394         # whatnot all add up .. yuck!
1395         $col->[COLSPEC_WIDTH] = $col_width;
1396     }
1397
1398     # put together a "%s" format for this column
1399     my $rv = ' ' x $col->[COLSPEC_PRE_SPACE]; # space on left
1400     $rv .= '%';
1401     $rv .= '-' if $left_align;
1402     $rv .= $col_width;
1403     $rv .= ".$col_width" if $limit_width;
1404     $rv .= "s";
1405 }
1406
1407 ## col_spec functions.  I want to deprecate this stuff so bad it hurts.
1408
1409 sub set_col_spec
1410 {
1411     my ($self) = @_;
1412     my $report = $self->{report};
1413     my $disp_unit = $self->{disp_unit};
1414
1415     $self->{col_spec} = [
1416         [ "HostName", 0, 12, 12, 0, "%-*.*s", "HOSTNAME" ],
1417         [ "Disk",     1, 11, 11, 0, "%-*.*s", "DISK" ],
1418         [ "Level",    1, 1,  1,  0, "%*.*d",  "L" ],
1419         [ "OrigKB",   1, 7,  0,  1, "%*.*f",  "ORIG-" . $disp_unit . "B" ],
1420         [ "OutKB",    1, 7,  0,  1, "%*.*f",  "OUT-" . $disp_unit . "B" ],
1421         [ "Compress", 1, 6,  1,  1, "%*.*f",  "COMP%" ],
1422         [ "DumpTime", 1, 7,  7,  1, "%*.*s",  "MMM:SS" ],
1423         [ "DumpRate", 1, 6,  1,  1, "%*.*f",  "KB/s" ],
1424         [ "TapeTime", 1, 6,  6,  1, "%*.*s",  "MMM:SS" ],
1425         [ "TapeRate", 1, 6,  1,  1, "%*.*f",  "KB/s" ]
1426     ];
1427
1428     $self->apply_col_spec_override();
1429     return $self->{col_spec};
1430 }
1431
1432 sub apply_col_spec_override
1433 {
1434     my ($self) = @_;
1435     my $col_spec = $self->{col_spec};
1436
1437     my %col_spec_override = read_col_spec_override();
1438
1439     foreach my $col (@$col_spec) {
1440         if ( my $col_override = $col_spec_override{ $col->[COLSPEC_NAME] } ) {
1441
1442             my $override_col_val_if_def = sub {
1443                 my ( $field, $or_num ) = @_;
1444                 if ( defined $col_override->[$or_num]
1445                     && !( $col_override->[$or_num] eq "" ) ) {
1446                     $col->[$field] = $col_override->[$or_num];
1447                 }
1448             };
1449
1450             $override_col_val_if_def->( COLSPEC_PRE_SPACE, 0 );
1451             $override_col_val_if_def->( COLSPEC_WIDTH,     1 );
1452             $override_col_val_if_def->( COLSPEC_PREC,      2 );
1453             $override_col_val_if_def->( COLSPEC_MAXWIDTH,  3 );
1454         }
1455     }
1456 }
1457
1458 sub read_col_spec_override
1459 {
1460     ## takes no arguments
1461     my $col_spec_str = getconf($CNF_COLUMNSPEC) || return;
1462     my %col_spec_override = ();
1463
1464     foreach (split(",", $col_spec_str)) {
1465
1466         $_ =~ m/^(\w+)           # field name
1467                 =([-:\d]+)       # field values
1468                 $/x
1469           or die "error: malformed columnspec string:$col_spec_str";
1470
1471         my $field = $1;
1472         my @field_values = split ':', $2;
1473
1474         # too many values
1475         die "error: malformed columnspec string:$col_spec_str"
1476           if (@field_values > 3);
1477
1478         # all values *should* be in the right place.  If not enough
1479         # were given, pad the array.
1480         push @field_values, "" while (@field_values < 4);
1481
1482         # if the second value is negative, that means MAXWIDTH=1, so
1483         # sort that out now.  Yes, this is pretty ugly.  Imagine this in C!
1484         if ($field_values[1] ne '') {
1485             if ($field_values[1] =~ /^-/) {
1486                 $field_values[1] =~ s/^-//;
1487                 $field_values[3] = 1;
1488             } else {
1489                 $field_values[3] = 0;
1490             }
1491         }
1492
1493         $col_spec_override{$field} = \@field_values;
1494     }
1495
1496     return %col_spec_override;
1497 }
1498
1499 sub print_if_def
1500 {
1501     my ($self, $msgs, $header) = @_;
1502     my $fh = $self->{fh};
1503
1504     @$msgs or return;    # do not print section if no messages
1505
1506     print $fh "$header\n";
1507     foreach my $msg (@$msgs) {
1508         print $fh "  $msg\n";
1509     }
1510     print $fh "\n";
1511 }
1512
1513 1;