Merge r56.

bin/pt-query-digest

@@ -11800,15 +11800,6 @@ sub main {
       @orderby = @{$o->get('order-by')};
    }
 
-   my $can_gzip;
-   if ( $o->get('save-results') ) {
-      eval {
-         require IO::Compress::Gzip;
-         IO::Compress::Gzip->import(qw(gzip $GzipError));
-      };
-      $can_gzip = $EVAL_ERROR ? 0 : 1;
-   }
-
    if ( !$o->get('help') ) {
       if ( $review_dsn
            && (!defined $review_dsn->{D} || !defined $review_dsn->{t}) ) {
@@ -11835,16 +11826,6 @@ sub main {
          $o->save_error("--execute-throttle step must be between 1 and 100")
             if $step && ($step < 1 || $step > 100);
       }
-      if ( $o->get('save-results') && $o->get('gzip') && !$can_gzip ) {
-         my $err = "Cannot gzip --save-results because IO::Compress::Gzip "
-                 . "is not installed";
-         if ( $o->got('gzip') ) {
-            $o->save_error($err);
-         }
-         else {
-            warn $err;
-         }
-      }
       if ( $o->get('progress') ) {
          eval { Progress->validate_spec($o->get('progress')) };
          if ( $EVAL_ERROR ) {
@@ -13207,15 +13188,6 @@ sub print_reports {
          );
       }
 
-      if ( my $file = $o->get('save-results') ) {
-         save_results(
-            ea    => $eas->[$i],
-            worst => $worst,
-            file  => $file,
-            gzip  => $o->get('gzip'),
-         );
-      }
-
       $eas->[$i]->reset_aggregated_data();  # Reset for next iteration.
 
       # Print header report only once.  So remove it from the
@@ -13529,79 +13501,6 @@ sub update_query_review_tables {
    return;
 }
 
-# Save EventAggregator (ea) results to file.  To reconstruct an ea
-# later, the following info is saved, in this format:
-#   groupby (e.g. fingerprint)
-#
-#   worst  (e.g. Query_time)
-#
-#   attribute types (hashref with attrib=>type for each attrib)
-#
-#   results (3 hashrefs for classes, globals and samples)
-# Each bit of info is separated by a blank line so the program that
-# loads them can easily parse one from the other ($INPUT_RECORD_SEPARATOR='').
-sub save_results {
-   my ( %args ) = @_;
-   foreach my $arg ( qw(ea worst file) ) {
-      die "I need a $arg argument" unless $args{$arg};
-   }
-   my $ea      = $args{ea};
-   my $results = $ea->results();
-   my $worst   = $args{worst};
-   my $file    = $args{file};
-   return unless $file;
-   MKDEBUG && _d('Saving results to', $file);
-
-   my $ea_info = {
-      groupby         => $ea->{groupby},
-      worst           => $ea->{worst},
-      attribute_types => $ea->attributes(),
-      results         => { 
-         classes => {},
-         globals => $results->{globals},
-         samples => {},
-      }
-   };
-   # Shallow copy of worst results (don't dump all results).
-   foreach my $item ( @$worst ) {
-      my $where = $item->[0];
-      $ea_info->{results}->{classes}->{$where} = $results->{classes}->{$where};
-      $ea_info->{results}->{samples}->{$where} = $results->{samples}->{$where};
-   }
-
-   my ($fh, $zfh);  # filehandle, gzip filehandle
-   $file .= '.gz' if $args{gzip};
-   open $fh, '>', $file;
-   if ( !$fh ) {
-      warn "Cannot open $file for --save-results: $OS_ERROR";
-      return;
-   }
-   if ( $args{gzip} ) {
-      our $GzipError;
-      $zfh = new IO::Compress::Gzip($fh);
-      if ( !$zfh ) {
-         warn "Cannot open gzip filehandle on $file for --save-results: "
-            . $GzipError;
-         close $fh if $fh;
-         return;
-      }
-   }
-   else {
-      $zfh = $fh;
-   }
-
-   local $Data::Dumper::Indent    = 0;
-   local $Data::Dumper::Sortkeys  = 1;
-   local $Data::Dumper::Quotekeys = 0;
-   local $Data::Dumper::Purity    = 1;
-
-   print $zfh Dumper($ea_info);
-   close $zfh;
-   close $fh if $fh;
-
-   return;
-}
-
 # Sub: verify_run_time
 #   Verify that the given run mode and run time are valid.  If the run mode
 #   is "interval", the time boundary (in seconds) for the run time is returned
@@ -13817,7 +13716,7 @@ L<http://code.google.com/p/maatkit/wiki/EventAttributes>.
 The default output is a query analysis report.  The L<"--[no]report"> option
 controls whether or not this report is printed.  Sometimes you may wish to
 parse all the queries but suppress the report, for example when using
-L<"--print">, L<"--review"> or L<"--save-results">.
+L<"--print"> or L<"--review">.
 
 There is one paragraph for each class of query analyzed.  A "class" of queries
 all have the same value for the L<"--group-by"> attribute which is
@@ -14561,12 +14460,6 @@ attributes which you can group by: key_print (see memcached section in
 L<"FINGERPRINTS">), cmd, key, res and val (see memcached section in
 L<"ATTRIBUTES">).
 
-=item --[no]gzip
-
-default: yes
-
-Gzip L<"--save-results"> files; requires IO::Compress::Gzip.
-
 =item --help
 
 Show help and exit.
@@ -15147,15 +15040,6 @@ queries.  A complete example:
 
   pt-query-digest --sample 2 --no-report --print slow.log
 
-=item --save-results
-
-type: string
-
-Save results to the specified file.
-
-If L<"--[no]gzip"> is true (by default it is) then .gz is appended to the
-file name.
-
 =item --select
 
 type: Array

t/pt-query-digest/save_results.t

@@ -1,67 +0,0 @@
-#!/usr/bin/env perl
-
-BEGIN {
-   die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
-      unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
-   unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
-};
-
-use strict;
-use warnings FATAL => 'all';
-use English qw(-no_match_vars);
-use Test::More tests => 4;
-
-use PerconaTest;
-shift @INC;  # our unshift (above)
-shift @INC;  # PerconaTest's unshift
-require "$trunk/bin/pt-query-digest";
-
-my @args      = (qw(--no-report --no-gzip));
-my $sample    = "$trunk/t/lib/samples/slowlogs/";
-my $ressample = "$trunk/t/pt-query-digest/samples/save-results/";
-my $resdir    = "/tmp/mqd-res/";
-my $diff      = "";
-
-# Default results (95%).  From slow002 that's 1 query.
-diag(`rm -rf $resdir ; mkdir $resdir`);
-pt_query_digest::main(@args, '--save-results', "$resdir/r1",
-   $sample.'slow002.txt');
-ok(
-   -f "$resdir/r1",
-   "Saved results to file"
-);
-
-$diff = `diff $ressample/slow002.txt $resdir/r1 2>&1`;
-is(
-   $diff,
-   '',
-   "slow002.txt saved results"
-);
-
-# Change --limit to save more queries.
-diag(`rm -rf $resdir/*`);
-pt_query_digest::main(@args, '--save-results', "$resdir/r1",
-   qw(--limit 3), $sample.'slow002.txt');
-$diff = `diff $ressample/slow002-limit-3.txt $resdir/r1 2>&1`;
-is(
-   $diff,
-   '',
-   "slow002.txt --limit 3 saved results"
-);
-
-# issue 1008: sprintf formatting in log events crashes it.
-diag(`rm -rf $resdir/*`);
-pt_query_digest::main(@args, '--save-results', "$resdir/r1",
-   $sample.'slow043.txt');
-$diff = `diff $ressample/slow043.txt $resdir/r1 2>&1`;
-is(
-   $diff,
-   '',
-   "slow043.txt did not crash with its %d format code"
-);
-
-# #############################################################################
-# Done.
-# #############################################################################
-diag(`rm -rf $resdir`);
-exit;

util/check-tool

@@ -18,6 +18,7 @@ if ( !@tool_files ) {
 my $exit_status = 0;  # 0 no problems, 1 any problems
 my $tool_file;        # bin/pt-archiver
 my $tool_name;        # pt-archiver (no path)
+my $tool_type;        # perl or bash
 
 my @check_subs = (qw(
    check_alpha_order
@@ -47,6 +48,13 @@ while ( defined($tool_file = shift @ARGV) ) {
       next TOOL;
    }
 
+   $tool_type = get_tool_type($tool_file);
+   if ( !$tool_type ) {
+      $exit_status = 1;
+      warn "Cannot determine if $tool_name is Perl or Bash; assuming Perl";
+      $tool_type = 'perl';
+   }
+
    foreach my $check_sub ( @check_subs ) {
       seek $fh, 0, 0;
       print "# $check_sub ", ('#' x (70 - length $check_sub)), "\n";
@@ -67,6 +75,16 @@ exit $exit_status;
 # Subroutines
 # ############################################################################
 
+sub get_tool_type {
+   my ($file) = @_;
+   return unless $file;
+   my $head = `head -n 1 $file`;
+   return unless $head;
+   return 'bash' if $head =~ m/bash|sh/;
+   return 'perl' if $head =~ m/perl/;
+   return;
+}
+
 # Check that options in the tool's POD are in alphabetical order.  Only the
 # head1 OPTIONS section and any head2 subsections are checked.  Subsections
 # are considered independent.  The "[no]" part of negatable options is not
@@ -120,6 +138,11 @@ sub parse_options {
 sub check_module_usage {
    my ($fh) = @_;
 
+   if ( $tool_type ne 'perl' ) {
+      print "Not a Perl tool\n";
+      return;
+   }
+
    # These modules are not instantiated as objects.
    my %not_obj = (
       Transformers   => 1,
@@ -211,6 +234,11 @@ sub check_module_usage {
 sub check_option_types {
    my ($fh) = @_;
 
+   if ( $tool_type ne 'perl' ) {
+      print "Not a Perl tool\n";
+      return;
+   }
+
    # Standard options: http://code.google.com/p/maatkit/wiki/CommandLineOptions
    my $sop = {
       'defaults-file'   => {type  => 's', short => 'F' },
@@ -330,10 +358,10 @@ sub check_pod_header_order {
       'RISKS',
       'DESCRIPTION',
       'OPTIONS',
-      'DOWNLOADING',
       'ENVIRONMENT',
       'SYSTEM REQUIREMENTS',
       'BUGS',
+      'DOWNLOADING',
       'AUTHORS',
       'COPYRIGHT, LICENSE, AND WARRANTY',
       'VERSION',
@@ -390,6 +418,11 @@ sub check_pod_formatting {
 sub check_option_usage {
    my ($fh) = @_;
 
+   if ( $tool_type ne 'perl' ) {
+      print "Not a Perl tool\n";
+      return;
+   }
+
    # help and version are special opts, intrinsic to OptionParser.
    # The other opts are usually processed all at once by calling
    # DSNParser::parse_options().