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->{planner}) {
 541             push @missing_failures, "$hostname $qdisk RESULTS MISSING";
 542         }
 543
 544         if (   exists $dle->{driver}
 545             && exists $dle->{driver}->{error}) {
 546             push @driver_failures, "$hostname $qdisk lev $dle->{driver}->{level}  FAILED $dle->{driver}->{error}";
 547         }
 548
 549         if (   exists $dle->{planner}
 550             && exists $dle->{planner}->{error}) {
 551             push @planner_failures, "$hostname $qdisk lev $dle->{planner}->{level}  FAILED $dle->{planner}->{error}";
 552         }
 553
 554         while( my ($timestamp, $tries) = each %$alldumps ) {
 555             my $failed = 0;
 556             foreach my $try (@$tries) {
 557                 if (exists $try->{dumper} &&
 558                     $try->{dumper}->{status} &&
 559                     $try->{dumper}->{status} eq 'fail') {
 560                     push @dump_failures, "$hostname $qdisk lev $try->{dumper}->{level}  FAILED $try->{dumper}->{error}";
 561                     $failed = 1;
 562                 }
 563                 if (exists $try->{chunker} &&
 564                     $try->{chunker}->{status} eq 'fail') {
 565                     push @dump_failures, "$hostname $qdisk lev $try->{chunker}->{level}  FAILED $try->{chunker}->{error}";
 566                     $failed = 1;
 567                 }
 568                 if (   exists $try->{taper}
 569                     && (   $try->{taper}->{status} eq 'fail'
 570                         || (   $try->{taper}->{status} eq 'partial'))) {
 571                     my $flush = "FLUSH";
 572                     $flush = "FAILED" if exists $try->{dumper} && !exists $try->{chunker};
 573                     if ($flush ne "FLUSH" or !defined $try->{taper}->{failure_from}
 574                                           or $try->{taper}->{failure_from} ne 'config') {
 575                         if ($try->{taper}->{status} eq 'partial') {
 576                             # if the error message is omitted, then the taper only got a partial
 577                             # dump from the dumper/chunker, rather than failing with a taper error
 578                             my $errmsg = $try->{taper}{error} || "successfully taped a partial dump";
 579                             $flush = "partial taper: $errmsg";
 580                         } else {
 581                             $flush .= " " . $try->{taper}{error};
 582                         }
 583
 584                         push @dump_failures, "$hostname $qdisk lev $try->{taper}->{level}  $flush";
 585                         $failed = 1;
 586                     }
 587                 }
 588
 589                 # detect retried dumps
 590                 if (   $failed
 591                     && exists $try->{dumper}
 592                     && (   $try->{dumper}->{status} eq "success"
 593                         || $try->{dumper}->{status} eq "strange")
 594                     && (   !exists $try->{chunker}
 595                         || $try->{chunker}->{status} eq "success")
 596                     && (   !exists $try->{taper}
 597                         || $try->{taper}->{status} eq "done")) {
 598                     push @dump_failures, "$hostname $qdisk lev $try->{dumper}->{level}  was successfully retried";
 599                     $failed = 0;
 600                 }
 601
 602                 # detect dumps re-flushed from holding
 603                 if (   $failed
 604                     && !exists $try->{dumper}
 605                     && !exists $try->{chunker}
 606                     && exists $try->{taper}
 607                     && $try->{taper}->{status} eq "done") {
 608                     push @dump_failures, "$hostname $qdisk lev $try->{taper}->{level}  was successfully re-flushed";
 609                     $failed = 0;
 610                 }
 611
 612                 push @stranges,
 613     "$hostname $qdisk lev $try->{dumper}->{level}  STRANGE (see below)"
 614                   if (defined $try->{dumper}
 615                     && $try->{dumper}->{status} eq 'strange');
 616             }
 617         }
 618     }
 619     push @failures, @fatal_failures, @error_failures, @missing_failures,
 620                     @driver_failures, @planner_failures, @dump_failures;
 621
 622     $self->print_if_def(\@failures, "FAILURE DUMP SUMMARY:");
 623     $self->print_if_def(\@stranges, "STRANGE DUMP SUMMARY:");
 624
 625     return;
 626 }
 627
 628 sub by_level_count
 629 {
 630     my ($count) = @_;
 631     my @lc;
 632
 633     # start at level 1 - don't include fulls
 634     foreach my $i (1 .. (@$count - 1)) {
 635         push @lc, "$i:$count->[$i]" if defined $count->[$i] and $count->[$i] > 0;
 636     }
 637     return join(' ', @lc);
 638 }
 639
 640 sub output_stats
 641 {
 642     my ($self) = @_;
 643     my $fh     = $self->{fh};
 644     my $report = $self->{report};
 645
 646     my $header = <<EOF;
 647
 648
 649 STATISTICS:
 650                           Total       Full      Incr.   Level:#
 651                         --------   --------   --------  --------
 652 EOF
 653
 654     my $st_format = <<EOF;
 655 @<<<<<<<<<<<<<<<<<<<<<<@>>>>>>>>  @>>>>>>>>  @>>>>>>>>  @<<<<<<<<<<<<<<<<<<
 656 EOF
 657
 658     # TODO: the hashes are a cheap fix.  fix these.
 659     my $full_stats  = $self->{full_stats};
 660     my $incr_stats  = $self->{incr_stats};
 661     my $total_stats = $self->{total_stats};
 662
 663     my ( $ttyp, $tt, $tapesize, $marksize );
 664     $ttyp = getconf($CNF_TAPETYPE);
 665     $tt = lookup_tapetype($ttyp) if $ttyp;
 666
 667     if ( $ttyp && $tt ) {
 668
 669         $tapesize = "".tapetype_getconf( $tt, $TAPETYPE_LENGTH );
 670         $marksize = "".tapetype_getconf( $tt, $TAPETYPE_FILEMARK );
 671     }
 672
 673     # these values should never be zero; assign defaults
 674     $tapesize = 100 * 1024 * 1024 if !$tapesize;
 675     $marksize = 1 * 1024 * 1024   if !$marksize;
 676
 677     print $fh $header;
 678
 679     print $fh swrite(
 680         $st_format,
 681         "Estimate Time (hrs:min)",
 682         hrmn( $total_stats->{planner_time} ),
 683         "", "", ""
 684     );
 685
 686     print $fh swrite(
 687         $st_format,
 688         "Run Time (hrs:min)",
 689         hrmn( $total_stats->{total_time} ),
 690         "", "", ""
 691     );
 692
 693     print $fh swrite(
 694         $st_format,
 695         "Dump Time (hrs:min)",
 696         hrmn( $total_stats->{dumper_time} ),
 697         hrmn( $full_stats->{dumper_time} ),
 698         hrmn( $incr_stats->{dumper_time} ),
 699         ""
 700     );
 701
 702     print $fh swrite(
 703         $st_format,
 704         "Output Size (meg)",
 705         sprintf( "%8.1f", $total_stats->{outsize}/1024 ),
 706         sprintf( "%8.1f", $full_stats->{outsize}/1024 ),
 707         sprintf( "%8.1f", $incr_stats->{outsize}/1024 ),
 708         "",
 709     );
 710
 711     print $fh swrite(
 712         $st_format,
 713         "Original Size (meg)",
 714         sprintf( "%8.1f", $total_stats->{origsize}/1024 ),
 715         sprintf( "%8.1f", $full_stats->{origsize}/1024 ),
 716         sprintf( "%8.1f", $incr_stats->{origsize}/1024 ),
 717         "",
 718     );
 719
 720     my $comp_size = sub {
 721         my ($stats) = @_;
 722         return divzero(100 * $stats->{outsize}, $stats->{origsize});
 723     };
 724
 725     print $fh swrite(
 726         $st_format,
 727         "Avg Compressed Size (%)",
 728         $comp_size->($total_stats),
 729         $comp_size->($full_stats),
 730         $comp_size->($incr_stats),
 731         "",
 732     );
 733
 734     print $fh swrite(
 735         $st_format,
 736         "DLEs Dumped",
 737         sprintf("%4d", $total_stats->{dumpdisk_count}),
 738         sprintf("%4d", $full_stats->{dumpdisk_count}),
 739         sprintf("%4d", $incr_stats->{dumpdisk_count}),
 740         (has_incrementals($self->{dumpdisks}) ? by_level_count($self->{dumpdisks}) : "")
 741     );
 742
 743     print $fh swrite(
 744         $st_format,
 745         "Avg Dump Rate (k/s)",
 746         divzero_wide( $total_stats->{outsize}, $total_stats->{dumper_time} ),
 747         divzero_wide( $full_stats->{outsize},  $full_stats->{dumper_time} ),
 748         divzero_wide( $incr_stats->{outsize},  $incr_stats->{dumper_time} ),
 749         ""
 750     );
 751     print $fh "\n";
 752
 753     print $fh swrite(
 754         $st_format,
 755         "Tape Time (hrs:min)",
 756         hrmn( $total_stats->{taper_time} ),
 757         hrmn( $full_stats->{taper_time} ),
 758         hrmn( $incr_stats->{taper_time} ),
 759         ""
 760     );
 761
 762     print $fh swrite(
 763         $st_format,
 764         "Tape Size (meg)",
 765         sprintf( "%8.1f", $total_stats->{tapesize}/1024 ),
 766         sprintf( "%8.1f", $full_stats->{tapesize}/1024 ),
 767         sprintf( "%8.1f", $incr_stats->{tapesize}/1024 ),
 768         ""
 769     );
 770
 771     my $tape_usage = sub {
 772         my ($stat_ref) = @_;
 773         return divzero(
 774             100 * (
 775                 $marksize *
 776                   ($stat_ref->{tapedisk_count} + $stat_ref->{tapepart_count}) +
 777                   $stat_ref->{tapesize}
 778             ),
 779             $tapesize
 780         );
 781     };
 782
 783     print $fh swrite(
 784         $st_format,
 785         "Tape Used (%)",
 786         $tape_usage->($total_stats),
 787         $tape_usage->($full_stats),
 788         $tape_usage->($incr_stats),
 789         ""
 790     );
 791
 792     my $nb_incr_dle = 0;
 793     my @incr_dle = @{$self->{tapedisks}};
 794     foreach my $level (1 .. $#incr_dle) {
 795         $nb_incr_dle += $incr_dle[$level];
 796     }
 797     print $fh swrite(
 798         $st_format,
 799         "DLEs Taped",
 800         $self->{tapedisks}[0] + $nb_incr_dle,
 801         $self->{tapedisks}[0],
 802         $nb_incr_dle,
 803         (
 804             (has_incrementals($self->{tapedisks}))
 805             ? by_level_count($self->{tapedisks})
 806             : ""
 807         )
 808     );
 809
 810     # NOTE: only print out the per-level tapeparts if there are
 811     # incremental tapeparts
 812     print $fh swrite(
 813         $st_format,
 814         "Parts Taped",
 815         sprintf("%4d", $total_stats->{tapepart_count}),
 816         sprintf("%4d", $full_stats->{tapepart_count}),
 817         sprintf("%4d", $incr_stats->{tapepart_count}),
 818         (
 819             $self->{tapeparts}[1] > 0
 820             ? by_level_count($self->{tapeparts})
 821             : ""
 822         )
 823     );
 824
 825     print $fh swrite(
 826         $st_format,
 827         "Avg Tp Write Rate (k/s)",
 828         divzero_wide( $total_stats->{tapesize}, $total_stats->{taper_time} ),
 829         divzero_wide( $full_stats->{tapesize},  $full_stats->{taper_time} ),
 830         divzero_wide( $incr_stats->{tapesize},  $incr_stats->{taper_time} ),
 831         ""
 832     );
 833
 834     print $fh "\n";
 835     return;
 836 }
 837
 838 sub has_incrementals
 839 {
 840     my $array = shift;
 841
 842     for ($a = 1; $a < @$array; $a+=1) {
 843         return 1 if $array->[$a] > 0;
 844     }
 845     return 0;
 846 }
 847
 848 sub output_tape_stats
 849 {
 850     my ($self) = @_;
 851     my $fh     = $self->{fh};
 852     my $report = $self->{report};
 853
 854     my $taper       = $report->get_program_info("taper");
 855     my $tapes       = $taper->{tapes}       || {};
 856     my $tape_labels = $taper->{tape_labels} || [];
 857
 858     # if no tapes used, do nothing
 859     return if (!@$tape_labels);
 860
 861     my $label_length = 19;
 862     foreach my $label (@$tape_labels) {
 863         $label_length = length($label) if length($label) > $label_length;
 864     }
 865     my $ts_format = "  @"
 866       . '<' x ($label_length - 1)
 867       . "@>>>> @>>>>>>>>>>> @>>>>> @>>>> @>>>>\n";
 868
 869     print $fh "USAGE BY TAPE:\n";
 870     print $fh swrite($ts_format, "Label", "Time", "Size", "%", "DLEs", "Parts");
 871
 872     my $tapetype_name = getconf($CNF_TAPETYPE);
 873     my $tapetype      = lookup_tapetype($tapetype_name);
 874     my $tapesize      = "" . tapetype_getconf($tapetype, $TAPETYPE_LENGTH);
 875     my $marksize      = "" . tapetype_getconf($tapetype, $TAPETYPE_FILEMARK);
 876
 877     foreach my $label (@$tape_labels) {
 878
 879         my $tape = $tapes->{$label};
 880
 881         my $tapeused = $tape->{'kb'};
 882         $tapeused += $marksize * (1 + $tape->{'files'});
 883
 884         print $fh swrite(
 885             $ts_format,
 886             $label,
 887             hrmn($tape->{time}),                               # time
 888             sprintf("%.0f", $self->tounits($tape->{kb})) . $self->{disp_unit},  # size
 889             divzero(100 * $tapeused, $tapesize),    # % usage
 890             int($tape->{dle}),                        # # of dles
 891             int($tape->{files})                       # # of parts
 892         );
 893     }
 894     print $fh "\n";
 895     return;
 896 }
 897
 898 sub output_details
 899 {
 900     ## takes no arguments
 901     my ($self)   = @_;
 902     my $fh       = $self->{fh};
 903     my $errors   = $self->{errors};
 904     my $notes    = $self->{notes};
 905     my $report   = $self->{report};
 906     my $stranges = $report->{stranges};
 907
 908     my $disp_unit = $self->{disp_unit};
 909
 910     my @failed_dump_details;
 911     my @strange_dump_details;
 912
 913     my @dles = $report->get_dles();
 914
 915     foreach my $dle_entry (@dles) {
 916
 917         my ($hostname, $disk) = @$dle_entry;
 918         my $dle      = $report->get_dle_info(@$dle_entry);
 919         my $alldumps = $dle->{'dumps'} || {};
 920         my $qdisk    = quote_string($disk);
 921         my $outsize  = undef;
 922
 923         while( my ($timestamp, $tries) = each %$alldumps ) {
 924             foreach my $try (@$tries) {
 925
 926                 #
 927                 # check for failed dumper details
 928                 #
 929                 if (defined $try->{dumper}
 930                     && $try->{dumper}->{status} eq 'fail') {
 931
 932                     push @failed_dump_details,
 933     "/-- $hostname $qdisk lev $try->{dumper}->{level} FAILED $try->{dumper}->{error}",
 934                       @{ $try->{dumper}->{errors} },
 935                       "\\--------";
 936
 937                     if ($try->{dumper}->{nb_errors} > 100) {
 938                         my $nb = $try->{dumper}->{nb_errors} - 100;
 939
 940                         push @failed_dump_details,
 941     "$nb lines follow, see the corresponding log.* file for the complete list",
 942                           "\\--------";
 943                     }
 944                 }
 945
 946                 #
 947                 # check for strange dumper details
 948                 #
 949                 if (defined $try->{dumper}
 950                     && $try->{dumper}->{status} eq 'strange') {
 951
 952                     push @strange_dump_details,
 953                       "/-- $hostname $qdisk lev $try->{dumper}->{level} STRANGE",
 954                       @{ $try->{dumper}->{stranges} },
 955                       "\\--------";
 956
 957                     if ($try->{dumper}->{nb_stranges} > 100) {
 958                         my $nb = $try->{dumper}->{nb_stranges} - 100;
 959                         push @strange_dump_details,
 960     "$nb lines follow, see the corresponding log.* file for the complete list",
 961                           "\\--------";
 962                     }
 963                 }
 964
 965                 # note: copied & modified from calculate_stats.
 966                 if (
 967                        exists $try->{dumper}
 968                     && exists $try->{taper}
 969                     && defined $try->{taper}->{kb}
 970                     && (   $try->{taper}{status} eq 'done'
 971                         || $try->{taper}{status} eq 'partial')
 972                   ) {
 973                     $outsize = $try->{taper}->{kb};
 974                 } elsif (
 975                     exists $try->{dumper}
 976                     && exists $try->{chunker}
 977                     && defined $try->{chunker}->{kb}
 978                     && (   $try->{chunker}{status} eq 'success'
 979                         || $try->{chunker}{status} eq 'partial')
 980                   ) {
 981                     $outsize = $try->{chunker}->{kb};
 982                 }
 983             }
 984         }
 985
 986         #
 987         # check for bad estimates
 988         #
 989
 990         if (exists $dle->{estimate} && defined $outsize) {
 991             my $est = $dle->{estimate};
 992
 993             push @$notes,
 994               "big estimate: $hostname $qdisk $dle->{estimate}{level}",
 995               sprintf('                est: %.0f%s    out %.0f%s',
 996                 $est->{ckb}, $disp_unit, $outsize, $disp_unit)
 997               if (defined $est->{'ckb'} && ($est->{ckb} * .9 > $outsize)
 998                 && ($est->{ckb} - $outsize > 1.0e5));
 999         }
1000     }
1001
1002     $self->print_if_def(\@failed_dump_details,  "FAILED DUMP DETAILS:");
1003     $self->print_if_def(\@strange_dump_details, "STRANGE DUMP DETAILS:");
1004     $self->print_if_def($notes,                 "NOTES:");
1005
1006     print $fh "\n";
1007     return;
1008 }
1009
1010 sub output_summary
1011 {
1012     ## takes no arguments
1013     my ($self) = @_;
1014     my $fh     = $self->{fh};
1015     my $report = $self->{report};
1016
1017     ## get the dles
1018     my @dles =
1019       sort { ( $a->[0] cmp $b->[0] ) || ( $a->[1] cmp $b->[1] ) }
1020       $report->get_dles();
1021
1022     ## set the col_spec, which is the configuration for the summary
1023     ## output.
1024     my $col_spec = $self->set_col_spec();
1025
1026     ## collect all the output line specs (see get_summary_info)
1027     my @summary_linespecs = ();
1028     foreach my $dle (@dles) {
1029         push @summary_linespecs, $self->get_summary_info($dle, $report, $col_spec);
1030     }
1031
1032     # shift off the first element of each tuple
1033     my @summary_linedata =
1034       map { my @x = @$_; shift @x; [ @x ] } @summary_linespecs;
1035
1036     ## get the summary format. this is based on col_spec, but may
1037     ## expand maxwidth columns if they have large fields.  Note that
1038     ## this modifies $col_spec in place.  Ordering is important: the summary
1039     ## format must be generated before the others.
1040     my $title_format = get_summary_format($col_spec, 'title', @summary_linedata);
1041     my $summary_format = get_summary_format($col_spec, 'full', @summary_linedata);
1042     my $missing_format = get_summary_format($col_spec, 'missing', @summary_linedata);
1043     my $noflush_format = get_summary_format($col_spec, 'noflush', @summary_linedata);
1044     my $nodump_PARTIAL_format = get_summary_format($col_spec, 'nodump-PARTIAL', @summary_linedata);
1045     my $nodump_FAILED_format = get_summary_format($col_spec, 'nodump-FAILED', @summary_linedata);
1046     my $nodump_FLUSH_format = get_summary_format($col_spec, 'nodump-FLUSH', @summary_linedata);
1047     my $skipped_format = get_summary_format($col_spec, 'skipped', @summary_linedata);
1048
1049     ## print the header names
1050     my $hdl =
1051       $col_spec->[0]->[COLSPEC_WIDTH] +
1052       $col_spec->[1]->[COLSPEC_PRE_SPACE] +
1053       $col_spec->[1]->[COLSPEC_WIDTH] +
1054       $col_spec->[2]->[COLSPEC_PRE_SPACE] +
1055       $col_spec->[2]->[COLSPEC_WIDTH];
1056     my $ds =
1057       $col_spec->[3]->[COLSPEC_WIDTH] +
1058       $col_spec->[4]->[COLSPEC_PRE_SPACE] +
1059       $col_spec->[4]->[COLSPEC_WIDTH] +
1060       $col_spec->[5]->[COLSPEC_PRE_SPACE] +
1061       $col_spec->[5]->[COLSPEC_WIDTH] +
1062       $col_spec->[6]->[COLSPEC_PRE_SPACE] +
1063       $col_spec->[6]->[COLSPEC_WIDTH] +
1064       $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1065       $col_spec->[7]->[COLSPEC_WIDTH];
1066     my $ts =
1067       $col_spec->[8]->[COLSPEC_WIDTH] +
1068       $col_spec->[9]->[COLSPEC_PRE_SPACE] +
1069       $col_spec->[9]->[COLSPEC_WIDTH];
1070
1071
1072     ## use perl's ancient formatting support for the header, since we get free string
1073     ## centering..
1074     my $summary_header_format =
1075       ' ' x ($col_spec->[0]->[COLSPEC_PRE_SPACE] +
1076           $hdl + $col_spec->[4]->[COLSPEC_PRE_SPACE])
1077       . '@' . '|' x ($ds - 1)
1078       . ' ' x $col_spec->[9]->[COLSPEC_PRE_SPACE]
1079       . '@'. '|' x ($ts - 1) . "\n";
1080     my $summary_header = swrite($summary_header_format, "DUMPER STATS", "TAPER STATS");
1081
1082     my $summary_dashes =
1083         ' ' x $col_spec->[0]->[COLSPEC_PRE_SPACE]
1084       . '-' x $hdl
1085       . ' ' x $col_spec->[4]->[COLSPEC_PRE_SPACE]
1086       . '-' x $ds
1087       . ' ' x $col_spec->[9]->[COLSPEC_PRE_SPACE]
1088       . '-' x $ts . "\n";
1089
1090     print $fh "DUMP SUMMARY:\n";
1091     print $fh $summary_header;
1092     print $fh sprintf($title_format, map { $_->[COLSPEC_TITLE] } @$col_spec);
1093     print $fh $summary_dashes;
1094
1095     ## write out each output line
1096     for (@summary_linespecs) {
1097         my ($type, @data) = @$_;
1098         if ($type eq 'full') {
1099             print $fh sprintf($summary_format, @data);
1100         } elsif ($type eq 'nodump-PARTIAL') {
1101             print $fh sprintf($nodump_PARTIAL_format, @data);
1102         } elsif ($type eq 'nodump-FAILED') {
1103             print $fh sprintf($nodump_FAILED_format, @data);
1104         } elsif ($type eq 'nodump-FLUSH') {
1105             print $fh sprintf($nodump_FLUSH_format, @data);
1106         } elsif ($type eq 'missing') {
1107             print $fh sprintf($missing_format, @data[0..2]);
1108         } elsif ($type eq 'noflush') {
1109             print $fh sprintf($noflush_format, @data[0..2]);
1110         } elsif ($type eq 'skipped') {
1111             print $fh sprintf($skipped_format, @data[0..2]);
1112         }
1113     }
1114
1115     print $fh "\n";
1116     return;
1117 }
1118
1119 ## output_summary helper functions.  mostly for formatting, but some
1120 ## for data collection.  Returns an 12-tuple matching one of
1121 ##
1122 ##  ('full', host, disk, level, orig, out, comp%, dumptime, dumprate,
1123 ##    tapetime, taperate, taperpartial)
1124 ##  ('missing', host, disk, '' ..) # MISSING -----
1125 ##  ('noflush', host, disk, '' ..) # NO FILE TO FLUSH ------
1126 ##  ('nodump-$msg', host, disk, level, '', out, '--', '',
1127 ##          '', tapetime, taperate, taperpartial)  # ... {FLUSH|FAILED|PARTIAL} ...
1128 ##  ('skipped', host, disk, '' ..) # SKIPPED -----
1129 ##
1130 ## the taperpartial column is not covered by the columnspec, and "hangs off"
1131 ## the right side.  It's usually empty, but set to " PARTIAL" when the taper
1132 ## write was partial
1133
1134 sub get_summary_info
1135 {
1136     my $self = shift;
1137     my ( $dle, $report, $col_spec ) = @_;
1138     my ( $hostname, $disk ) = @$dle;
1139     my @rvs;
1140
1141     my $dle_info = $report->get_dle_info(@$dle);
1142
1143     my $tail_quote_trunc = sub {
1144         my ($str, $len) = @_;
1145
1146         my $q_str = quote_string($str);
1147         my $qt_str;
1148
1149         if (length($q_str) > $len) {
1150
1151             $qt_str = substr($q_str, length($q_str) - $len, $len);
1152             if ($q_str eq $str) {
1153                 $qt_str =~ s{^.}{-}
1154             } else {
1155                 $qt_str =~ s{^..}{"-};
1156             }
1157         } else {
1158             $qt_str = $q_str;
1159         }
1160
1161         return $qt_str;
1162     };
1163
1164     my $disk_out =
1165       ($col_spec->[1]->[COLSPEC_MAXWIDTH])
1166       ? quote_string($disk)
1167       : $tail_quote_trunc->($disk, $col_spec->[1]->[COLSPEC_WIDTH]);
1168
1169     my $alldumps = $dle_info->{'dumps'};
1170     if ($dle_info->{'planner'} &&
1171         $dle_info->{'planner'}->{'status'} eq 'fail') {
1172         my @rv;
1173         push @rv, 'nodump-FAILED';
1174         push @rv, $hostname;
1175         push @rv, $disk_out;
1176         push @rv, ("",) x 9;
1177         push @rvs, [@rv];
1178     } elsif ($dle_info->{'planner'} &&
1179         $dle_info->{'planner'}->{'status'} eq 'skipped') {
1180         my @rv;
1181         push @rv, 'skipped';
1182         push @rv, $hostname;
1183         push @rv, $disk_out;
1184         push @rv, ("",) x 8;
1185         push @rvs, [@rv];
1186     } elsif (keys %{$alldumps} == 0) {
1187         my @rv;
1188         push @rv, $report->get_flag("amflush_run")? 'noflush' : 'missing';
1189         push @rv, $hostname;
1190         push @rv, $disk_out;
1191         push @rv, ("",) x 8;
1192         push @rvs, [@rv];
1193     }
1194
1195     while( my ($timestamp, $tries) = each %$alldumps ) {
1196         my $last_try = $tries->[-1];
1197         my $level =
1198             exists $last_try->{taper}   ? $last_try->{taper}{level}
1199           : exists $last_try->{chunker} ? $last_try->{chunker}{level}
1200           :                               $last_try->{dumper}{level};
1201
1202         my $orig_size = undef;
1203
1204         # find the try with the successful dumper entry
1205         my $dumper = undef;
1206         foreach my $try (@$tries) {
1207             if ( exists $try->{dumper}
1208                 && exists $try->{dumper}{status}
1209                 && (   $try->{dumper}{status} eq "success"
1210                     || $try->{dumper}{status} eq "strange")) {
1211                 $dumper = $try->{dumper};
1212                 last;
1213             }
1214         }
1215         $orig_size = $dumper->{orig_kb}
1216             if defined $dumper;
1217
1218         my ( $out_size, $dump_time, $dump_rate, $tape_time, $tape_rate ) = (0) x 5;
1219         my ($dumper_status) = "";
1220         my $saw_dumper = 0; # no dumper will mean this was a flush
1221         my $taper_partial = 0; # was the last taper run partial?
1222
1223         ## Use this loop to set values
1224         foreach my $try ( @$tries ) {
1225
1226             ## find the outsize for the output summary
1227
1228             if (
1229                 exists $try->{taper}
1230                 && (   $try->{taper}{status} eq "done"
1231                     || $try->{taper}{status} eq "part+partial" )
1232               ) {
1233                 $taper_partial = 0;
1234                 $orig_size = $try->{taper}{orig_kb} if !defined($orig_size);
1235                 $out_size  = $try->{taper}{kb};
1236                 $tape_time = $try->{taper}{sec};
1237                 $tape_rate = $try->{taper}{kps};
1238             } elsif ( exists $try->{taper}
1239                 && ( $try->{taper}{status} eq "partial" ) ) {
1240
1241                 $taper_partial = 1;
1242                 $orig_size = $try->{taper}{orig_kb} if !defined($orig_size);
1243                 $out_size  = $try->{taper}{kb};
1244                 $tape_time = $try->{taper}{sec} if !$tape_time;
1245                 $tape_rate = $try->{taper}{kps} if !$tape_rate;
1246             } elsif (exists $try->{taper} && ( $try->{taper}{status} eq "fail")) {
1247                 $tape_time = undef;
1248                 $tape_rate = undef;
1249             }
1250
1251             if (!$out_size &&
1252                 exists $try->{chunker}
1253                 && (   $try->{chunker}{status} eq "success"
1254                     || $try->{chunker}{status} eq "partial" )
1255               ) {
1256                 $out_size = $try->{chunker}{kb};
1257             }
1258
1259             if (!$out_size &&
1260                 exists $try->{dumper}) {
1261                 $out_size = $try->{dumper}{kb};
1262             }
1263
1264             if ( exists $try->{dumper}) {
1265                 $saw_dumper = 1;
1266                 $dumper_status = $try->{dumper}{status};
1267             }
1268
1269             ## find the dump time
1270             if ( exists $try->{dumper}
1271                 && exists $try->{dumper}{status}
1272                 && (   $try->{dumper}{status} eq "success"
1273                     || $try->{dumper}{status} eq "strange")) {
1274
1275                 $dump_time = $try->{dumper}{sec};
1276                 $dump_rate = $try->{dumper}{kps};
1277             }
1278         }
1279
1280         # sometimes the driver logs an orig_size of -1, which makes the
1281         # compression percent very large and negative
1282         $orig_size = 0 if ($orig_size < 0);
1283
1284         # pre-format the compression column, with '--' replacing 100% (i.e.,
1285         # no compression)
1286         my $compression;
1287         if (!defined $orig_size || $orig_size == $out_size) {
1288             $compression = '--';
1289         } else {
1290             $compression =
1291               divzero_col((100 * $out_size), $orig_size, $col_spec->[5]);
1292         }
1293
1294         ## simple formatting macros
1295
1296         my $fmt_col_field = sub {
1297             my ( $column, $data ) = @_;
1298
1299             return sprintf(
1300                 $col_spec->[$column]->[COLSPEC_FORMAT],
1301                 $col_spec->[$column]->[COLSPEC_WIDTH],
1302                 $col_spec->[$column]->[COLSPEC_PREC], $data
1303             );
1304         };
1305
1306         my $format_space = sub {
1307             my ( $column, $data ) = @_;
1308
1309             return sprintf("%*s",$col_spec->[$column]->[COLSPEC_WIDTH], $data);
1310         };
1311
1312         my @rv;
1313
1314         if ( !$orig_size && !$out_size && (!defined($tape_time) || !$tape_time)) {
1315             push @rv, $report->get_flag("amflush_run")? 'noflush' : 'missing';
1316             push @rv, $hostname;
1317             push @rv, $disk_out;
1318             push @rv, ("",) x 8;
1319         } elsif ($saw_dumper and ($dumper_status eq 'success' or $dumper_status eq 'strange')) {
1320             push @rv, "full";
1321             push @rv, $hostname;
1322             push @rv, $disk_out;
1323             push @rv, $fmt_col_field->(2, $level);
1324             push @rv, $orig_size ? $fmt_col_field->(3, $self->tounits($orig_size)) : '';
1325             push @rv, $out_size ? $fmt_col_field->(4, $self->tounits($out_size)) : '';
1326             push @rv, $compression;
1327             push @rv, $dump_time ? $fmt_col_field->(6, mnsc($dump_time)) : "PARTIAL";
1328             push @rv, $dump_rate ? $fmt_col_field->(7, $dump_rate) : "";
1329             push @rv, $fmt_col_field->(8,
1330                     (defined $tape_time) ?
1331                             $tape_time ? mnsc($tape_time) : ""
1332                           : "FAILED");
1333             push @rv, (defined $tape_rate) ?
1334                 $tape_rate ?
1335                     $fmt_col_field->(9, $tape_rate)
1336                   : $format_space->(9, "")
1337               : $format_space->(9, "FAILED");
1338             push @rv, $taper_partial? " PARTIAL" : ""; # column 10
1339         } else {
1340             my $message = $saw_dumper?
1341                             ($dumper_status eq 'failed') ? 'FAILED' : 'PARTIAL'
1342                           : 'FLUSH';
1343             push @rv, "nodump-$message";
1344             push @rv, $hostname;
1345             push @rv, $disk_out;
1346             push @rv, $fmt_col_field->(2, $level);
1347             push @rv, $orig_size ? $fmt_col_field->(4, $self->tounits($orig_size)) :'';
1348             push @rv, $out_size ? $fmt_col_field->(4, $self->tounits($out_size)) : '';
1349             push @rv, $compression;
1350             push @rv, '';
1351             push @rv, '';
1352             push @rv, $fmt_col_field->(8,
1353                     (defined $tape_time) ?
1354                             $tape_time ? mnsc($tape_time) : ""
1355                           : "FAILED");
1356             push @rv, (defined $tape_rate) ?
1357                 $tape_rate ?
1358                     $fmt_col_field->(9, $tape_rate)
1359                   : $format_space->(9, "")
1360               : $format_space->(9, "FAILED");
1361             push @rv, $taper_partial? " PARTIAL" : "";
1362         }
1363         push @rvs, [@rv];
1364     }
1365     return @rvs;
1366 }
1367
1368 sub get_summary_format
1369 {
1370     my ($col_spec, $type, @summary_lines) = @_;
1371     my @col_format = ();
1372
1373     if ($type eq 'full' || $type eq 'title') {
1374         foreach my $i ( 0 .. ( @$col_spec - 1 ) ) {
1375             push @col_format,
1376               get_summary_col_format( $i, $col_spec->[$i],
1377                 map { $_->[$i] } @summary_lines );
1378         }
1379     } else {
1380         # first two columns are the same
1381         foreach my $i ( 0 .. 1 ) {
1382             push @col_format,
1383               get_summary_col_format( $i, $col_spec->[$i],
1384                 map { $_->[$i] } @summary_lines );
1385         }
1386
1387         # some of these have a lovely text rule, just to be difficult
1388         my $rulewidth =
1389             $col_spec->[3]->[COLSPEC_WIDTH] +
1390             $col_spec->[4]->[COLSPEC_PRE_SPACE] +
1391             $col_spec->[4]->[COLSPEC_WIDTH] +
1392             $col_spec->[5]->[COLSPEC_PRE_SPACE] +
1393             $col_spec->[5]->[COLSPEC_WIDTH] +
1394             $col_spec->[6]->[COLSPEC_PRE_SPACE] +
1395             $col_spec->[6]->[COLSPEC_WIDTH] +
1396             $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1397             $col_spec->[7]->[COLSPEC_WIDTH] +
1398             $col_spec->[8]->[COLSPEC_PRE_SPACE] +
1399             $col_spec->[8]->[COLSPEC_WIDTH] +
1400             $col_spec->[9]->[COLSPEC_PRE_SPACE] +
1401             $col_spec->[9]->[COLSPEC_WIDTH];
1402
1403         if ($type eq 'missing') {
1404             # add a blank level column and the space for the origkb column
1405             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1406             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1407             push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1408             my $str = "MISSING ";
1409             $str .= '-' x ($rulewidth - length($str));
1410             push @col_format, $str;
1411         } elsif ($type eq 'noflush') {
1412             # add a blank level column and the space for the origkb column
1413             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1414             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1415             push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1416
1417             my $str = "NO FILE TO FLUSH ";
1418             $str .= '-' x ($rulewidth - length($str));
1419             push @col_format, $str;
1420         } elsif ($type =~ /^nodump-(.*)$/) {
1421             my $msg = $1;
1422
1423             # nodump has level, origkb, outkb, and comp% although origkb is usually blank and
1424             # comp% is "--".
1425             foreach my $i ( 2 .. 5 ) {
1426                 push @col_format,
1427                   get_summary_col_format( $i, $col_spec->[$i],
1428                     map { $_->[$i] } @summary_lines );
1429             }
1430
1431             # and then the message is centered across columns 6 and 7, which are both blank
1432             push @col_format, ' ' x $col_spec->[6]->[COLSPEC_PRE_SPACE];
1433             my $width =
1434                 $col_spec->[6]->[COLSPEC_WIDTH] +
1435                 $col_spec->[7]->[COLSPEC_PRE_SPACE] +
1436                 $col_spec->[7]->[COLSPEC_WIDTH];
1437
1438             my $str = ' ' x (($width - length($msg))/2);
1439             $str .= $msg;
1440             $str .= ' ' x ($width - length($str));
1441             push @col_format, $str;
1442             push @col_format, "%s%s"; # consume empty columns 6 and 7
1443
1444             # and finally columns 8 and 9 as usual
1445             foreach my $i ( 8 .. 9 ) {
1446                 push @col_format,
1447                   get_summary_col_format( $i, $col_spec->[$i],
1448                     map { $_->[$i] } @summary_lines );
1449             }
1450         } elsif ($type eq 'skipped') {
1451             # add a blank level column and the space for the origkb column
1452             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_PRE_SPACE];
1453             push @col_format, ' ' x $col_spec->[2]->[COLSPEC_WIDTH];
1454             push @col_format, ' ' x $col_spec->[3]->[COLSPEC_PRE_SPACE];
1455             my $str = "SKIPPED ";
1456             $str .= '-' x ($rulewidth - length($str));
1457             push @col_format, $str;
1458         }
1459     }
1460
1461     # and format the hidden 10th column.  This is not part of the columnspec,
1462     # so its width is not counted in any of the calculations here.
1463     push @col_format, "%s" if $type ne 'title';
1464
1465     return join( "", @col_format ) . "\n";
1466 }
1467
1468 sub get_summary_col_format
1469 {
1470     my ( $i, $col, @entries ) = @_;
1471
1472     my $col_width = $col->[COLSPEC_WIDTH];
1473     my $left_align = ($i == 0 || $i == 1); # first 2 cols left-aligned
1474     my $limit_width = ($i == 0 || $i == 1); # and not allowed to overflow
1475
1476     ## if necessary, resize COLSPEC_WIDTH to the maximum widht
1477     ## of any row
1478     if ($col->[COLSPEC_MAXWIDTH]) {
1479
1480         push @entries, $col->[COLSPEC_TITLE];
1481         my $strmax = max( map { length $_ } @entries );
1482         $col_width = max($strmax, $col_width);
1483         # modify the spec in place, so the headers and
1484         # whatnot all add up .. yuck!
1485         $col->[COLSPEC_WIDTH] = $col_width;
1486     }
1487
1488     # put together a "%s" format for this column
1489     my $rv = ' ' x $col->[COLSPEC_PRE_SPACE]; # space on left
1490     $rv .= '%';
1491     $rv .= '-' if $left_align;
1492     $rv .= $col_width;
1493     $rv .= ".$col_width" if $limit_width;
1494     $rv .= "s";
1495 }
1496
1497 ## col_spec functions.  I want to deprecate this stuff so bad it hurts.
1498
1499 sub set_col_spec
1500 {
1501     my ($self) = @_;
1502     my $report = $self->{report};
1503     my $disp_unit = $self->{disp_unit};
1504
1505     $self->{col_spec} = [
1506         [ "HostName", 0, 12, 12, 0, "%-*.*s", "HOSTNAME" ],
1507         [ "Disk",     1, 11, 11, 0, "%-*.*s", "DISK" ],
1508         [ "Level",    1, 1,  1,  0, "%*.*d",  "L" ],
1509         [ "OrigKB",   1, 7,  0,  1, "%*.*f",  "ORIG-" . $disp_unit . "B" ],
1510         [ "OutKB",    1, 7,  0,  1, "%*.*f",  "OUT-" . $disp_unit . "B" ],
1511         [ "Compress", 1, 6,  1,  1, "%*.*f",  "COMP%" ],
1512         [ "DumpTime", 1, 7,  7,  1, "%*.*s",  "MMM:SS" ],
1513         [ "DumpRate", 1, 6,  1,  1, "%*.*f",  "KB/s" ],
1514         [ "TapeTime", 1, 6,  6,  1, "%*.*s",  "MMM:SS" ],
1515         [ "TapeRate", 1, 6,  1,  1, "%*.*f",  "KB/s" ]
1516     ];
1517
1518     $self->apply_col_spec_override();
1519     return $self->{col_spec};
1520 }
1521
1522 sub apply_col_spec_override
1523 {
1524     my ($self) = @_;
1525     my $col_spec = $self->{col_spec};
1526
1527     my %col_spec_override = read_col_spec_override();
1528
1529     foreach my $col (@$col_spec) {
1530         if ( my $col_override = $col_spec_override{ $col->[COLSPEC_NAME] } ) {
1531
1532             my $override_col_val_if_def = sub {
1533                 my ( $field, $or_num ) = @_;
1534                 if ( defined $col_override->[$or_num]
1535                     && !( $col_override->[$or_num] eq "" ) ) {
1536                     $col->[$field] = $col_override->[$or_num];
1537                 }
1538             };
1539
1540             $override_col_val_if_def->( COLSPEC_PRE_SPACE, 0 );
1541             $override_col_val_if_def->( COLSPEC_WIDTH,     1 );
1542             $override_col_val_if_def->( COLSPEC_PREC,      2 );
1543             $override_col_val_if_def->( COLSPEC_MAXWIDTH,  3 );
1544         }
1545     }
1546 }
1547
1548 sub read_col_spec_override
1549 {
1550     ## takes no arguments
1551     my $col_spec_str = getconf($CNF_COLUMNSPEC) || return;
1552     my %col_spec_override = ();
1553
1554     foreach (split(",", $col_spec_str)) {
1555
1556         $_ =~ m/^(\w+)           # field name
1557                 =([-:\d]+)       # field values
1558                 $/x
1559           or die "error: malformed columnspec string:$col_spec_str";
1560
1561         my $field = $1;
1562         my @field_values = split ':', $2;
1563
1564         # too many values
1565         die "error: malformed columnspec string:$col_spec_str"
1566           if (@field_values > 3);
1567
1568         # all values *should* be in the right place.  If not enough
1569         # were given, pad the array.
1570         push @field_values, "" while (@field_values < 4);
1571
1572         # if the second value is negative, that means MAXWIDTH=1, so
1573         # sort that out now.  Yes, this is pretty ugly.  Imagine this in C!
1574         if ($field_values[1] ne '') {
1575             if ($field_values[1] =~ /^-/) {
1576                 $field_values[1] =~ s/^-//;
1577                 $field_values[3] = 1;
1578             } else {
1579                 $field_values[3] = 0;
1580             }
1581         }
1582
1583         $col_spec_override{$field} = \@field_values;
1584     }
1585
1586     return %col_spec_override;
1587 }
1588
1589 sub print_if_def
1590 {
1591     my ($self, $msgs, $header) = @_;
1592     my $fh = $self->{fh};
1593
1594     @$msgs or return;    # do not print section if no messages
1595
1596     print $fh "$header\n";
1597     foreach my $msg (@$msgs) {
1598         print $fh "  $msg\n";
1599     }
1600     print $fh "\n";
1601 }
1602
1603 1;