Merged fix-doc-bugs-1016127-934310-937225-1016114

This commit is contained in:
Brian Fraser
2012-08-02 15:10:45 -03:00
26 changed files with 240 additions and 172 deletions

View File

@@ -2143,7 +2143,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }

View File

@@ -1252,7 +1252,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -1291,7 +1291,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -1301,15 +1301,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -1321,12 +1323,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }
@@ -1451,6 +1453,7 @@ sub new {
dsn_name => $dp->as_string($dsn, [qw(h P S)]), dsn_name => $dp->as_string($dsn, [qw(h P S)]),
hostname => '', hostname => '',
set => $args{set}, set => $args{set},
NAME_lc => defined($args{NAME_lc}) ? $args{NAME_lc} : 1,
dbh_set => 0, dbh_set => 0,
OptionParser => $o, OptionParser => $o,
DSNParser => $dp, DSNParser => $dp,
@@ -1488,7 +1491,10 @@ sub set_dbh {
PTDEBUG && _d($dbh, 'Setting dbh'); PTDEBUG && _d($dbh, 'Setting dbh');
if ( !exists $self->{NAME_lc}
|| (defined $self->{NAME_lc} && $self->{NAME_lc}) ) {
$dbh->{FetchHashKeyName} = 'NAME_lc'; $dbh->{FetchHashKeyName} = 'NAME_lc';
}
my $sql = 'SELECT @@hostname, @@server_id'; my $sql = 'SELECT @@hostname, @@server_id';
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);

View File

@@ -2014,7 +2014,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -2053,7 +2053,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -2063,15 +2063,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -2083,12 +2085,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1514,7 +1514,8 @@ sub _GetTerminalSize {
die "My::Term::ReadKey doesn't implement GetTerminalSize with arguments"; die "My::Term::ReadKey doesn't implement GetTerminalSize with arguments";
} }
my ( $rows, $cols ); my $cols = $ENV{COLUMNS} || 80;
my $rows = $ENV{LINES} || 24;
if ( open( TTY, "+<", "/dev/tty" ) ) { # Got a tty if ( open( TTY, "+<", "/dev/tty" ) ) { # Got a tty
my $winsize = ''; my $winsize = '';

View File

@@ -787,7 +787,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -826,7 +826,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -836,15 +836,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -856,12 +858,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -227,7 +227,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -266,7 +266,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -276,15 +276,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -296,12 +298,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1371,7 +1371,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -1410,7 +1410,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -1420,15 +1420,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -1440,12 +1442,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1986,7 +1986,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }

View File

