Removed unused modules.

This commit is contained in:
Daniel Nichter
2011-08-02 17:32:12 -06:00
parent f71eaa037a
commit 1a720f7c67
4 changed files with 0 additions and 702 deletions

View File

@@ -1,206 +0,0 @@
# This program is copyright 2011 Percona Inc.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307 USA.
# ###########################################################################
# ForeignKeyIterator package
# ###########################################################################
{
# Package: ForeignKeyIterator
# ForeignKeyIterator iterates from or to a table by its foreign key constraints.
# This is a special type of <SchemaIterator> with the same interface, so it
# can be used in place of a <SchemaIterator>, but internally it functions
# very differently. Whereas a <SchemaIterator> is a real iterator that only
# gets the next schema object when called, a ForeignKeyIterator slurps the
# given <SchemaIterator> so it can discover foreign key constraints.
package ForeignKeyIterator;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
# Sub: new
#
# Parameters:
# %args - Arguments
#
# Required Arguments:
# db - Database of tbl.
# tbl - Table to iterate from to its referenced tables.
# Schema - <Schema> object.
# SchemaIterator - <SchemaIterator> object created with Schema and
# keep_ddl=>true.
# TableParser - <TableParser> object.
# Quoter - <Quoter> object.
#
# Optional Arguments:
# reverse - Iterate in reverse, from referenced tables to tbl.
#
# Returns:
# ForeignKeyIterator object
sub new {
my ( $class, %args ) = @_;
my @required_args = qw(db tbl Schema SchemaIterator TableParser Quoter);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless $args{$arg};
}
MKDEBUG && _d('Reverse iteration:', $args{reverse} ? 'yes' : 'no');
my $self = {
%args,
};
return bless $self, $class;
}
# Sub: next_schema_object
# Return the next schema object or undef when no more schema objects.
#
# Returns:
# Hashref of schema object with at least a db and tbl keys, like
# (start code)
# {
# db => 'test',
# tbl => 'a',
# ddl => 'CREATE TABLE `a` ( ...',
# tbl_struct => <TableParser::parse()> hashref of parsed ddl,
# fk_struct => <TableParser::get_fks()> hashref of parsed fk constraints
# }
# (end code)
sub next_schema_object {
my ( $self ) = @_;
if ( !exists $self->{fk_refs} ) {
# The default code order is (childN, child1, parent), but the default
# user order is (parent, child1, childN). So the two are opposite.
# Thus for default user order we reverse code order, and for reverse
# user order we keep the default code order. Yes, it's a confusing
# double negative, but it can't be avoided.
my @fk_refs = $self->_get_fk_refs();
@fk_refs = reverse @fk_refs if !$self->{reverse};
MKDEBUG && _d("Foreign key table order:\n",
map { "$_->{db}.$_->{tbl}\n" } @fk_refs);
# Save the originals and then create a copy of them to return
# when called. If reset, then copy originals back to fk_refs.
$self->{original_fk_refs} = \@fk_refs;
$self->{fk_refs} = [@fk_refs]; # copy
}
my $schema_obj = shift @{$self->{fk_refs}};
MKDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl});
return $schema_obj;
}
sub reset {
my ( $self ) = @_;
$self->{fk_refs} = [ @{$self->{original_fk_refs}} ]; # copy
MKDEBUG && _d('ForeignKeyIterator reset');
return;
}
sub _get_fk_refs {
my ( $self ) = @_;
my $schema_itr = $self->{SchemaIterator};
my $tp = $self->{TableParser};
my $q = $self->{Quoter};
MKDEBUG && _d('Loading schema from SchemaIterator');
# First we need to load all schema objects from the iterator and
# parse any foreign key constraints.
SCHEMA_OBJECT:
while ( my $obj = $schema_itr->next_schema_object() ) {
my ($db, $tbl) = @{$obj}{qw(db tbl)};
if ( !$db || !$tbl ) {
die "No database or table name for schema object";
}
if ( !$obj->{ddl} ) {
# If the SchemaIterator obj was created with a dbh, this probably
# means that it was not also created with a MySQLDump obj.
die "No CREATE TABLE for $db.$tbl";
}
if ( !$obj->{tbl_struct} ) {
# This probably means that the SchemaIterator obj wasn't created
# with a TableParser obj.
die "No table structure for $db.$tbl";
}
my $fks = $tp->get_fks($obj->{ddl}, { database => $db });
if ( $fks && scalar values %$fks ) {
MKDEBUG && _d('Table', $db, $tbl, 'has foreign keys');
$obj->{fk_struct} = $fks;
foreach my $fk ( values %$fks ) {
my ($parent_db, $parent_tbl) = @{$fk->{parent_tbl}}{qw(db tbl)};
if ( !$parent_db ) {
MKDEBUG && _d('No fk parent table database,',
'assuming child table database', $tbl->{db});
$parent_db = $tbl->{db};
}
push @{$obj->{references}}, [$parent_db, $parent_tbl];
}
}
}
# Now we can recurse through the foreign key references, starting with
# the target db.tbl.
return $self->_recurse_fk_references(
$self->{Schema}->get_schema(),
$self->{db},
$self->{tbl},
);
}
sub _recurse_fk_references {
my ( $self, $schema, $db, $tbl, $seen ) = @_;
$seen ||= {};
if ( $seen && $seen->{"$db$tbl"}++ ) {
MKDEBUG && _d('Circular reference, already seen', $db, $tbl);
return;
}
MKDEBUG && _d('Recursing from', $db, $tbl);
my @fk_refs;
if ( $schema->{$db}->{$tbl}->{references} ) {
foreach my $refed_obj ( @{$schema->{$db}->{$tbl}->{references}} ) {
MKDEBUG && _d($db, $tbl, 'references', @$refed_obj);
push @fk_refs,
$self->_recurse_fk_references($schema, @$refed_obj, $seen);
}
}
MKDEBUG && _d('No more tables referenced by', $db, $tbl);
push @fk_refs, $schema->{$db}->{$tbl};
return @fk_refs;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
1;
}
# ###########################################################################
# End ForeignKeyIterator package
# ###########################################################################

