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

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