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