@@ -227,7 +227,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -266,7 +266,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -276,15 +276,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -296,12 +298,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1586,7 +1586,7 @@ sub parse {
} }
foreach my $key ( keys %given_props ) { foreach my $key ( keys %given_props ) {
die "DSN option '$key' in '$dsn'. For more details, " die "Unknown DSN option '$key' in '$dsn'. For more details, "
. "please use the --help option, or try 'perldoc $PROGRAM_NAME' " . "please use the --help option, or try 'perldoc $PROGRAM_NAME' "
. "for complete documentation." . "for complete documentation."
unless exists $opts->{$key}; unless exists $opts->{$key};
@@ -1702,7 +1702,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -1741,7 +1741,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -1751,15 +1751,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -1771,12 +1773,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }
@@ -2476,9 +2478,11 @@ sub parse {
my ( $self, $ddl, $opts ) = @_; my ( $self, $ddl, $opts ) = @_;
return unless $ddl; return unless $ddl;
if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) {
die "Cannot parse table definition; is ANSI quoting " $ddl = $self->ansi_to_legacy($ddl);
. "enabled or SQL_QUOTE_SHOW_CREATE disabled?"; }
elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {
die "TableParser doesn't handle CREATE TABLE without quoting.";
} }
my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;
@@ -2687,19 +2691,13 @@ sub get_keys {
my $key_ddl = $key; my $key_ddl = $key;
PTDEBUG && _d('Parsed key:', $key_ddl); PTDEBUG && _d('Parsed key:', $key_ddl);
if ( $engine !~ m/MEMORY|HEAP/ ) { if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) {
$key =~ s/USING HASH/USING BTREE/; $key =~ s/USING HASH/USING BTREE/;
} }
my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;
my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;
$type = $type || $special || 'BTREE'; $type = $type || $special || 'BTREE';
if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000'
&& $engine =~ m/HEAP|MEMORY/i )
{
$type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP
}
my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;
my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;
my @cols; my @cols;
@@ -2725,7 +2723,7 @@ sub get_keys {
ddl => $key_ddl, ddl => $key_ddl,
}; };
if ( $engine =~ m/InnoDB/i && !$clustered_key ) { if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) {
my $this_key = $keys->{$name}; my $this_key = $keys->{$name};
if ( $this_key->{name} eq 'PRIMARY' ) { if ( $this_key->{name} eq 'PRIMARY' ) {
$clustered_key = 'PRIMARY'; $clustered_key = 'PRIMARY';
@@ -2808,6 +2806,21 @@ sub get_table_status {
return @tables; return @tables;
} }
my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx;
sub ansi_to_legacy {
my ($self, $ddl) = @_;
$ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge;
return $ddl;
}
sub ansi_quote_replace {
my ($val) = @_;
$val =~ s/^"|"$//g;
$val =~ s/`/``/g;
$val =~ s/""/"/g;
return "`$val`";
}
sub _d { sub _d {
my ($package, undef, $line) = caller 0; my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -4698,7 +4711,7 @@ sub new {
dsn_name => $dp->as_string($dsn, [qw(h P S)]), dsn_name => $dp->as_string($dsn, [qw(h P S)]),
hostname => '', hostname => '',
set => $args{set}, set => $args{set},
NAME_lc => $args{NAME_lc}, NAME_lc => defined($args{NAME_lc}) ? $args{NAME_lc} : 1,
dbh_set => 0, dbh_set => 0,
OptionParser => $o, OptionParser => $o,
DSNParser => $dp, DSNParser => $dp,

View File

@@ -2207,7 +2207,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -2246,7 +2246,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -2256,15 +2256,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -2276,12 +2278,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1896,7 +1896,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -7985,6 +7985,12 @@ The C<RENAME> clause cannot be used to rename the table.
Columns cannot be renamed by dropping and re-adding with the new name. Columns cannot be renamed by dropping and re-adding with the new name.
The tool will not copy the original column's data to the new column. The tool will not copy the original column's data to the new column.
=item *
If you add a column without a default value and make it NOT NULL, the tool
will fail, as it will not try to guess a default value for you; You must
specify the default.
=back =back
=item --alter-foreign-keys-method =item --alter-foreign-keys-method

View File

@@ -227,7 +227,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -266,7 +266,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -276,15 +276,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -296,12 +298,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }
@@ -6895,7 +6897,8 @@ severity: warn
OUTER JOIN defeated. The reference to an outer table column in the WHERE clause OUTER JOIN defeated. The reference to an outer table column in the WHERE clause
prevents the OUTER JOIN from returning any non-matched rows, which implicitly prevents the OUTER JOIN from returning any non-matched rows, which implicitly
converts the query to an INNER JOIN. This is probably a bug in the query or a converts the query to an INNER JOIN. This is probably a bug in the query or a
misunderstanding of how OUTER JOIN works. misunderstanding of how OUTER JOIN works, as LEFT/RIGHT joins are a shortcut
for LEFT/RIGHT OUTER JOIN.
=item JOI.004 =item JOI.004

View File

@@ -227,7 +227,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -266,7 +266,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -276,15 +276,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -296,12 +298,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }
@@ -2311,6 +2313,7 @@ sub new {
last_poll => 0, last_poll => 0,
active_cxn => {}, # keyed off ID active_cxn => {}, # keyed off ID
event_cache => [], event_cache => [],
_reasons_for_matching => {},
}; };
return bless $self, $class; return bless $self, $class;
} }
@@ -2521,7 +2524,9 @@ sub find {
PTDEBUG && _d("Query isn't running long enough"); PTDEBUG && _d("Query isn't running long enough");
next QUERY; next QUERY;
} }
PTDEBUG && _d('Exceeds busy time'); my $reason = 'Exceeds busy time';
PTDEBUG && _d($reason);
push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
$matched++; $matched++;
} }
@@ -2531,7 +2536,9 @@ sub find {
PTDEBUG && _d("Query isn't idle long enough"); PTDEBUG && _d("Query isn't idle long enough");
next QUERY; next QUERY;
} }
PTDEBUG && _d('Exceeds idle time'); my $reason = 'Exceeds idle time';
PTDEBUG && _d($reason);
push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
$matched++; $matched++;
} }
@@ -2548,7 +2555,9 @@ sub find {
PTDEBUG && _d('Query does not match', $property, 'spec'); PTDEBUG && _d('Query does not match', $property, 'spec');
next QUERY; next QUERY;
} }
PTDEBUG && _d('Query matches', $property, 'spec'); my $reason = 'Query matches ' . $property . ' spec';
PTDEBUG && _d($reason);
push @{$self->{_reasons_for_matching}->{$query} ||= []}, $reason;
$matched++; $matched++;
} }
} }

View File

@@ -1252,7 +1252,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -1291,7 +1291,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -1301,15 +1301,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -1321,12 +1323,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1702,7 +1702,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -1741,7 +1741,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -1751,15 +1751,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -1771,12 +1773,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1702,7 +1702,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }

View File

@@ -2015,7 +2015,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }

View File

@@ -227,7 +227,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -4357,6 +4357,11 @@ sub next {
return; return;
} }
} }
if ( !$self->{one_nibble} && !$self->{first_lower} ) {
PTDEBUG && _d('No first lower boundary, table must be empty');
$self->{no_more_boundaries} = 1;
return;
}
} }
NIBBLE: NIBBLE:

View File

@@ -1821,7 +1821,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }

View File

@@ -227,7 +227,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -266,7 +266,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -276,15 +276,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -296,12 +298,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -2338,7 +2338,8 @@ number of iterations.
type: float type: float
The percentile for the last column when L<"--type"> is "requests" (default .99). The percentile for the second to last last column when L<"--type"> is
"requests" (default .99).
=item --run-time =item --run-time

View File

@@ -227,7 +227,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -266,7 +266,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -276,15 +276,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -296,12 +298,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1702,7 +1702,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -1741,7 +1741,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -1751,15 +1751,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -1771,12 +1773,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -1924,7 +1924,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }
@@ -1963,7 +1963,7 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error getting the current SQL_MODE: $EVAL_ERROR";
} }
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
@@ -1973,15 +1973,17 @@ sub get_dbh {
PTDEBUG && _d($dbh, $sql); PTDEBUG && _d($dbh, $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE"
. ($sql_mode ? " and $sql_mode" : '')
. ": $EVAL_ERROR";
} }
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) {
$sql = "/*!40101 SET NAMES $charset*/"; $sql = qq{/*!40101 SET NAMES "$charset"*/};
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting NAMES to $charset: $EVAL_ERROR";
} }
PTDEBUG && _d('Enabling charset for STDOUT'); PTDEBUG && _d('Enabling charset for STDOUT');
if ( $charset eq 'utf8' ) { if ( $charset eq 'utf8' ) {
@@ -1993,12 +1995,12 @@ sub get_dbh {
} }
} }
if ( $self->prop('set-vars') ) { if ( my $var = $self->prop('set-vars') ) {
$sql = "SET " . $self->prop('set-vars'); $sql = "SET $var";
PTDEBUG && _d($dbh, ':', $sql); PTDEBUG && _d($dbh, ':', $sql);
eval { $dbh->do($sql) }; eval { $dbh->do($sql) };
if ( $EVAL_ERROR ) { if ( $EVAL_ERROR ) {
die $EVAL_ERROR; die "Error setting $var: $EVAL_ERROR";
} }
} }
} }

View File

@@ -291,7 +291,7 @@ sub get_dbh {
. "that Perl searches for DBI. If DBI is not installed, try:\n" . "that Perl searches for DBI. If DBI is not installed, try:\n"
. " Debian/Ubuntu apt-get install libdbi-perl\n" . " Debian/Ubuntu apt-get install libdbi-perl\n"
. " RHEL/CentOS yum install perl-DBI\n" . " RHEL/CentOS yum install perl-DBI\n"
. " OpenSolaris pgk install pkg:/SUNWpmdbi\n"; . " OpenSolaris pkg install pkg:/SUNWpmdbi\n";
} }