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

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