View File

@@ -1,84 +0,0 @@
# This program is copyright 2008-2011 Percona Inc.
# Feedback and improvements are welcome.
#
# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation, version 2; OR the Perl Artistic License. On UNIX and similar
# systems, you can issue `man perlgpl' or `man perlartistic' to read these
# licenses.
#
# You should have received a copy of the GNU General Public License along with
# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
# Place, Suite 330, Boston, MA 02111-1307 USA.
# ###########################################################################
# ProcesslistAggregator package
# ###########################################################################
{
# Package: ProcesslistAggregator
# ProcesslistAggregator aggregates PROCESSLIST entires.
package ProcesslistAggregator;
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
sub new {
my ( $class, %args ) = @_;
my $self = {
undef_val => $args{undef_val} || 'NULL',
};
return bless $self, $class;
}
# Given an arrayref of processes ($proclist), returns an hashref of
# time and counts aggregates for User, Host, db, Command and State.
# See t/ProcesslistAggregator.t for examples.
# The $proclist arg is usually the return val of:
# $dbh->selectall_arrayref('SHOW PROCESSLIST', { Slice => {} } );
sub aggregate {
my ( $self, $proclist ) = @_;
my $aggregate = {};
foreach my $proc ( @{$proclist} ) {
foreach my $field ( keys %{ $proc } ) {
# Don't aggregate these fields.
next if $field eq 'Id';
next if $field eq 'Info';
next if $field eq 'Time';
# Format the field's value a little.
my $val = $proc->{ $field };
$val = $self->{undef_val} if !defined $val;
$val = lc $val if ( $field eq 'Command' || $field eq 'State' );
$val =~ s/:.*// if $field eq 'Host';
my $time = $proc->{Time};
$time = 0 if !$time || $time eq 'NULL';
# Do this last or else $proc->{$field} won't match.
$field = lc $field;
$aggregate->{ $field }->{ $val }->{time} += $time;
$aggregate->{ $field }->{ $val }->{count} += 1;
}
}
return $aggregate;
}
sub _d {
my ($package, undef, $line) = caller 0;
@_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
map { defined $_ ? $_ : 'undef' }
@_;
print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
}
1;
}
# ###########################################################################
# End ProcesslistAggregator package
# ###########################################################################

View File

