mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-08 20:37:36 +00:00
Fix 984915: DSNParser does not check return value of do() calls
This commit is contained in:
@@ -1709,51 +1709,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1762,12 +1721,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1262,51 +1262,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1315,12 +1274,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1525,51 +1525,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1578,12 +1537,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -947,51 +947,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1000,12 +959,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
96
bin/pt-find
96
bin/pt-find
@@ -237,51 +237,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -290,12 +249,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1381,51 +1381,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1434,12 +1393,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1970,51 +1970,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -2023,12 +1982,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -237,51 +237,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -290,12 +249,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
96
bin/pt-kill
96
bin/pt-kill
@@ -1406,51 +1406,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1459,12 +1418,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -2217,51 +2217,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -2270,12 +2229,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1406,51 +1406,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1459,12 +1418,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -237,51 +237,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -290,12 +249,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -237,51 +237,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -290,12 +249,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1262,51 +1262,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1315,12 +1274,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1406,51 +1406,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1459,12 +1418,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1262,51 +1262,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1315,12 +1274,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1525,51 +1525,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1578,12 +1537,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -237,51 +237,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -290,12 +249,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1381,51 +1381,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1434,12 +1393,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -237,51 +237,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -290,12 +249,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -237,51 +237,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -290,12 +249,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1262,51 +1262,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1315,12 +1274,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -1934,51 +1934,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -1987,12 +1946,63 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
108
lib/DSNParser.pm
108
lib/DSNParser.pm
@@ -302,57 +302,10 @@ sub get_dbh {
|
||||
PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
|
||||
join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
|
||||
|
||||
eval {
|
||||
$dbh = DBI->connect($cxn_string, $user, $pass, $defaults);
|
||||
$dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
|
||||
|
||||
# If it's a MySQL connection, set some options.
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
# Set SQL_MODE and options for SHOW CREATE TABLE.
|
||||
# Get current, server SQL mode. Don't clobber this;
|
||||
# append our SQL mode to whatever is already set.
|
||||
# http://code.google.com/p/maatkit/issues/detail?id=801
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = $dbh->selectrow_array($sql);
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
$dbh->do($sql);
|
||||
|
||||
# Set character set and binmode on STDOUT.
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
$dbh->do($sql);
|
||||
}
|
||||
}
|
||||
};
|
||||
if ( !$dbh && $EVAL_ERROR ) {
|
||||
PTDEBUG && _d($EVAL_ERROR);
|
||||
if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
|
||||
die "Cannot connect to MySQL because the Perl DBD::mysql module is "
|
||||
. "not installed or not found. Run 'perl -MDBD::mysql' to see "
|
||||
. "the directories that Perl searches for DBD::mysql. If "
|
||||
@@ -361,12 +314,69 @@ sub get_dbh {
|
||||
. " RHEL/CentOS yum install perl-DBD-MySQL\n"
|
||||
. " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
|
||||
}
|
||||
elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
|
||||
PTDEBUG && _d('Going to try again without utf8 support');
|
||||
delete $defaults->{mysql_enable_utf8};
|
||||
}
|
||||
if ( !$tries ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# If it's a MySQL connection, set some options.
|
||||
if ( $cxn_string =~ m/mysql/i ) {
|
||||
my $sql;
|
||||
|
||||
# Set SQL_MODE and options for SHOW CREATE TABLE.
|
||||
# Get current, server SQL mode. Don't clobber this;
|
||||
# append our SQL mode to whatever is already set.
|
||||
# http://code.google.com/p/maatkit/issues/detail?id=801
|
||||
$sql = 'SELECT @@SQL_MODE';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
$sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
|
||||
. '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
|
||||
. ($sql_mode ? ",$sql_mode" : '')
|
||||
. '\'*/';
|
||||
PTDEBUG && _d($dbh, $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
|
||||
# Set character set and binmode on STDOUT.
|
||||
if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
|
||||
$sql = "/*!40101 SET NAMES $charset*/";
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
PTDEBUG && _d('Enabling charset for STDOUT');
|
||||
if ( $charset eq 'utf8' ) {
|
||||
binmode(STDOUT, ':utf8')
|
||||
or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
|
||||
}
|
||||
else {
|
||||
binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
|
||||
}
|
||||
}
|
||||
|
||||
if ( $self->prop('set-vars') ) {
|
||||
$sql = "SET " . $self->prop('set-vars');
|
||||
PTDEBUG && _d($dbh, ':', $sql);
|
||||
eval { $dbh->do($sql) };
|
||||
if ( $EVAL_ERROR ) {
|
||||
die $EVAL_ERROR;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PTDEBUG && _d('DBH info: ',
|
||||
$dbh,
|
||||
Dumper($dbh->selectrow_hashref(
|
||||
|
@@ -9,7 +9,7 @@ BEGIN {
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
use Test::More tests => 35;
|
||||
use Test::More tests => 37;
|
||||
|
||||
use DSNParser;
|
||||
use OptionParser;
|
||||
@@ -542,6 +542,30 @@ foreach my $password_comma ( @password_commas ) {
|
||||
test_password_comma_with_auto(@$password_comma);
|
||||
}
|
||||
|
||||
# #############################################################################
|
||||
# Bug 984915: SQL calls after creating the dbh aren't checked
|
||||
# #############################################################################
|
||||
|
||||
$dsn = $dp->parse('h=127.1,P=12345,u=msandbox,p=msandbox');
|
||||
my @opts = $dp->get_cxn_params($dsn);
|
||||
$opts[0] .= ";charset=garbage_eh";
|
||||
my ($out, undef) = full_output(sub { $dp->get_dbh(@opts, {}) });
|
||||
|
||||
like(
|
||||
$out,
|
||||
qr/\QUnknown character set/,
|
||||
"get_dbh dies withg an unknown charset"
|
||||
);
|
||||
|
||||
$dp->prop('set-vars', "time_zoen='UTC'");
|
||||
($out, undef) = full_output(sub { $dp->get_dbh($dp->get_cxn_params($dsn), {}) });
|
||||
|
||||
like(
|
||||
$out,
|
||||
qr/\QUnknown system variable 'time_zoen'/,
|
||||
"get_dbh dies withg an unknown charset"
|
||||
);
|
||||
|
||||
# #############################################################################
|
||||
# Done.
|
||||
# #############################################################################
|
||||
|
Reference in New Issue
Block a user