App-Repository
view release on metacpan or search on metacpan
lib/App/Repository/MySQL.pm view on Meta::CPAN
}
$sql .= ($rownum < $#$rows) ? "),\n" : ")\n";
}
}
else { # if $row is a HASH or OBJECT ...
for (my $rownum = 0; $rownum <= $#$rows; $rownum++) {
$row = $rows->[$rownum];
for ($colnum = 0; $colnum <= $#$cols; $colnum++) {
$col = $cols->[$colnum];
$value = $row->{$col};
if (!defined $value) {
$value = "NULL";
}
else {
$quoted = (defined $column_defs->{$col}{quoted}) ? ($column_defs->{$col}{quoted}) : ($value !~ /^-?[0-9.]+$/);
if ($quoted) {
$value = $dbh->quote($value);
}
}
if ($column_defs->{$col}{dbexpr_update}) {
$value = sprintf($column_defs->{$col}{dbexpr_update}, $value);
}
$sql .= ($colnum == 0) ? " ($value" : ", $value";
}
$sql .= ($rownum < $#$rows) ? "),\n" : ")\n";
}
}
if (!$options->{replace} && $options->{update}) {
my $update = $options->{update};
$sql .= "on duplicate key update";
my $first_update_column = 1;
for ($colnum = 0; $colnum <= $#$cols; $colnum++) {
$col = $cols->[$colnum];
if (!ref($update) || $update->{$col}) {
$sql .= "," if (!$first_update_column);
$first_update_column = 0;
$sql .= "\n $col = values($col)";
}
}
$sql .= "\n";
}
&App::sub_exit($sql) if ($App::trace);
$sql;
}
# $nrows = $rep->_insert_rows ($table, \@cols, \@rows);
sub _insert_rows {
&App::sub_entry if ($App::trace);
my ($self, $table, $cols, $rows, $options) = @_;
$self->{error} = "";
my ($sql, $retval, $nrows_this_insert);
my $dbh = $self->{dbh};
return 0 if (!defined $dbh);
my $nrows = 0;
my $ok = 1;
my $context_options = $self->{context}{options};
my $debug_sql = $context_options->{debug_sql};
my $explain_sql = $context_options->{explain_sql};
my ($timer, $elapsed_time);
if ($debug_sql) {
$timer = $self->_get_timer();
}
my $rows_ref = ref($rows);
if ($rows_ref eq "ARRAY") {
my $maxrows = $options->{maxrows} || 100;
my $rownum = 0;
my (@current_rows, $rownum2);
while ($rownum <= $#$rows) {
$rownum2 = $rownum + $maxrows - 1;
$rownum2 = $#$rows if ($rownum2 > $#$rows);
@current_rows = @{$rows}[($rownum .. $rownum2)];
$nrows_this_insert = $#current_rows + 1;
$sql = $self->_mk_insert_rows_sql($table, $cols, \@current_rows, $options);
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: _insert_rows()\n";
print $App::DEBUG_FILE $sql;
}
### TODO: make this work with regex for retry
$retval = $dbh->do($sql);
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] $DBI::errstr\n";
print $App::DEBUG_FILE "\n";
}
# The MySQL "insert ... on duplicate key update ..." statement returns 2 rows affected
# when the insert gets a collision and causes an update. So we have to make this
# adjustment. I don't know if it affects the "replace ..." statement in a similar way,
# but I figure this can't hurt.
if ($options->{update} || $options->{replace}) {
if ($retval > $nrows_this_insert) {
$retval = $nrows_this_insert;
}
}
$nrows += $retval;
$rownum += $maxrows;
}
if ($nrows != $#$rows + 1) {
$ok = 0;
}
$self->{numrows} = $nrows;
}
else {
my ($fh);
if (!$rows_ref) {
my $file = $rows; # assume it is a file name
open(App::Repository::MySQL::FILE, $file) || die "Unable to open $file for reading: $!";
$fh = \*App::Repository::MySQL::FILE;
}
else {
$fh = $rows; # assume it is a file handle
}
$rows = []; # we will be refilling this buffer
my %options = ( %$options ); # make a copy so it can be modified
$options{maxrows} = 100;
$nrows = 0;
while (1) {
$rows = $self->_read_rows_from_file($fh, $cols, \%options);
last if ($#$rows == -1);
$sql = $self->_mk_insert_rows_sql($table, $cols, $rows, $options);
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: _insert_rows()\n";
print $App::DEBUG_FILE $sql;
}
### TODO: make this work with regex for retry
$retval = $dbh->do($sql);
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] $DBI::errstr\n";
print $App::DEBUG_FILE "\n";
}
$nrows += $retval;
if ($retval != $#$rows + 1) {
$ok = 0;
last;
}
}
$self->{numrows} = $nrows;
if (!$rows_ref) {
close(App::Repository::MySQL::FILE);
}
}
if ($debug_sql) {
$elapsed_time = $self->_read_timer($timer);
print $App::DEBUG_FILE "DEBUG_SQL: total rows [$nrows] ($elapsed_time sec)\n";
}
$self->{sql} = $sql;
$self->{numrows} = $nrows;
&App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
###################################################################
# This routine was written because a reliable data load method is
# needed for MySQL 5.1.14+. There are instabilities in this beta
# version of software that cause "load data local infile" and
# extended inserts to both hang the server. Now I am trying to
# write the extended inserts out to a file and load it with the
# "mysql" client program.
###################################################################
# $nrows = $rep->insert_rows_mysql ($table, \@cols, \@rows);
sub insert_rows_mysql {
&App::sub_entry if ($App::trace);
my ($self, $table, $cols, $rows, $options) = @_;
$self->{error} = "";
my ($sql, $retval);
my $dbh = $self->{dbh};
return 0 if (!defined $dbh);
my $nrows = 0;
my $ok = 1;
my $context_options = $self->{context}{options};
my $debug_sql = $context_options->{debug_sql};
my $explain_sql = $context_options->{explain_sql};
my ($timer, $elapsed_time);
if ($debug_sql) {
$timer = $self->_get_timer();
}
my $rows_ref = ref($rows);
if ($rows_ref eq "ARRAY") {
$sql = $self->_mk_insert_rows_sql($table, $cols, $rows, $options);
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: _insert_rows()\n";
print $App::DEBUG_FILE $sql;
}
### TODO: make this work with regex for retry
$retval = $dbh->do($sql);
if ($debug_sql) {
print $App::DEBUG_FILE "DEBUG_SQL: retval [$retval] $DBI::errstr\n";
print $App::DEBUG_FILE "\n";
}
$nrows = $retval;
$self->{numrows} = $nrows;
if ($retval != $#$rows + 1) {
$ok = 0;
}
}
else {
my ($fh, $sqlfh);
my $file = $rows; # $rows must be a file name
open(App::Repository::MySQL::FILE, $file) || die "Unable to open $file for reading: $!";
$fh = \*App::Repository::MySQL::FILE;
open(App::Repository::MySQL::SQL, "| gzip > $file.sql.gz") || die "Unable to open $file.sql.gz for writing: $!";
$sqlfh = \*App::Repository::MySQL::SQL;
$rows = []; # we will be refilling this buffer
my %options = ( %$options ); # make a copy so it can be modified
$options{maxrows} = 100;
$nrows = 0;
while (1) {
$rows = $self->_read_rows_from_file($fh, $cols, \%options);
last if ($#$rows == -1);
$sql = $self->_mk_insert_rows_sql($table, $cols, $rows, $options);
print $sqlfh $sql, ";\n";
$nrows += ($#$rows + 1);
}
if (!$rows_ref) {
close(App::Repository::MySQL::FILE);
close(App::Repository::MySQL::SQL);
}
my $cmd = "zcat $file.sql.gz | mysql --host=$self->{dbhost} --user=$self->{dbuser} --password=$self->{dbpass} $self->{dbname}";
$retval = system($cmd);
if ($retval) {
$nrows = 0;
}
$self->{numrows} = $nrows;
}
$self->{sql} = $sql;
$self->{numrows} = $nrows;
&App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
sub _load_table_key_metadata {
&App::sub_entry if ($App::trace);
my ($self, $table) = @_;
lib/App/Repository/MySQL.pm view on Meta::CPAN
Sample Usage:
$rep->import_rows("usr","usr.dat");
# root:x:0:0:root:/root:/bin/bash
$rep->import_rows("usr", "/etc/passwd" ,{
field_sep => ":",
columns => [ "username", "password", "uid", "gid", "comment", "home_directory", "shell" ],
});
=cut
#SYNTAX:
#LOAD DATA [LOW_PRIORITY | CONCURRENT] [LOCAL] INFILE 'file_name.txt'
# [REPLACE | IGNORE]
# INTO TABLE tbl_name
# [FIELDS
# [TERMINATED BY 'string']
# [[OPTIONALLY] ENCLOSED BY 'char']
# [ESCAPED BY 'char' ]
# ]
# [LINES
# [STARTING BY 'string']
# [TERMINATED BY 'string']
# ]
# [IGNORE number LINES]
# [(col_name_or_user_var,...)]
# [SET col_name = expr,...)]
sub import_rows {
&App::sub_entry if ($App::trace);
my ($self, $table, $columns, $file, $options) = @_;
$columns = $self->_get_default_columns($table) if (!$columns);
my $nrows = 0;
my $import_method = $options->{import_method} || $self->{import_method} || "";
if ($import_method eq "basic") {
$nrows = $self->SUPER::import_rows($table, $columns, $file, $options);
}
elsif ($import_method eq "insert") {
$nrows = $self->insert_rows($table, $columns, $file, $options);
}
elsif ($import_method eq "insert_mysql") {
$nrows = $self->insert_rows_mysql($table, $columns, $file, $options);
}
else {
my $local = $options->{local};
$local = 1 if (!defined $local);
my $local_modifier = $local ? " local" : "";
my $sql = "load data$local_modifier infile '$file' into table $table";
if ($options->{field_sep} || $options->{field_quote} || $options->{field_escape}) {
$sql .= "\nfields";
$sql .= "\n terminated by '$options->{field_sep}'" if ($options->{field_sep});
$sql .= "\n optionally enclosed by '$options->{field_quote}'" if ($options->{field_quote});
$sql .= "\n escaped by '$options->{field_escape}'" if ($options->{field_escape});
}
$sql .= "\n(" . join(",", @$columns) . ")\n";
my $context_options = $self->{context}{options};
my $debug_sql = $context_options->{debug_sql};
my ($timer, $elapsed_time);
if ($debug_sql) {
$timer = $self->_get_timer();
print $App::DEBUG_FILE "DEBUG_SQL: import_rows()\n";
print $App::DEBUG_FILE $sql;
}
eval {
$nrows = $self->{dbh}->do($sql);
};
if ($debug_sql) {
$elapsed_time = $self->_read_timer($timer);
print $App::DEBUG_FILE "DEBUG_SQL: import_rows=[$nrows] ($elapsed_time sec) $DBI::errstr : $@\n";
}
die $@ if ($@);
}
&App::sub_exit($nrows) if ($App::trace);
return($nrows);
}
#############################################################################
# export_rows()
#############################################################################
=head2 export_rows()
* Signature: $rep->export_rows($table, $file);
* Signature: $rep->export_rows($table, $file, $options);
* Param: $table string
* Param: $file string
* Param: $options named
* Param: columns ARRAY names of columns of the fields in the file
* Param: export_method string [basic=invokes generic superclass to do work]
* Param: field_sep char character which separates the fields in the file (can by "\t")
* Param: field_quote char character which optionally encloses the fields in the file (i.e. '"')
* Param: field_escape char character which escapes the quote chars within quotes (i.e. "\")
* Return: void
* Throws: App::Exception::Repository
* Since: 0.01
Sample Usage:
$rep->export_rows("usr","usr.dat");
# root:x:0:0:root:/root:/bin/bash
$rep->export_rows("usr", "passwd.dat" ,{
field_sep => ":",
columns => [ "username", "password", "uid", "gid", "comment", "home_directory", "shell" ],
});
=cut
#SELECT ... INTO OUTFILE is the complement of LOAD DATA INFILE; the syntax for the
#export_options part of the statement consists of the same FIELDS and LINES clauses
#that are used with the LOAD DATA INFILE statement.
#See Section 13.2.5, .LOAD DATA INFILE Syntax..
#SELECT
# [ALL | DISTINCT | DISTINCTROW ]
# [HIGH_PRIORITY]
# [STRAIGHT_JOIN]
# [SQL_SMALL_RESULT] [SQL_BIG_RESULT] [SQL_BUFFER_RESULT]
# [SQL_CACHE | SQL_NO_CACHE] [SQL_CALC_FOUND_ROWS]
# select_expr, ...
# [INTO OUTFILE 'file_name' export_options
# | INTO DUMPFILE 'file_name']
# [FROM table_references
# [WHERE where_definition]
# [GROUP BY {col_name | expr | position}
# [ASC | DESC], ... [WITH ROLLUP]]
# [HAVING where_definition]
# [ORDER BY {col_name | expr | position}
# [ASC | DESC] , ...]
# [LIMIT {[offset,] row_count | row_count OFFSET offset}]
# [PROCEDURE procedure_name(argument_list)]
# [FOR UPDATE | LOCK IN SHARE MODE]]
sub export_rows {
&App::sub_entry if ($App::trace);
my ($self, $table, $params, $file, $options) = @_;
if ($options->{export_method} && $options->{export_method} eq "basic") {
$self->SUPER::export_rows($table, $file, $options);
}
else {
my $columns = $options->{columns} || $self->{table}{$table}{columns};
my $where_clause = $self->_mk_where_clause($table, $params, $options);
my $sql = "select\n " . join(",\n ", @$columns);
$sql .= "\n$where_clause" if ($where_clause);
$sql .= "\ninto outfile '$file'";
if ($options->{field_sep} || $options->{field_quote} || $options->{field_escape}) {
$sql .= "\nfields";
$sql .= "\n terminated by '$options->{field_sep}'" if ($options->{field_sep});
$sql .= "\n optionally enclosed by '$options->{field_quote}'" if ($options->{field_quote});
$sql .= "\n escaped by '$options->{field_escape}'" if ($options->{field_escape});
}
$sql .= "\n";
my $context_options = $self->{context}{options};
my $debug_sql = $context_options->{debug_sql};
my ($timer, $elapsed_time);
if ($debug_sql) {
$timer = $self->_get_timer();
print $App::DEBUG_FILE "DEBUG_SQL: export_rows()\n";
print $App::DEBUG_FILE $sql;
}
my ($retval);
eval {
$retval = $self->{dbh}->do($sql);
};
if ($debug_sql) {
$elapsed_time = $self->_read_timer($timer);
print $App::DEBUG_FILE "DEBUG_SQL: export_rows=[$retval] ($elapsed_time sec) $DBI::errstr : $@\n";
}
}
&App::sub_exit() if ($App::trace);
}
#+----+-------------+-------+-------+-------------------------------------+-------------------+---------+-------------+------+-------+
#| id | select_type | table | type | possible_keys | key | key_len | ref | rows | Extra |
#+----+-------------+-------+-------+-------------------------------------+-------------------+---------+-------------+------+-------+
#| 1 | SIMPLE | t1 | const | hotel_prop_ds_ak1,hotel_prop_ds_ie1 | hotel_prop_ds_ak1 | 9 | const,const | 1 | |
#+----+-------------+-------+-------+-------------------------------------+-------------------+---------+-------------+------+-------+
sub explain_sql {
my ($self, $sql) = @_;
my $dbh = $self->{dbh};
# NOTE: MySQL "explain" only works for "select".
# We convert "update" and "delete" to "select" to explain them.
if (defined $dbh) {
if ($sql =~ s/^delete/select */is) {
# do nothing
}
elsif ($sql =~ s/^update\s+(.*)\sset\s+.*\swhere/select * from $1\nwhere/is) {
# do nothing
}
if ($sql =~ /^select/i) {
my ($rows, $posskeys, $key, $keylen);
eval {
$rows = $dbh->selectall_arrayref("explain $sql");
};
print $App::DEBUG_FILE "EXPLAIN_SQL: $DBI::errstr\n";
if ($rows) {
print $App::DEBUG_FILE "+----+-------------+----------------------+-------+----------------------+---------+----------+\n";
print $App::DEBUG_FILE "| id | select_type | table | type | key | key_len | rows |\n";
print $App::DEBUG_FILE "+----+-------------+----------------------+-------+----------------------+---------+----------+\n";
foreach my $row (@$rows) {
$key = $row->[5];
$keylen = length($key);
if ($keylen > 21) {
$key = substr($key,0,12) . ".." . substr($key,$keylen-7,7);
}
printf($App::DEBUG_FILE "|%3s | %-12s| %-21s| %-6s| %-21s|%8d |%9d | %s\n", @{$row}[0,1,2,3], $key, @{$row}[6,8]);
}
print $App::DEBUG_FILE "+----+----------------------------------------------------------------------------------------+\n";
print $App::DEBUG_FILE "| id | possible_keys/ref/extra\n";
print $App::DEBUG_FILE "+----+----------------------------------------------------------------------------------------+\n";
foreach my $row (@$rows) {
$key = $row->[5];
$posskeys = $row->[4];
$posskeys =~ s/\b($key)\b/[$key]/;
printf($App::DEBUG_FILE "|%3s | posskeys: %s\n", $row->[0], $posskeys);
printf($App::DEBUG_FILE "|%3s | ref: %s; extra: %s\n", @{$row}[0,7,9]);
}
print $App::DEBUG_FILE "+---------------------------------------------------------------------------------------------+\n";
}
}
else {
$sql =~ /^\s*(\S*)/;
print $App::DEBUG_FILE "EXPLAIN_SQL: Can't explain $1 statement.\n";
}
}
( run in 0.333 second using v1.01-cache-2.11-cpan-adec679a428 )