@@ -1,256 +0,0 @@
#!/usr/bin/perl
BEGIN {
die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
};
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More tests => 7;
use Schema;
use SchemaIterator;
use ForeignKeyIterator;
use FileIterator;
use Quoter;
use TableParser;
use DSNParser;
use OptionParser;
use PerconaTest;
use constant MKDEBUG => $ENV{MKDEBUG} || 0;
use Data::Dumper;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;
my $q = new Quoter();
my $tp = new TableParser(Quoter => $q);
my $fi = new FileIterator();
my $o = new OptionParser(description => 'SchemaIterator');
$o->get_specs("$trunk/bin/pt-table-checksum");
my $in = "$trunk/t/lib/samples/ForeignKeyIterator/";
my $out = "t/lib/samples/ForeignKeyIterator/";
sub test_fki {
my ( %args ) = @_;
my @required_args = qw(files db tbl test_name result);
foreach my $arg ( @required_args ) {
die "I need a $arg argument" unless defined $args{$arg};
}
my $fki = $args{fki};
if ( !$fki ) {
@ARGV = $args{filters} ? @{$args{filters}} : ();
$o->get_opts();
my $file_itr = $fi->get_file_itr(@{$args{files}});
my $schema = new Schema();
my $si = new SchemaIterator(
file_itr => $file_itr,
OptionParser => $o,
Quoter => $q,
TableParser => $tp,
keep_ddl => 1,
Schema => $schema,
);
$fki = new ForeignKeyIterator(
db => $args{db},
tbl => $args{tbl},
reverse => $args{reverse},
SchemaIterator => $si,
Quoter => $q,
TableParser => $tp,
Schema => $schema,
);
}
my @got_objs;
while ( my $obj = $fki->next_schema_object() ) {
my %got = (
db => $obj->{db},
tbl => $obj->{tbl},
);
$got{fk_struct} = $obj->{fk_struct} if $args{fk_struct};
push @got_objs, \%got;
}
is_deeply(
\@got_objs,
$args{result},
$args{test_name},
) or print Dumper(\@got_objs);
if ( $args{stop} ) {
die "Stopped after test $args{test_name}";
}
return $fki;
}
test_fki(
test_name => 'Iterate from address (fktbls001.sql)',
files => ["$in/fktbls001.sql"],
db => 'test',
tbl => 'address',
result => [
{
db => 'test',
tbl => 'address',
},
{
db => 'test',
tbl => 'city',
},
{
db => 'test',
tbl => 'country',
},
],
);
test_fki(
test_name => 'Iterate from data (fktbls002.sql)',
files => ["$in/fktbls002.sql"],
db => 'test',
tbl => 'data',
fk_struct => 1,
result => [
{
db => 'test',
tbl => 'data',
fk_struct => {
data_ibfk_1 => {
name => 'data_ibfk_1',
colnames => '`data_report`',
cols => [ 'data_report' ],
parent_tbl => {db=>'test', tbl=>'data_report'},
parent_tblname => '`test`.`data_report`',
parent_cols => [ 'id' ],
parent_colnames => '`id`',
ddl => 'CONSTRAINT `data_ibfk_1` FOREIGN KEY (`data_report`) REFERENCES `data_report` (`id`)',
},
data_ibfk_2 => {
name => 'data_ibfk_2',
colnames => '`entity`',
cols => [ 'entity' ],
parent_tbl => {db=>'test', tbl=>'entity'},
parent_tblname => '`test`.`entity`',
parent_cols => [ 'id' ],
parent_colnames => '`id`',
ddl => 'CONSTRAINT `data_ibfk_2` FOREIGN KEY (`entity`) REFERENCES `entity` (`id`)',
},
},
},
{
db => 'test',
tbl => 'entity',
fk_struct => undef,
},
{
db => 'test',
tbl => 'data_report',
fk_struct => undef,
},
],
);
# There is a circular reference between store and staff, but the
# code should handle it. See http://dev.mysql.com/doc/sakila/en/sakila.html
# for the entire sakila db table structure.
test_fki(
test_name => 'Iterate from sakila.customer',
files => ["$trunk/t/lib/samples/mysqldump-no-data/all-dbs.txt"],
db => 'sakila',
tbl => 'customer',
result => [
{ db => 'sakila', tbl => 'customer' },
{ db => 'sakila', tbl => 'store' },
{ db => 'sakila', tbl => 'staff' },
{ db => 'sakila', tbl => 'address' },
{ db => 'sakila', tbl => 'city' },
{ db => 'sakila', tbl => 'country' },
],
);
test_fki(
test_name => 'Iterate from sakila.customer reversed',
files => ["$trunk/t/lib/samples/mysqldump-no-data/all-dbs.txt"],
db => 'sakila',
tbl => 'customer',
reverse => 1,
result => [
{ db => 'sakila', tbl => 'country' },
{ db => 'sakila', tbl => 'city' },
{ db => 'sakila', tbl => 'address' },
{ db => 'sakila', tbl => 'staff' },
{ db => 'sakila', tbl => 'store' },
{ db => 'sakila', tbl => 'customer' },
],
);
# ############################################################################
# Can we reset and re-iterate?
# ############################################################################
my $fki1 = test_fki(
test_name => 'Iteration 1',
files => ["$in/fktbls001.sql"],
db => 'test',
tbl => 'address',
result => [
{
db => 'test',
tbl => 'address',
},
{
db => 'test',
tbl => 'city',
},
{
db => 'test',
tbl => 'country',
},
],
);
$fki1->reset();
my $fki2 = test_fki(
test_name => 'Iteration 2',
files => '', # hack to satisfy required args,
db => '', # these also insure that the given
tbl => '', # fki is reused...
fki => $fki1,
result => [
{
db => 'test',
tbl => 'address',
},
{
db => 'test',
tbl => 'city',
},
{
db => 'test',
tbl => 'country',
},
],
);
is(
$fki1,
$fki2,
'Reset and reused ForeignKeyIterator'
);
# #############################################################################
# Done.
# #############################################################################
exit;

View File

@@ -1,156 +0,0 @@
#!/usr/bin/perl
BEGIN {
die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
};
use strict;
use warnings FATAL => 'all';
use English qw(-no_match_vars);
use Test::More tests => 7;
use ProcesslistAggregator;
use TextResultSetParser;
use DSNParser;
use MySQLDump;
use Quoter;
use TableParser;
use PerconaTest;
my $r = new TextResultSetParser();
my $apl = new ProcesslistAggregator();
isa_ok($apl, 'ProcesslistAggregator');
sub test_aggregate {
my ($file, $expected, $msg) = @_;
my $proclist = $r->parse( load_file($file) );
is_deeply(
$apl->aggregate($proclist),
$expected,
$msg
);
return;
}
test_aggregate(
't/lib/samples/pl/recset001.txt',
{
command => { query => { time => 0, count => 1 } },
db => { '' => { time => 0, count => 1 } },
user => { msandbox => { time => 0, count => 1 } },
state => { '' => { time => 0, count => 1 } },
host => { localhost => { time => 0, count => 1 } },
},
'Aggregate basic processlist'
);
test_aggregate(
't/lib/samples/pl/recset004.txt',
{
db => {
NULL => { count => 1, time => 0 },
forest => { count => 50, time => 533 }
},
user => {
user1 => { count => 50, time => 533 },
root => { count => 1, time => 0 }
},
host => {
'0.1.2.11' => { count => 21, time => 187 },
'0.1.2.12' => { count => 25, time => 331 },
'0.1.2.21' => { count => 4, time => 15 },
localhost => { count => 1, time => 0 }
},
state => {
locked => { count => 24, time => 84 },
preparing => { count => 26, time => 449 },
null => { count => 1, time => 0 }
},
command => { query => { count => 51, time => 533 } }
},
'Sample with 51 processes',
);
my $aggregate = $apl->aggregate($r->parse(load_file('t/lib/samples/pl/recset003.txt')));
cmp_ok(
$aggregate->{db}->{NULL}->{count},
'==',
3,
'113 proc sample: 3 NULL db'
);
cmp_ok(
$aggregate->{db}->{happy}->{count},
'==',
110,
'113 proc sample: 110 happy db'
);
# #############################################################################
# Issue 777: ProcesslistAggregator undef bug
# #############################################################################
$r = new TextResultSetParser(
value_for => {
'' => undef,
}
);
my $row = $r->parse(load_file('t/lib/samples/pl/recset007.txt'));
is_deeply(
$row,
[
{
Command => undef,
Host => undef,
Id => '9',
Info => undef,
State => undef,
Time => undef,
User => undef,
db => undef
}
],
'Pathological undef row'
);
is_deeply(
$apl->aggregate($row),
{
command => {
null => {
count => 1,
time => 0
}
},
db => {
NULL => {
count => 1,
time => 0
}
},
host => {
NULL => {
count => 1,
time => 0
}
},
state => {
null => {
count => 1,
time => 0
}
},
user => {
NULL => {
count => 1,
time => 0
}
},
},
'Pathological undef row aggregate'
);
exit;