From 55bb01bb6e0f2971f714dea62cdc919e6c16db8f Mon Sep 17 00:00:00 2001 From: Brian Fraser Date: Wed, 13 Mar 2013 11:50:08 -0300 Subject: [PATCH] Removed pt-query-advisor --- bin/pt-query-advisor | 9483 ----------------- lib/QueryAdvisorRules.pm | 687 -- t/lib/samples/bug_823431.log | 88 - t/pt-query-advisor/checks.t | 166 - t/pt-query-advisor/get_create_table.t | 76 - t/pt-query-advisor/group_by.t | 49 - t/pt-query-advisor/ignore_rules.t | 31 - t/pt-query-advisor/parse_logs.t | 67 - t/pt-query-advisor/review.t | 99 - t/pt-query-advisor/samples/cla-006-01.txt | 10 - t/pt-query-advisor/samples/cla-007-01.txt | 9 - .../samples/group-by-none-001.txt | 35 - .../samples/group-by-query-id-001.txt | 22 - .../samples/group-by-rule-id-001.txt | 18 - t/pt-query-advisor/samples/issue-950.sql | 11 - t/pt-query-advisor/samples/joi-001-002-01.txt | 22 - t/pt-query-advisor/samples/lit-001.txt | 10 - t/pt-query-advisor/samples/lit-002-01.txt | 10 - t/pt-query-advisor/samples/lit-002-02.txt | 8 - t/pt-query-advisor/samples/qry-001-01.txt | 9 - t/pt-query-advisor/samples/qry-001-02.txt | 9 - t/pt-query-advisor/samples/review001.txt | 9 - t/pt-query-advisor/samples/review002.txt | 13 - t/pt-query-advisor/samples/slow001.txt | 14 - t/pt-query-advisor/samples/sub-001-01.txt | 10 - .../samples/tbl-001-01-ignored.txt | 8 - t/pt-query-advisor/samples/tbl-001-01.txt | 9 - t/pt-query-advisor/samples/tbl-001-02.txt | 9 - t/pt-query-advisor/samples/tbl-002-01.txt | 11 - t/pt-query-advisor/samples/tbl-002-02.txt | 10 - 30 files changed, 11012 deletions(-) delete mode 100755 bin/pt-query-advisor delete mode 100644 lib/QueryAdvisorRules.pm delete mode 100644 t/lib/samples/bug_823431.log delete mode 100644 t/pt-query-advisor/checks.t delete mode 100644 t/pt-query-advisor/get_create_table.t delete mode 100644 t/pt-query-advisor/group_by.t delete mode 100644 t/pt-query-advisor/ignore_rules.t delete mode 100644 t/pt-query-advisor/parse_logs.t delete mode 100644 t/pt-query-advisor/review.t delete mode 100644 t/pt-query-advisor/samples/cla-006-01.txt delete mode 100644 t/pt-query-advisor/samples/cla-007-01.txt delete mode 100644 t/pt-query-advisor/samples/group-by-none-001.txt delete mode 100644 t/pt-query-advisor/samples/group-by-query-id-001.txt delete mode 100644 t/pt-query-advisor/samples/group-by-rule-id-001.txt delete mode 100644 t/pt-query-advisor/samples/issue-950.sql delete mode 100644 t/pt-query-advisor/samples/joi-001-002-01.txt delete mode 100644 t/pt-query-advisor/samples/lit-001.txt delete mode 100644 t/pt-query-advisor/samples/lit-002-01.txt delete mode 100644 t/pt-query-advisor/samples/lit-002-02.txt delete mode 100644 t/pt-query-advisor/samples/qry-001-01.txt delete mode 100644 t/pt-query-advisor/samples/qry-001-02.txt delete mode 100644 t/pt-query-advisor/samples/review001.txt delete mode 100644 t/pt-query-advisor/samples/review002.txt delete mode 100644 t/pt-query-advisor/samples/slow001.txt delete mode 100644 t/pt-query-advisor/samples/sub-001-01.txt delete mode 100644 t/pt-query-advisor/samples/tbl-001-01-ignored.txt delete mode 100644 t/pt-query-advisor/samples/tbl-001-01.txt delete mode 100644 t/pt-query-advisor/samples/tbl-001-02.txt delete mode 100644 t/pt-query-advisor/samples/tbl-002-01.txt delete mode 100644 t/pt-query-advisor/samples/tbl-002-02.txt diff --git a/bin/pt-query-advisor b/bin/pt-query-advisor deleted file mode 100755 index 4fcc4bba..00000000 --- a/bin/pt-query-advisor +++ /dev/null @@ -1,9483 +0,0 @@ -#!/usr/bin/env perl - -# This program is part of Percona Toolkit: http://www.percona.com/software/ -# See "COPYRIGHT, LICENSE, AND WARRANTY" at the end of this file for legal -# notices and disclaimers. - -use strict; -use warnings FATAL => 'all'; - -# This tool is "fat-packed": most of its dependent modules are embedded -# in this file. Setting %INC to this file for each module makes Perl aware -# of this so it will not try to load the module from @INC. See the tool's -# documentation for a full list of dependencies. -BEGIN { - $INC{$_} = __FILE__ for map { (my $pkg = "$_.pm") =~ s!::!/!g; $pkg } (qw( - Percona::Toolkit - Lmo::Utils - Lmo::Meta - Lmo::Object - Lmo::Types - Lmo - DSNParser - OptionParser - Quoter - SlowLogParser - GeneralLogParser - QueryParser - QueryRewriter - Transformers - Daemon - Advisor - AdvisorRules - QueryAdvisorRules - PodParser - SQLParser - TableParser - ReportFormatter - HTTPMicro - VersionCheck - )); -} - -# ########################################################################### -# Percona::Toolkit package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Percona/Toolkit.pm -# t/lib/Percona/Toolkit.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Percona::Toolkit; -our $VERSION = '2.1.8'; - -1; -} -# ########################################################################### -# End Percona::Toolkit package -# ########################################################################### - -# ########################################################################### -# Lmo::Utils package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Lmo/Utils.pm -# t/lib/Lmo/Utils.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Lmo::Utils; -use strict; -use warnings qw( FATAL all ); -require Exporter; -our (@ISA, @EXPORT, @EXPORT_OK); - -BEGIN { - @ISA = qw(Exporter); - @EXPORT = @EXPORT_OK = qw(_install_coderef _unimport_coderefs _glob_for _stash_for); -} - -{ - no strict 'refs'; - sub _glob_for { - return \*{shift()} - } - - sub _stash_for { - return \%{ shift() . "::" }; - } -} - -sub _install_coderef { - my ($to, $code) = @_; - - return *{ _glob_for $to } = $code; -} - -sub _unimport_coderefs { - my ($target, @names) = @_; - return unless @names; - my $stash = _stash_for($target); - foreach my $name (@names) { - if ($stash->{$name} and defined(&{$stash->{$name}})) { - delete $stash->{$name}; - } - } -} - -1; -} -# ########################################################################### -# End Lmo::Utils package -# ########################################################################### - -# ########################################################################### -# Lmo::Meta package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Lmo/Meta.pm -# t/lib/Lmo/Meta.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Lmo::Meta; -use strict; -use warnings qw( FATAL all ); - -my %metadata_for; - -sub new { - my $class = shift; - return bless { @_ }, $class -} - -sub metadata_for { - my $self = shift; - my ($class) = @_; - - return $metadata_for{$class} ||= {}; -} - -sub class { shift->{class} } - -sub attributes { - my $self = shift; - return keys %{$self->metadata_for($self->class)} -} - -sub attributes_for_new { - my $self = shift; - my @attributes; - - my $class_metadata = $self->metadata_for($self->class); - while ( my ($attr, $meta) = each %$class_metadata ) { - if ( exists $meta->{init_arg} ) { - push @attributes, $meta->{init_arg} - if defined $meta->{init_arg}; - } - else { - push @attributes, $attr; - } - } - return @attributes; -} - -1; -} -# ########################################################################### -# End Lmo::Meta package -# ########################################################################### - -# ########################################################################### -# Lmo::Object package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Lmo/Object.pm -# t/lib/Lmo/Object.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Lmo::Object; - -use strict; -use warnings qw( FATAL all ); - -use Carp (); -use Scalar::Util qw(blessed); - -use Lmo::Meta; -use Lmo::Utils qw(_glob_for); - -sub new { - my $class = shift; - my $args = $class->BUILDARGS(@_); - - my $class_metadata = Lmo::Meta->metadata_for($class); - - my @args_to_delete; - while ( my ($attr, $meta) = each %$class_metadata ) { - next unless exists $meta->{init_arg}; - my $init_arg = $meta->{init_arg}; - - if ( defined $init_arg ) { - $args->{$attr} = delete $args->{$init_arg}; - } - else { - push @args_to_delete, $attr; - } - } - - delete $args->{$_} for @args_to_delete; - - for my $attribute ( keys %$args ) { - if ( my $coerce = $class_metadata->{$attribute}{coerce} ) { - $args->{$attribute} = $coerce->($args->{$attribute}); - } - if ( my $isa_check = $class_metadata->{$attribute}{isa} ) { - my ($check_name, $check_sub) = @$isa_check; - $check_sub->($args->{$attribute}); - } - } - - while ( my ($attribute, $meta) = each %$class_metadata ) { - next unless $meta->{required}; - Carp::confess("Attribute ($attribute) is required for $class") - if ! exists $args->{$attribute} - } - - my $self = bless $args, $class; - - my @build_subs; - my $linearized_isa = mro::get_linear_isa($class); - - for my $isa_class ( @$linearized_isa ) { - unshift @build_subs, *{ _glob_for "${isa_class}::BUILD" }{CODE}; - } - my @args = %$args; - for my $sub (grep { defined($_) && exists &$_ } @build_subs) { - $sub->( $self, @args); - } - return $self; -} - -sub BUILDARGS { - shift; # No need for the classname - if ( @_ == 1 && ref($_[0]) ) { - Carp::confess("Single parameters to new() must be a HASH ref, not $_[0]") - unless ref($_[0]) eq ref({}); - return {%{$_[0]}} # We want a new reference, always - } - else { - return { @_ }; - } -} - -sub meta { - my $class = shift; - $class = Scalar::Util::blessed($class) || $class; - return Lmo::Meta->new(class => $class); -} - - -1; -} -# ########################################################################### -# End Lmo::Object package -# ########################################################################### - -# ########################################################################### -# Lmo::Types package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Lmo/Types.pm -# t/lib/Lmo/Types.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Lmo::Types; - -use strict; -use warnings qw( FATAL all ); - -use Carp (); -use Scalar::Util qw(looks_like_number blessed); - - -our %TYPES = ( - Bool => sub { !$_[0] || (defined $_[0] && looks_like_number($_[0]) && $_[0] == 1) }, - Num => sub { defined $_[0] && looks_like_number($_[0]) }, - Int => sub { defined $_[0] && looks_like_number($_[0]) && $_[0] == int($_[0]) }, - Str => sub { defined $_[0] }, - Object => sub { defined $_[0] && blessed($_[0]) }, - FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened }, - - map { - my $type = /R/ ? $_ : uc $_; - $_ . "Ref" => sub { ref $_[0] eq $type } - } qw(Array Code Hash Regexp Glob Scalar) -); - -sub check_type_constaints { - my ($attribute, $type_check, $check_name, $val) = @_; - ( ref($type_check) eq 'CODE' - ? $type_check->($val) - : (ref $val eq $type_check - || ($val && $val eq $type_check) - || (exists $TYPES{$type_check} && $TYPES{$type_check}->($val))) - ) - || Carp::confess( - qq - . qq - . (defined $val ? Lmo::Dumper($val) : 'undef') ) -} - -sub _nested_constraints { - my ($attribute, $aggregate_type, $type) = @_; - - my $inner_types; - if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) { - $inner_types = _nested_constraints($1, $2); - } - else { - $inner_types = $TYPES{$type}; - } - - if ( $aggregate_type eq 'ArrayRef' ) { - return sub { - my ($val) = @_; - return unless ref($val) eq ref([]); - - if ($inner_types) { - for my $value ( @{$val} ) { - return unless $inner_types->($value) - } - } - else { - for my $value ( @{$val} ) { - return unless $value && ($value eq $type - || (Scalar::Util::blessed($value) && $value->isa($type))); - } - } - return 1; - }; - } - elsif ( $aggregate_type eq 'Maybe' ) { - return sub { - my ($value) = @_; - return 1 if ! defined($value); - if ($inner_types) { - return unless $inner_types->($value) - } - else { - return unless $value eq $type - || (Scalar::Util::blessed($value) && $value->isa($type)); - } - return 1; - } - } - else { - Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe"); - } -} - -1; -} -# ########################################################################### -# End Lmo::Types package -# ########################################################################### - -# ########################################################################### -# Lmo package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Lmo.pm -# t/lib/Lmo.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -BEGIN { -$INC{"Lmo.pm"} = __FILE__; -package Lmo; -our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo. - - -use strict; -use warnings qw( FATAL all ); - -use Carp (); -use Scalar::Util qw(looks_like_number blessed); - -use Lmo::Meta; -use Lmo::Object; -use Lmo::Types; - -use Lmo::Utils; - -my %export_for; -sub import { - warnings->import(qw(FATAL all)); - strict->import(); - - my $caller = scalar caller(); # Caller's package - my %exports = ( - extends => \&extends, - has => \&has, - with => \&with, - override => \&override, - confess => \&Carp::confess, - ); - - $export_for{$caller} = \%exports; - - for my $keyword ( keys %exports ) { - _install_coderef "${caller}::$keyword" => $exports{$keyword}; - } - - if ( !@{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] } ) { - @_ = "Lmo::Object"; - goto *{ _glob_for "${caller}::extends" }{CODE}; - } -} - -sub extends { - my $caller = scalar caller(); - for my $class ( @_ ) { - _load_module($class); - } - _set_package_isa($caller, @_); - _set_inherited_metadata($caller); -} - -sub _load_module { - my ($class) = @_; - - (my $file = $class) =~ s{::|'}{/}g; - $file .= '.pm'; - { local $@; eval { require "$file" } } # or warn $@; - return; -} - -sub with { - my $package = scalar caller(); - require Role::Tiny; - for my $role ( @_ ) { - _load_module($role); - _role_attribute_metadata($package, $role); - } - Role::Tiny->apply_roles_to_package($package, @_); -} - -sub _role_attribute_metadata { - my ($package, $role) = @_; - - my $package_meta = Lmo::Meta->metadata_for($package); - my $role_meta = Lmo::Meta->metadata_for($role); - - %$package_meta = (%$role_meta, %$package_meta); -} - -sub has { - my $names = shift; - my $caller = scalar caller(); - - my $class_metadata = Lmo::Meta->metadata_for($caller); - - for my $attribute ( ref $names ? @$names : $names ) { - my %args = @_; - my $method = ($args{is} || '') eq 'ro' - ? sub { - Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller}::${attribute}") - if $#_; - return $_[0]{$attribute}; - } - : sub { - return $#_ - ? $_[0]{$attribute} = $_[1] - : $_[0]{$attribute}; - }; - - $class_metadata->{$attribute} = (); - - if ( my $type_check = $args{isa} ) { - my $check_name = $type_check; - - if ( my ($aggregate_type, $inner_type) = $type_check =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) { - $type_check = Lmo::Types::_nested_constraints($attribute, $aggregate_type, $inner_type); - } - - my $check_sub = sub { - my ($new_val) = @_; - Lmo::Types::check_type_constaints($attribute, $type_check, $check_name, $new_val); - }; - - $class_metadata->{$attribute}{isa} = [$check_name, $check_sub]; - my $orig_method = $method; - $method = sub { - $check_sub->($_[1]) if $#_; - goto &$orig_method; - }; - } - - if ( my $builder = $args{builder} ) { - my $original_method = $method; - $method = sub { - $#_ - ? goto &$original_method - : ! exists $_[0]{$attribute} - ? $_[0]{$attribute} = $_[0]->$builder - : goto &$original_method - }; - } - - if ( my $code = $args{default} ) { - Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef") - unless ref($code) eq 'CODE'; - my $original_method = $method; - $method = sub { - $#_ - ? goto &$original_method - : ! exists $_[0]{$attribute} - ? $_[0]{$attribute} = $_[0]->$code - : goto &$original_method - }; - } - - if ( my $role = $args{does} ) { - my $original_method = $method; - $method = sub { - if ( $#_ ) { - Carp::confess(qq) - unless Scalar::Util::blessed($_[1]) && eval { $_[1]->does($role) } - } - goto &$original_method - }; - } - - if ( my $coercion = $args{coerce} ) { - $class_metadata->{$attribute}{coerce} = $coercion; - my $original_method = $method; - $method = sub { - if ( $#_ ) { - return $original_method->($_[0], $coercion->($_[1])) - } - goto &$original_method; - } - } - - _install_coderef "${caller}::$attribute" => $method; - - if ( $args{required} ) { - $class_metadata->{$attribute}{required} = 1; - } - - if ($args{clearer}) { - _install_coderef "${caller}::$args{clearer}" - => sub { delete shift->{$attribute} } - } - - if ($args{predicate}) { - _install_coderef "${caller}::$args{predicate}" - => sub { exists shift->{$attribute} } - } - - if ($args{handles}) { - _has_handles($caller, $attribute, \%args); - } - - if (exists $args{init_arg}) { - $class_metadata->{$attribute}{init_arg} = $args{init_arg}; - } - } -} - -sub _has_handles { - my ($caller, $attribute, $args) = @_; - my $handles = $args->{handles}; - - my $ref = ref $handles; - my $kv; - if ( $ref eq ref [] ) { - $kv = { map { $_,$_ } @{$handles} }; - } - elsif ( $ref eq ref {} ) { - $kv = $handles; - } - elsif ( $ref eq ref qr// ) { - Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)") - unless $args->{isa}; - my $target_class = $args->{isa}; - $kv = { - map { $_, $_ } - grep { $_ =~ $handles } - grep { !exists $Lmo::Object::{$_} && $target_class->can($_) } - grep { !$export_for{$target_class}->{$_} } - keys %{ _stash_for $target_class } - }; - } - else { - Carp::confess("handles for $ref not yet implemented"); - } - - while ( my ($method, $target) = each %{$kv} ) { - my $name = _glob_for "${caller}::$method"; - Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation") - if defined &$name; - - my ($target, @curried_args) = ref($target) ? @$target : $target; - *$name = sub { - my $self = shift; - my $delegate_to = $self->$attribute(); - my $error = "Cannot delegate $method to $target because the value of $attribute"; - Carp::confess("$error is not defined") unless $delegate_to; - Carp::confess("$error is not an object (got '$delegate_to')") - unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target)); - return $delegate_to->$target(@curried_args, @_); - } - } -} - -sub _set_package_isa { - my ($package, @new_isa) = @_; - my $package_isa = \*{ _glob_for "${package}::ISA" }; - @{*$package_isa} = @new_isa; -} - -sub _set_inherited_metadata { - my $class = shift; - my $class_metadata = Lmo::Meta->metadata_for($class); - my $linearized_isa = mro::get_linear_isa($class); - my %new_metadata; - - for my $isa_class (reverse @$linearized_isa) { - my $isa_metadata = Lmo::Meta->metadata_for($isa_class); - %new_metadata = ( - %new_metadata, - %$isa_metadata, - ); - } - %$class_metadata = %new_metadata; -} - -sub unimport { - my $caller = scalar caller(); - my $target = caller; - _unimport_coderefs($target, keys %{$export_for{$caller}}); -} - -sub Dumper { - require Data::Dumper; - local $Data::Dumper::Indent = 0; - local $Data::Dumper::Sortkeys = 0; - local $Data::Dumper::Quotekeys = 0; - local $Data::Dumper::Terse = 1; - - Data::Dumper::Dumper(@_) -} - -BEGIN { - if ($] >= 5.010) { - { local $@; require mro; } - } - else { - local $@; - eval { - require MRO::Compat; - } or do { - *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub { - no strict 'refs'; - - my $classname = shift; - - my @lin = ($classname); - my %stored; - foreach my $parent (@{"$classname\::ISA"}) { - my $plin = mro::get_linear_isa_dfs($parent); - foreach (@$plin) { - next if exists $stored{$_}; - push(@lin, $_); - $stored{$_} = 1; - } - } - return \@lin; - }; - } - } -} - -sub override { - my ($methods, $code) = @_; - my $caller = scalar caller; - - for my $method ( ref($methods) ? @$methods : $methods ) { - my $full_method = "${caller}::${method}"; - *{_glob_for $full_method} = $code; - } -} - -} -1; -} -# ########################################################################### -# End Lmo package -# ########################################################################### - -# ########################################################################### -# DSNParser package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/DSNParser.pm -# t/lib/DSNParser.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package DSNParser; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Data::Dumper; -$Data::Dumper::Indent = 0; -$Data::Dumper::Quotekeys = 0; - -my $dsn_sep = qr/(? {} # h, P, u, etc. Should come from DSN OPTIONS section in POD. - }; - foreach my $opt ( @{$args{opts}} ) { - if ( !$opt->{key} || !$opt->{desc} ) { - die "Invalid DSN option: ", Dumper($opt); - } - PTDEBUG && _d('DSN option:', - join(', ', - map { "$_=" . (defined $opt->{$_} ? ($opt->{$_} || '') : 'undef') } - keys %$opt - ) - ); - $self->{opts}->{$opt->{key}} = { - dsn => $opt->{dsn}, - desc => $opt->{desc}, - copy => $opt->{copy} || 0, - }; - } - return bless $self, $class; -} - -sub prop { - my ( $self, $prop, $value ) = @_; - if ( @_ > 2 ) { - PTDEBUG && _d('Setting', $prop, 'property'); - $self->{$prop} = $value; - } - return $self->{$prop}; -} - -sub parse { - my ( $self, $dsn, $prev, $defaults ) = @_; - if ( !$dsn ) { - PTDEBUG && _d('No DSN to parse'); - return; - } - PTDEBUG && _d('Parsing', $dsn); - $prev ||= {}; - $defaults ||= {}; - my %given_props; - my %final_props; - my $opts = $self->{opts}; - - foreach my $dsn_part ( split($dsn_sep, $dsn) ) { - $dsn_part =~ s/\\,/,/g; - if ( my ($prop_key, $prop_val) = $dsn_part =~ m/^(.)=(.*)$/ ) { - $given_props{$prop_key} = $prop_val; - } - else { - PTDEBUG && _d('Interpreting', $dsn_part, 'as h=', $dsn_part); - $given_props{h} = $dsn_part; - } - } - - foreach my $key ( keys %$opts ) { - PTDEBUG && _d('Finding value for', $key); - $final_props{$key} = $given_props{$key}; - if ( !defined $final_props{$key} - && defined $prev->{$key} && $opts->{$key}->{copy} ) - { - $final_props{$key} = $prev->{$key}; - PTDEBUG && _d('Copying value for', $key, 'from previous DSN'); - } - if ( !defined $final_props{$key} ) { - $final_props{$key} = $defaults->{$key}; - PTDEBUG && _d('Copying value for', $key, 'from defaults'); - } - } - - foreach my $key ( keys %given_props ) { - die "Unknown DSN option '$key' in '$dsn'. For more details, " - . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " - . "for complete documentation." - unless exists $opts->{$key}; - } - if ( (my $required = $self->prop('required')) ) { - foreach my $key ( keys %$required ) { - die "Missing required DSN option '$key' in '$dsn'. For more details, " - . "please use the --help option, or try 'perldoc $PROGRAM_NAME' " - . "for complete documentation." - unless $final_props{$key}; - } - } - - return \%final_props; -} - -sub parse_options { - my ( $self, $o ) = @_; - die 'I need an OptionParser object' unless ref $o eq 'OptionParser'; - my $dsn_string - = join(',', - map { "$_=".$o->get($_); } - grep { $o->has($_) && $o->get($_) } - keys %{$self->{opts}} - ); - PTDEBUG && _d('DSN string made from options:', $dsn_string); - return $self->parse($dsn_string); -} - -sub as_string { - my ( $self, $dsn, $props ) = @_; - return $dsn unless ref $dsn; - my @keys = $props ? @$props : sort keys %$dsn; - return join(',', - map { "$_=" . ($_ eq 'p' ? '...' : $dsn->{$_}) } - grep { - exists $self->{opts}->{$_} - && exists $dsn->{$_} - && defined $dsn->{$_} - } @keys); -} - -sub usage { - my ( $self ) = @_; - my $usage - = "DSN syntax is key=value[,key=value...] Allowable DSN keys:\n\n" - . " KEY COPY MEANING\n" - . " === ==== =============================================\n"; - my %opts = %{$self->{opts}}; - foreach my $key ( sort keys %opts ) { - $usage .= " $key " - . ($opts{$key}->{copy} ? 'yes ' : 'no ') - . ($opts{$key}->{desc} || '[No description]') - . "\n"; - } - $usage .= "\n If the DSN is a bareword, the word is treated as the 'h' key.\n"; - return $usage; -} - -sub get_cxn_params { - my ( $self, $info ) = @_; - my $dsn; - my %opts = %{$self->{opts}}; - my $driver = $self->prop('dbidriver') || ''; - if ( $driver eq 'Pg' ) { - $dsn = 'DBI:Pg:dbname=' . ( $info->{D} || '' ) . ';' - . join(';', map { "$opts{$_}->{dsn}=$info->{$_}" } - grep { defined $info->{$_} } - qw(h P)); - } - else { - $dsn = 'DBI:mysql:' . ( $info->{D} || '' ) . ';' - . join(';', map { "$opts{$_}->{dsn}=$info->{$_}" } - grep { defined $info->{$_} } - qw(F h P S A)) - . ';mysql_read_default_group=client' - . ($info->{L} ? ';mysql_local_infile=1' : ''); - } - PTDEBUG && _d($dsn); - return ($dsn, $info->{u}, $info->{p}); -} - -sub fill_in_dsn { - my ( $self, $dbh, $dsn ) = @_; - my $vars = $dbh->selectall_hashref('SHOW VARIABLES', 'Variable_name'); - my ($user, $db) = $dbh->selectrow_array('SELECT USER(), DATABASE()'); - $user =~ s/@.*//; - $dsn->{h} ||= $vars->{hostname}->{Value}; - $dsn->{S} ||= $vars->{'socket'}->{Value}; - $dsn->{P} ||= $vars->{port}->{Value}; - $dsn->{u} ||= $user; - $dsn->{D} ||= $db; -} - -sub get_dbh { - my ( $self, $cxn_string, $user, $pass, $opts ) = @_; - $opts ||= {}; - my $defaults = { - AutoCommit => 0, - RaiseError => 1, - PrintError => 0, - ShowErrorStatement => 1, - mysql_enable_utf8 => ($cxn_string =~ m/charset=utf8/i ? 1 : 0), - }; - @{$defaults}{ keys %$opts } = values %$opts; - if (delete $defaults->{L}) { # L for LOAD DATA LOCAL INFILE, our own extension - $defaults->{mysql_local_infile} = 1; - } - - if ( $opts->{mysql_use_result} ) { - $defaults->{mysql_use_result} = 1; - } - - if ( !$have_dbi ) { - die "Cannot connect to MySQL because the Perl DBI module is not " - . "installed or not found. Run 'perl -MDBI' to see the directories " - . "that Perl searches for DBI. If DBI is not installed, try:\n" - . " Debian/Ubuntu apt-get install libdbi-perl\n" - . " RHEL/CentOS yum install perl-DBI\n" - . " OpenSolaris pkg install pkg:/SUNWpmdbi\n"; - - } - - my $dbh; - my $tries = 2; - while ( !$dbh && $tries-- ) { - PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, - join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); - - $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) }; - - if ( !$dbh && $EVAL_ERROR ) { - 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 " - . "DBD::mysql is not installed, try:\n" - . " Debian/Ubuntu apt-get install libdbd-mysql-perl\n" - . " 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 "Error getting the current SQL_MODE: $EVAL_ERROR"; - } - - if ( my ($charset) = $cxn_string =~ m/charset=([\w]+)/ ) { - $sql = qq{/*!40101 SET NAMES "$charset"*/}; - PTDEBUG && _d($dbh, $sql); - eval { $dbh->do($sql) }; - if ( $EVAL_ERROR ) { - die "Error setting NAMES to $charset: $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 ( my $vars = $self->prop('set-vars') ) { - $self->set_vars($dbh, $vars); - } - - $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 "Error setting SQL_QUOTE_SHOW_CREATE, SQL_MODE" - . ($sql_mode ? " and $sql_mode" : '') - . ": $EVAL_ERROR"; - } - } - - PTDEBUG && _d('DBH info: ', - $dbh, - Dumper($dbh->selectrow_hashref( - 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), - 'Connection info:', $dbh->{mysql_hostinfo}, - 'Character set info:', Dumper($dbh->selectall_arrayref( - "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})), - '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, - '$DBI::VERSION:', $DBI::VERSION, - ); - - return $dbh; -} - -sub get_hostname { - my ( $self, $dbh ) = @_; - if ( my ($host) = ($dbh->{mysql_hostinfo} || '') =~ m/^(\w+) via/ ) { - return $host; - } - my ( $hostname, $one ) = $dbh->selectrow_array( - 'SELECT /*!50038 @@hostname, */ 1'); - return $hostname; -} - -sub disconnect { - my ( $self, $dbh ) = @_; - PTDEBUG && $self->print_active_handles($dbh); - $dbh->disconnect; -} - -sub print_active_handles { - my ( $self, $thing, $level ) = @_; - $level ||= 0; - printf("# Active %sh: %s %s %s\n", ($thing->{Type} || 'undef'), "\t" x $level, - $thing, (($thing->{Type} || '') eq 'st' ? $thing->{Statement} || '' : '')) - or die "Cannot print: $OS_ERROR"; - foreach my $handle ( grep {defined} @{ $thing->{ChildHandles} } ) { - $self->print_active_handles( $handle, $level + 1 ); - } -} - -sub copy { - my ( $self, $dsn_1, $dsn_2, %args ) = @_; - die 'I need a dsn_1 argument' unless $dsn_1; - die 'I need a dsn_2 argument' unless $dsn_2; - my %new_dsn = map { - my $key = $_; - my $val; - if ( $args{overwrite} ) { - $val = defined $dsn_1->{$key} ? $dsn_1->{$key} : $dsn_2->{$key}; - } - else { - $val = defined $dsn_2->{$key} ? $dsn_2->{$key} : $dsn_1->{$key}; - } - $key => $val; - } keys %{$self->{opts}}; - return \%new_dsn; -} - -sub set_vars { - my ($self, $dbh, $vars) = @_; - - return unless $vars; - - foreach my $var ( sort keys %$vars ) { - my $val = $vars->{$var}->{val}; - - (my $quoted_var = $var) =~ s/_/\\_/; - my ($var_exists, $current_val); - eval { - ($var_exists, $current_val) = $dbh->selectrow_array( - "SHOW VARIABLES LIKE '$quoted_var'"); - }; - my $e = $EVAL_ERROR; - if ( $e ) { - PTDEBUG && _d($e); - } - - if ( $vars->{$var}->{default} && !$var_exists ) { - PTDEBUG && _d('Not setting default var', $var, - 'because it does not exist'); - next; - } - - if ( $current_val && $current_val eq $val ) { - PTDEBUG && _d('Not setting var', $var, 'because its value', - 'is already', $val); - next; - } - - my $sql = "SET SESSION $var=$val"; - PTDEBUG && _d($dbh, $sql); - eval { $dbh->do($sql) }; - if ( my $set_error = $EVAL_ERROR ) { - chomp($set_error); - $set_error =~ s/ at \S+ line \d+//; - my $msg = "Error setting $var: $set_error"; - if ( $current_val ) { - $msg .= " The current value for $var is $current_val. " - . "If the variable is read only (not dynamic), specify " - . "--set-vars $var=$current_val to avoid this warning, " - . "else manually set the variable and restart MySQL."; - } - warn $msg . "\n\n"; - } - } - - return; -} - -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 DSNParser package -# ########################################################################### - -# ########################################################################### -# OptionParser package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/OptionParser.pm -# t/lib/OptionParser.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package OptionParser; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use List::Util qw(max); -use Getopt::Long; -use Data::Dumper; - -my $POD_link_re = '[LC]<"?([^">]+)"?>'; - -sub new { - my ( $class, %args ) = @_; - my @required_args = qw(); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - - my ($program_name) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/; - $program_name ||= $PROGRAM_NAME; - my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.'; - - my %attributes = ( - 'type' => 1, - 'short form' => 1, - 'group' => 1, - 'default' => 1, - 'cumulative' => 1, - 'negatable' => 1, - ); - - my $self = { - head1 => 'OPTIONS', # These args are used internally - skip_rules => 0, # to instantiate another Option- - item => '--(.*)', # Parser obj that parses the - attributes => \%attributes, # DSN OPTIONS section. Tools - parse_attributes => \&_parse_attribs, # don't tinker with these args. - - %args, - - strict => 1, # disabled by a special rule - program_name => $program_name, - opts => {}, - got_opts => 0, - short_opts => {}, - defaults => {}, - groups => {}, - allowed_groups => {}, - errors => [], - rules => [], # desc of rules for --help - mutex => [], # rule: opts are mutually exclusive - atleast1 => [], # rule: at least one opt is required - disables => {}, # rule: opt disables other opts - defaults_to => {}, # rule: opt defaults to value of other opt - DSNParser => undef, - default_files => [ - "/etc/percona-toolkit/percona-toolkit.conf", - "/etc/percona-toolkit/$program_name.conf", - "$home/.percona-toolkit.conf", - "$home/.$program_name.conf", - ], - types => { - string => 's', # standard Getopt type - int => 'i', # standard Getopt type - float => 'f', # standard Getopt type - Hash => 'H', # hash, formed from a comma-separated list - hash => 'h', # hash as above, but only if a value is given - Array => 'A', # array, similar to Hash - array => 'a', # array, similar to hash - DSN => 'd', # DSN - size => 'z', # size with kMG suffix (powers of 2^10) - time => 'm', # time, with an optional suffix of s/h/m/d - }, - }; - - return bless $self, $class; -} - -sub get_specs { - my ( $self, $file ) = @_; - $file ||= $self->{file} || __FILE__; - my @specs = $self->_pod_to_specs($file); - $self->_parse_specs(@specs); - - open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; - my $contents = do { local $/ = undef; <$fh> }; - close $fh; - if ( $contents =~ m/^=head1 DSN OPTIONS/m ) { - PTDEBUG && _d('Parsing DSN OPTIONS'); - my $dsn_attribs = { - dsn => 1, - copy => 1, - }; - my $parse_dsn_attribs = sub { - my ( $self, $option, $attribs ) = @_; - map { - my $val = $attribs->{$_}; - if ( $val ) { - $val = $val eq 'yes' ? 1 - : $val eq 'no' ? 0 - : $val; - $attribs->{$_} = $val; - } - } keys %$attribs; - return { - key => $option, - %$attribs, - }; - }; - my $dsn_o = new OptionParser( - description => 'DSN OPTIONS', - head1 => 'DSN OPTIONS', - dsn => 0, # XXX don't infinitely recurse! - item => '\* (.)', # key opts are a single character - skip_rules => 1, # no rules before opts - attributes => $dsn_attribs, - parse_attributes => $parse_dsn_attribs, - ); - my @dsn_opts = map { - my $opts = { - key => $_->{spec}->{key}, - dsn => $_->{spec}->{dsn}, - copy => $_->{spec}->{copy}, - desc => $_->{desc}, - }; - $opts; - } $dsn_o->_pod_to_specs($file); - $self->{DSNParser} = DSNParser->new(opts => \@dsn_opts); - } - - if ( $contents =~ m/^=head1 VERSION\n\n^(.+)$/m ) { - $self->{version} = $1; - PTDEBUG && _d($self->{version}); - } - - return; -} - -sub DSNParser { - my ( $self ) = @_; - return $self->{DSNParser}; -}; - -sub get_defaults_files { - my ( $self ) = @_; - return @{$self->{default_files}}; -} - -sub _pod_to_specs { - my ( $self, $file ) = @_; - $file ||= $self->{file} || __FILE__; - open my $fh, '<', $file or die "Cannot open $file: $OS_ERROR"; - - my @specs = (); - my @rules = (); - my $para; - - local $INPUT_RECORD_SEPARATOR = ''; - while ( $para = <$fh> ) { - next unless $para =~ m/^=head1 $self->{head1}/; - last; - } - - while ( $para = <$fh> ) { - last if $para =~ m/^=over/; - next if $self->{skip_rules}; - chomp $para; - $para =~ s/\s+/ /g; - $para =~ s/$POD_link_re/$1/go; - PTDEBUG && _d('Option rule:', $para); - push @rules, $para; - } - - die "POD has no $self->{head1} section" unless $para; - - do { - if ( my ($option) = $para =~ m/^=item $self->{item}/ ) { - chomp $para; - PTDEBUG && _d($para); - my %attribs; - - $para = <$fh>; # read next paragraph, possibly attributes - - if ( $para =~ m/: / ) { # attributes - $para =~ s/\s+\Z//g; - %attribs = map { - my ( $attrib, $val) = split(/: /, $_); - die "Unrecognized attribute for --$option: $attrib" - unless $self->{attributes}->{$attrib}; - ($attrib, $val); - } split(/; /, $para); - if ( $attribs{'short form'} ) { - $attribs{'short form'} =~ s/-//; - } - $para = <$fh>; # read next paragraph, probably short help desc - } - else { - PTDEBUG && _d('Option has no attributes'); - } - - $para =~ s/\s+\Z//g; - $para =~ s/\s+/ /g; - $para =~ s/$POD_link_re/$1/go; - - $para =~ s/\.(?:\n.*| [A-Z].*|\Z)//s; - PTDEBUG && _d('Short help:', $para); - - die "No description after option spec $option" if $para =~ m/^=item/; - - if ( my ($base_option) = $option =~ m/^\[no\](.*)/ ) { - $option = $base_option; - $attribs{'negatable'} = 1; - } - - push @specs, { - spec => $self->{parse_attributes}->($self, $option, \%attribs), - desc => $para - . (defined $attribs{default} ? " (default $attribs{default})" : ''), - group => ($attribs{'group'} ? $attribs{'group'} : 'default'), - }; - } - while ( $para = <$fh> ) { - last unless $para; - if ( $para =~ m/^=head1/ ) { - $para = undef; # Can't 'last' out of a do {} block. - last; - } - last if $para =~ m/^=item /; - } - } while ( $para ); - - die "No valid specs in $self->{head1}" unless @specs; - - close $fh; - return @specs, @rules; -} - -sub _parse_specs { - my ( $self, @specs ) = @_; - my %disables; # special rule that requires deferred checking - - foreach my $opt ( @specs ) { - if ( ref $opt ) { # It's an option spec, not a rule. - PTDEBUG && _d('Parsing opt spec:', - map { ($_, '=>', $opt->{$_}) } keys %$opt); - - my ( $long, $short ) = $opt->{spec} =~ m/^([\w-]+)(?:\|([^!+=]*))?/; - if ( !$long ) { - die "Cannot parse long option from spec $opt->{spec}"; - } - $opt->{long} = $long; - - die "Duplicate long option --$long" if exists $self->{opts}->{$long}; - $self->{opts}->{$long} = $opt; - - if ( length $long == 1 ) { - PTDEBUG && _d('Long opt', $long, 'looks like short opt'); - $self->{short_opts}->{$long} = $long; - } - - if ( $short ) { - die "Duplicate short option -$short" - if exists $self->{short_opts}->{$short}; - $self->{short_opts}->{$short} = $long; - $opt->{short} = $short; - } - else { - $opt->{short} = undef; - } - - $opt->{is_negatable} = $opt->{spec} =~ m/!/ ? 1 : 0; - $opt->{is_cumulative} = $opt->{spec} =~ m/\+/ ? 1 : 0; - $opt->{is_required} = $opt->{desc} =~ m/required/ ? 1 : 0; - - $opt->{group} ||= 'default'; - $self->{groups}->{ $opt->{group} }->{$long} = 1; - - $opt->{value} = undef; - $opt->{got} = 0; - - my ( $type ) = $opt->{spec} =~ m/=(.)/; - $opt->{type} = $type; - PTDEBUG && _d($long, 'type:', $type); - - - $opt->{spec} =~ s/=./=s/ if ( $type && $type =~ m/[HhAadzm]/ ); - - if ( (my ($def) = $opt->{desc} =~ m/default\b(?: ([^)]+))?/) ) { - $self->{defaults}->{$long} = defined $def ? $def : 1; - PTDEBUG && _d($long, 'default:', $def); - } - - if ( $long eq 'config' ) { - $self->{defaults}->{$long} = join(',', $self->get_defaults_files()); - } - - if ( (my ($dis) = $opt->{desc} =~ m/(disables .*)/) ) { - $disables{$long} = $dis; - PTDEBUG && _d('Deferring check of disables rule for', $opt, $dis); - } - - $self->{opts}->{$long} = $opt; - } - else { # It's an option rule, not a spec. - PTDEBUG && _d('Parsing rule:', $opt); - push @{$self->{rules}}, $opt; - my @participants = $self->_get_participants($opt); - my $rule_ok = 0; - - if ( $opt =~ m/mutually exclusive|one and only one/ ) { - $rule_ok = 1; - push @{$self->{mutex}}, \@participants; - PTDEBUG && _d(@participants, 'are mutually exclusive'); - } - if ( $opt =~ m/at least one|one and only one/ ) { - $rule_ok = 1; - push @{$self->{atleast1}}, \@participants; - PTDEBUG && _d(@participants, 'require at least one'); - } - if ( $opt =~ m/default to/ ) { - $rule_ok = 1; - $self->{defaults_to}->{$participants[0]} = $participants[1]; - PTDEBUG && _d($participants[0], 'defaults to', $participants[1]); - } - if ( $opt =~ m/restricted to option groups/ ) { - $rule_ok = 1; - my ($groups) = $opt =~ m/groups ([\w\s\,]+)/; - my @groups = split(',', $groups); - %{$self->{allowed_groups}->{$participants[0]}} = map { - s/\s+//; - $_ => 1; - } @groups; - } - if( $opt =~ m/accepts additional command-line arguments/ ) { - $rule_ok = 1; - $self->{strict} = 0; - PTDEBUG && _d("Strict mode disabled by rule"); - } - - die "Unrecognized option rule: $opt" unless $rule_ok; - } - } - - foreach my $long ( keys %disables ) { - my @participants = $self->_get_participants($disables{$long}); - $self->{disables}->{$long} = \@participants; - PTDEBUG && _d('Option', $long, 'disables', @participants); - } - - return; -} - -sub _get_participants { - my ( $self, $str ) = @_; - my @participants; - foreach my $long ( $str =~ m/--(?:\[no\])?([\w-]+)/g ) { - die "Option --$long does not exist while processing rule $str" - unless exists $self->{opts}->{$long}; - push @participants, $long; - } - PTDEBUG && _d('Participants for', $str, ':', @participants); - return @participants; -} - -sub opts { - my ( $self ) = @_; - my %opts = %{$self->{opts}}; - return %opts; -} - -sub short_opts { - my ( $self ) = @_; - my %short_opts = %{$self->{short_opts}}; - return %short_opts; -} - -sub set_defaults { - my ( $self, %defaults ) = @_; - $self->{defaults} = {}; - foreach my $long ( keys %defaults ) { - die "Cannot set default for nonexistent option $long" - unless exists $self->{opts}->{$long}; - $self->{defaults}->{$long} = $defaults{$long}; - PTDEBUG && _d('Default val for', $long, ':', $defaults{$long}); - } - return; -} - -sub get_defaults { - my ( $self ) = @_; - return $self->{defaults}; -} - -sub get_groups { - my ( $self ) = @_; - return $self->{groups}; -} - -sub _set_option { - my ( $self, $opt, $val ) = @_; - my $long = exists $self->{opts}->{$opt} ? $opt - : exists $self->{short_opts}->{$opt} ? $self->{short_opts}->{$opt} - : die "Getopt::Long gave a nonexistent option: $opt"; - - $opt = $self->{opts}->{$long}; - if ( $opt->{is_cumulative} ) { - $opt->{value}++; - } - else { - $opt->{value} = $val; - } - $opt->{got} = 1; - PTDEBUG && _d('Got option', $long, '=', $val); -} - -sub get_opts { - my ( $self ) = @_; - - foreach my $long ( keys %{$self->{opts}} ) { - $self->{opts}->{$long}->{got} = 0; - $self->{opts}->{$long}->{value} - = exists $self->{defaults}->{$long} ? $self->{defaults}->{$long} - : $self->{opts}->{$long}->{is_cumulative} ? 0 - : undef; - } - $self->{got_opts} = 0; - - $self->{errors} = []; - - if ( @ARGV && $ARGV[0] eq "--config" ) { - shift @ARGV; - $self->_set_option('config', shift @ARGV); - } - if ( $self->has('config') ) { - my @extra_args; - foreach my $filename ( split(',', $self->get('config')) ) { - eval { - push @extra_args, $self->_read_config_file($filename); - }; - if ( $EVAL_ERROR ) { - if ( $self->got('config') ) { - die $EVAL_ERROR; - } - elsif ( PTDEBUG ) { - _d($EVAL_ERROR); - } - } - } - unshift @ARGV, @extra_args; - } - - Getopt::Long::Configure('no_ignore_case', 'bundling'); - GetOptions( - map { $_->{spec} => sub { $self->_set_option(@_); } } - grep { $_->{long} ne 'config' } # --config is handled specially above. - values %{$self->{opts}} - ) or $self->save_error('Error parsing options'); - - if ( exists $self->{opts}->{version} && $self->{opts}->{version}->{got} ) { - if ( $self->{version} ) { - print $self->{version}, "\n"; - } - else { - print "Error parsing version. See the VERSION section of the tool's documentation.\n"; - } - exit 1; - } - - if ( @ARGV && $self->{strict} ) { - $self->save_error("Unrecognized command-line options @ARGV"); - } - - foreach my $mutex ( @{$self->{mutex}} ) { - my @set = grep { $self->{opts}->{$_}->{got} } @$mutex; - if ( @set > 1 ) { - my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" } - @{$mutex}[ 0 .. scalar(@$mutex) - 2] ) - . ' and --'.$self->{opts}->{$mutex->[-1]}->{long} - . ' are mutually exclusive.'; - $self->save_error($err); - } - } - - foreach my $required ( @{$self->{atleast1}} ) { - my @set = grep { $self->{opts}->{$_}->{got} } @$required; - if ( @set == 0 ) { - my $err = join(', ', map { "--$self->{opts}->{$_}->{long}" } - @{$required}[ 0 .. scalar(@$required) - 2] ) - .' or --'.$self->{opts}->{$required->[-1]}->{long}; - $self->save_error("Specify at least one of $err"); - } - } - - $self->_check_opts( keys %{$self->{opts}} ); - $self->{got_opts} = 1; - return; -} - -sub _check_opts { - my ( $self, @long ) = @_; - my $long_last = scalar @long; - while ( @long ) { - foreach my $i ( 0..$#long ) { - my $long = $long[$i]; - next unless $long; - my $opt = $self->{opts}->{$long}; - if ( $opt->{got} ) { - if ( exists $self->{disables}->{$long} ) { - my @disable_opts = @{$self->{disables}->{$long}}; - map { $self->{opts}->{$_}->{value} = undef; } @disable_opts; - PTDEBUG && _d('Unset options', @disable_opts, - 'because', $long,'disables them'); - } - - if ( exists $self->{allowed_groups}->{$long} ) { - - my @restricted_groups = grep { - !exists $self->{allowed_groups}->{$long}->{$_} - } keys %{$self->{groups}}; - - my @restricted_opts; - foreach my $restricted_group ( @restricted_groups ) { - RESTRICTED_OPT: - foreach my $restricted_opt ( - keys %{$self->{groups}->{$restricted_group}} ) - { - next RESTRICTED_OPT if $restricted_opt eq $long; - push @restricted_opts, $restricted_opt - if $self->{opts}->{$restricted_opt}->{got}; - } - } - - if ( @restricted_opts ) { - my $err; - if ( @restricted_opts == 1 ) { - $err = "--$restricted_opts[0]"; - } - else { - $err = join(', ', - map { "--$self->{opts}->{$_}->{long}" } - grep { $_ } - @restricted_opts[0..scalar(@restricted_opts) - 2] - ) - . ' or --'.$self->{opts}->{$restricted_opts[-1]}->{long}; - } - $self->save_error("--$long is not allowed with $err"); - } - } - - } - elsif ( $opt->{is_required} ) { - $self->save_error("Required option --$long must be specified"); - } - - $self->_validate_type($opt); - if ( $opt->{parsed} ) { - delete $long[$i]; - } - else { - PTDEBUG && _d('Temporarily failed to parse', $long); - } - } - - die "Failed to parse options, possibly due to circular dependencies" - if @long == $long_last; - $long_last = @long; - } - - return; -} - -sub _validate_type { - my ( $self, $opt ) = @_; - return unless $opt; - - if ( !$opt->{type} ) { - $opt->{parsed} = 1; - return; - } - - my $val = $opt->{value}; - - if ( $val && $opt->{type} eq 'm' ) { # type time - PTDEBUG && _d('Parsing option', $opt->{long}, 'as a time value'); - my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; - if ( !$suffix ) { - my ( $s ) = $opt->{desc} =~ m/\(suffix (.)\)/; - $suffix = $s || 's'; - PTDEBUG && _d('No suffix given; using', $suffix, 'for', - $opt->{long}, '(value:', $val, ')'); - } - if ( $suffix =~ m/[smhd]/ ) { - $val = $suffix eq 's' ? $num # Seconds - : $suffix eq 'm' ? $num * 60 # Minutes - : $suffix eq 'h' ? $num * 3600 # Hours - : $num * 86400; # Days - $opt->{value} = ($prefix || '') . $val; - PTDEBUG && _d('Setting option', $opt->{long}, 'to', $val); - } - else { - $self->save_error("Invalid time suffix for --$opt->{long}"); - } - } - elsif ( $val && $opt->{type} eq 'd' ) { # type DSN - PTDEBUG && _d('Parsing option', $opt->{long}, 'as a DSN'); - my $prev = {}; - my $from_key = $self->{defaults_to}->{ $opt->{long} }; - if ( $from_key ) { - PTDEBUG && _d($opt->{long}, 'DSN copies from', $from_key, 'DSN'); - if ( $self->{opts}->{$from_key}->{parsed} ) { - $prev = $self->{opts}->{$from_key}->{value}; - } - else { - PTDEBUG && _d('Cannot parse', $opt->{long}, 'until', - $from_key, 'parsed'); - return; - } - } - my $defaults = $self->{DSNParser}->parse_options($self); - $opt->{value} = $self->{DSNParser}->parse($val, $prev, $defaults); - } - elsif ( $val && $opt->{type} eq 'z' ) { # type size - PTDEBUG && _d('Parsing option', $opt->{long}, 'as a size value'); - $self->_parse_size($opt, $val); - } - elsif ( $opt->{type} eq 'H' || (defined $val && $opt->{type} eq 'h') ) { - $opt->{value} = { map { $_ => 1 } split(/(?{type} eq 'A' || (defined $val && $opt->{type} eq 'a') ) { - $opt->{value} = [ split(/(?{long}, 'type', $opt->{type}, 'value', $val); - } - - $opt->{parsed} = 1; - return; -} - -sub get { - my ( $self, $opt ) = @_; - my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt); - die "Option $opt does not exist" - unless $long && exists $self->{opts}->{$long}; - return $self->{opts}->{$long}->{value}; -} - -sub got { - my ( $self, $opt ) = @_; - my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt); - die "Option $opt does not exist" - unless $long && exists $self->{opts}->{$long}; - return $self->{opts}->{$long}->{got}; -} - -sub has { - my ( $self, $opt ) = @_; - my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt); - return defined $long ? exists $self->{opts}->{$long} : 0; -} - -sub set { - my ( $self, $opt, $val ) = @_; - my $long = (length $opt == 1 ? $self->{short_opts}->{$opt} : $opt); - die "Option $opt does not exist" - unless $long && exists $self->{opts}->{$long}; - $self->{opts}->{$long}->{value} = $val; - return; -} - -sub save_error { - my ( $self, $error ) = @_; - push @{$self->{errors}}, $error; - return; -} - -sub errors { - my ( $self ) = @_; - return $self->{errors}; -} - -sub usage { - my ( $self ) = @_; - warn "No usage string is set" unless $self->{usage}; # XXX - return "Usage: " . ($self->{usage} || '') . "\n"; -} - -sub descr { - my ( $self ) = @_; - warn "No description string is set" unless $self->{description}; # XXX - my $descr = ($self->{description} || $self->{program_name} || '') - . " For more details, please use the --help option, " - . "or try 'perldoc $PROGRAM_NAME' " - . "for complete documentation."; - $descr = join("\n", $descr =~ m/(.{0,80})(?:\s+|$)/g) - unless $ENV{DONT_BREAK_LINES}; - $descr =~ s/ +$//mg; - return $descr; -} - -sub usage_or_errors { - my ( $self, $file, $return ) = @_; - $file ||= $self->{file} || __FILE__; - - if ( !$self->{description} || !$self->{usage} ) { - PTDEBUG && _d("Getting description and usage from SYNOPSIS in", $file); - my %synop = $self->_parse_synopsis($file); - $self->{description} ||= $synop{description}; - $self->{usage} ||= $synop{usage}; - PTDEBUG && _d("Description:", $self->{description}, - "\nUsage:", $self->{usage}); - } - - if ( $self->{opts}->{help}->{got} ) { - print $self->print_usage() or die "Cannot print usage: $OS_ERROR"; - exit 0 unless $return; - } - elsif ( scalar @{$self->{errors}} ) { - print $self->print_errors() or die "Cannot print errors: $OS_ERROR"; - exit 1 unless $return; - } - - return; -} - -sub print_errors { - my ( $self ) = @_; - my $usage = $self->usage() . "\n"; - if ( (my @errors = @{$self->{errors}}) ) { - $usage .= join("\n * ", 'Errors in command-line arguments:', @errors) - . "\n"; - } - return $usage . "\n" . $self->descr(); -} - -sub print_usage { - my ( $self ) = @_; - die "Run get_opts() before print_usage()" unless $self->{got_opts}; - my @opts = values %{$self->{opts}}; - - my $maxl = max( - map { - length($_->{long}) # option long name - + ($_->{is_negatable} ? 4 : 0) # "[no]" if opt is negatable - + ($_->{type} ? 2 : 0) # "=x" where x is the opt type - } - @opts); - - my $maxs = max(0, - map { - length($_) - + ($self->{opts}->{$_}->{is_negatable} ? 4 : 0) - + ($self->{opts}->{$_}->{type} ? 2 : 0) - } - values %{$self->{short_opts}}); - - my $lcol = max($maxl, ($maxs + 3)); - my $rcol = 80 - $lcol - 6; - my $rpad = ' ' x ( 80 - $rcol ); - - $maxs = max($lcol - 3, $maxs); - - my $usage = $self->descr() . "\n" . $self->usage(); - - my @groups = reverse sort grep { $_ ne 'default'; } keys %{$self->{groups}}; - push @groups, 'default'; - - foreach my $group ( reverse @groups ) { - $usage .= "\n".($group eq 'default' ? 'Options' : $group).":\n\n"; - foreach my $opt ( - sort { $a->{long} cmp $b->{long} } - grep { $_->{group} eq $group } - @opts ) - { - my $long = $opt->{is_negatable} ? "[no]$opt->{long}" : $opt->{long}; - my $short = $opt->{short}; - my $desc = $opt->{desc}; - - $long .= $opt->{type} ? "=$opt->{type}" : ""; - - if ( $opt->{type} && $opt->{type} eq 'm' ) { - my ($s) = $desc =~ m/\(suffix (.)\)/; - $s ||= 's'; - $desc =~ s/\s+\(suffix .\)//; - $desc .= ". Optional suffix s=seconds, m=minutes, h=hours, " - . "d=days; if no suffix, $s is used."; - } - $desc = join("\n$rpad", grep { $_ } $desc =~ m/(.{0,$rcol}(?!\W))(?:\s+|(?<=\W)|$)/g); - $desc =~ s/ +$//mg; - if ( $short ) { - $usage .= sprintf(" --%-${maxs}s -%s %s\n", $long, $short, $desc); - } - else { - $usage .= sprintf(" --%-${lcol}s %s\n", $long, $desc); - } - } - } - - $usage .= "\nOption types: s=string, i=integer, f=float, h/H/a/A=comma-separated list, d=DSN, z=size, m=time\n"; - - if ( (my @rules = @{$self->{rules}}) ) { - $usage .= "\nRules:\n\n"; - $usage .= join("\n", map { " $_" } @rules) . "\n"; - } - if ( $self->{DSNParser} ) { - $usage .= "\n" . $self->{DSNParser}->usage(); - } - $usage .= "\nOptions and values after processing arguments:\n\n"; - foreach my $opt ( sort { $a->{long} cmp $b->{long} } @opts ) { - my $val = $opt->{value}; - my $type = $opt->{type} || ''; - my $bool = $opt->{spec} =~ m/^[\w-]+(?:\|[\w-])?!?$/; - $val = $bool ? ( $val ? 'TRUE' : 'FALSE' ) - : !defined $val ? '(No value)' - : $type eq 'd' ? $self->{DSNParser}->as_string($val) - : $type =~ m/H|h/ ? join(',', sort keys %$val) - : $type =~ m/A|a/ ? join(',', @$val) - : $val; - $usage .= sprintf(" --%-${lcol}s %s\n", $opt->{long}, $val); - } - return $usage; -} - -sub prompt_noecho { - shift @_ if ref $_[0] eq __PACKAGE__; - my ( $prompt ) = @_; - local $OUTPUT_AUTOFLUSH = 1; - print $prompt - or die "Cannot print: $OS_ERROR"; - my $response; - eval { - require Term::ReadKey; - Term::ReadKey::ReadMode('noecho'); - chomp($response = ); - Term::ReadKey::ReadMode('normal'); - print "\n" - or die "Cannot print: $OS_ERROR"; - }; - if ( $EVAL_ERROR ) { - die "Cannot read response; is Term::ReadKey installed? $EVAL_ERROR"; - } - return $response; -} - -sub _read_config_file { - my ( $self, $filename ) = @_; - open my $fh, "<", $filename or die "Cannot open $filename: $OS_ERROR\n"; - my @args; - my $prefix = '--'; - my $parse = 1; - - LINE: - while ( my $line = <$fh> ) { - chomp $line; - next LINE if $line =~ m/^\s*(?:\#|\;|$)/; - $line =~ s/\s+#.*$//g; - $line =~ s/^\s+|\s+$//g; - if ( $line eq '--' ) { - $prefix = ''; - $parse = 0; - next LINE; - } - if ( $parse - && (my($opt, $arg) = $line =~ m/^\s*([^=\s]+?)(?:\s*=\s*(.*?)\s*)?$/) - ) { - push @args, grep { defined $_ } ("$prefix$opt", $arg); - } - elsif ( $line =~ m/./ ) { - push @args, $line; - } - else { - die "Syntax error in file $filename at line $INPUT_LINE_NUMBER"; - } - } - close $fh; - return @args; -} - -sub read_para_after { - my ( $self, $file, $regex ) = @_; - open my $fh, "<", $file or die "Can't open $file: $OS_ERROR"; - local $INPUT_RECORD_SEPARATOR = ''; - my $para; - while ( $para = <$fh> ) { - next unless $para =~ m/^=pod$/m; - last; - } - while ( $para = <$fh> ) { - next unless $para =~ m/$regex/; - last; - } - $para = <$fh>; - chomp($para); - close $fh or die "Can't close $file: $OS_ERROR"; - return $para; -} - -sub clone { - my ( $self ) = @_; - - my %clone = map { - my $hashref = $self->{$_}; - my $val_copy = {}; - foreach my $key ( keys %$hashref ) { - my $ref = ref $hashref->{$key}; - $val_copy->{$key} = !$ref ? $hashref->{$key} - : $ref eq 'HASH' ? { %{$hashref->{$key}} } - : $ref eq 'ARRAY' ? [ @{$hashref->{$key}} ] - : $hashref->{$key}; - } - $_ => $val_copy; - } qw(opts short_opts defaults); - - foreach my $scalar ( qw(got_opts) ) { - $clone{$scalar} = $self->{$scalar}; - } - - return bless \%clone; -} - -sub _parse_size { - my ( $self, $opt, $val ) = @_; - - if ( lc($val || '') eq 'null' ) { - PTDEBUG && _d('NULL size for', $opt->{long}); - $opt->{value} = 'null'; - return; - } - - my %factor_for = (k => 1_024, M => 1_048_576, G => 1_073_741_824); - my ($pre, $num, $factor) = $val =~ m/^([+-])?(\d+)([kMG])?$/; - if ( defined $num ) { - if ( $factor ) { - $num *= $factor_for{$factor}; - PTDEBUG && _d('Setting option', $opt->{y}, - 'to num', $num, '* factor', $factor); - } - $opt->{value} = ($pre || '') . $num; - } - else { - $self->save_error("Invalid size for --$opt->{long}: $val"); - } - return; -} - -sub _parse_attribs { - my ( $self, $option, $attribs ) = @_; - my $types = $self->{types}; - return $option - . ($attribs->{'short form'} ? '|' . $attribs->{'short form'} : '' ) - . ($attribs->{'negatable'} ? '!' : '' ) - . ($attribs->{'cumulative'} ? '+' : '' ) - . ($attribs->{'type'} ? '=' . $types->{$attribs->{type}} : '' ); -} - -sub _parse_synopsis { - my ( $self, $file ) = @_; - $file ||= $self->{file} || __FILE__; - PTDEBUG && _d("Parsing SYNOPSIS in", $file); - - local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs - open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; - my $para; - 1 while defined($para = <$fh>) && $para !~ m/^=head1 SYNOPSIS/; - die "$file does not contain a SYNOPSIS section" unless $para; - my @synop; - for ( 1..2 ) { # 1 for the usage, 2 for the description - my $para = <$fh>; - push @synop, $para; - } - close $fh; - PTDEBUG && _d("Raw SYNOPSIS text:", @synop); - my ($usage, $desc) = @synop; - die "The SYNOPSIS section in $file is not formatted properly" - unless $usage && $desc; - - $usage =~ s/^\s*Usage:\s+(.+)/$1/; - chomp $usage; - - $desc =~ s/\n/ /g; - $desc =~ s/\s{2,}/ /g; - $desc =~ s/\. ([A-Z][a-z])/. $1/g; - $desc =~ s/\s+$//; - - return ( - description => $desc, - usage => $usage, - ); -}; - -sub set_vars { - my ($self, $file) = @_; - $file ||= $self->{file} || __FILE__; - - my %user_vars; - my $user_vars = $self->has('set-vars') ? $self->get('set-vars') : undef; - if ( $user_vars ) { - foreach my $var_val ( @$user_vars ) { - my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; - die "Invalid --set-vars value: $var_val\n" unless $var && $val; - $user_vars{$var} = { - val => $val, - default => 0, - }; - } - } - - my %default_vars; - my $default_vars = $self->read_para_after($file, qr/MAGIC_set_vars/); - if ( $default_vars ) { - %default_vars = map { - my $var_val = $_; - my ($var, $val) = $var_val =~ m/([^\s=]+)=(\S+)/; - die "Invalid --set-vars value: $var_val\n" unless $var && $val; - $var => { - val => $val, - default => 1, - }; - } split("\n", $default_vars); - } - - my %vars = ( - %default_vars, # first the tool's defaults - %user_vars, # then the user's which overwrite the defaults - ); - PTDEBUG && _d('--set-vars:', Dumper(\%vars)); - return \%vars; -} - -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"; -} - -if ( PTDEBUG ) { - print '# ', $^X, ' ', $], "\n"; - if ( my $uname = `uname -a` ) { - $uname =~ s/\s+/ /g; - print "# $uname\n"; - } - print '# Arguments: ', - join(' ', map { my $a = "_[$_]_"; $a =~ s/\n/\n# /g; $a; } @ARGV), "\n"; -} - -1; -} -# ########################################################################### -# End OptionParser package -# ########################################################################### - -# ########################################################################### -# Quoter package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Quoter.pm -# t/lib/Quoter.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Quoter; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Data::Dumper; -$Data::Dumper::Indent = 1; -$Data::Dumper::Sortkeys = 1; -$Data::Dumper::Quotekeys = 0; - -sub new { - my ( $class, %args ) = @_; - return bless {}, $class; -} - -sub quote { - my ( $self, @vals ) = @_; - foreach my $val ( @vals ) { - $val =~ s/`/``/g; - } - return join('.', map { '`' . $_ . '`' } @vals); -} - -sub quote_val { - my ( $self, $val, %args ) = @_; - - return 'NULL' unless defined $val; # undef = NULL - return "''" if $val eq ''; # blank string = '' - return $val if $val =~ m/^0x[0-9a-fA-F]+$/ # quote hex data - && !$args{is_char}; # unless is_char is true - - $val =~ s/(['\\])/\\$1/g; - return "'$val'"; -} - -sub split_unquote { - my ( $self, $db_tbl, $default_db ) = @_; - my ( $db, $tbl ) = split(/[.]/, $db_tbl); - if ( !$tbl ) { - $tbl = $db; - $db = $default_db; - } - for ($db, $tbl) { - next unless $_; - s/\A`//; - s/`\z//; - s/``/`/g; - } - - return ($db, $tbl); -} - -sub literal_like { - my ( $self, $like ) = @_; - return unless $like; - $like =~ s/([%_])/\\$1/g; - return "'$like'"; -} - -sub join_quote { - my ( $self, $default_db, $db_tbl ) = @_; - return unless $db_tbl; - my ($db, $tbl) = split(/[.]/, $db_tbl); - if ( !$tbl ) { - $tbl = $db; - $db = $default_db; - } - $db = "`$db`" if $db && $db !~ m/^`/; - $tbl = "`$tbl`" if $tbl && $tbl !~ m/^`/; - return $db ? "$db.$tbl" : $tbl; -} - -sub serialize_list { - my ( $self, @args ) = @_; - PTDEBUG && _d('Serializing', Dumper(\@args)); - return unless @args; - - my @parts; - foreach my $arg ( @args ) { - if ( defined $arg ) { - $arg =~ s/,/\\,/g; # escape commas - $arg =~ s/\\N/\\\\N/g; # escape literal \N - push @parts, $arg; - } - else { - push @parts, '\N'; - } - } - - my $string = join(',', @parts); - PTDEBUG && _d('Serialized: <', $string, '>'); - return $string; -} - -sub deserialize_list { - my ( $self, $string ) = @_; - PTDEBUG && _d('Deserializing <', $string, '>'); - die "Cannot deserialize an undefined string" unless defined $string; - - my @parts; - foreach my $arg ( split(/(? 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Data::Dumper; -$Data::Dumper::Indent = 1; -$Data::Dumper::Sortkeys = 1; -$Data::Dumper::Quotekeys = 0; - -sub new { - my ( $class ) = @_; - my $self = { - pending => [], - }; - return bless $self, $class; -} - -my $slow_log_ts_line = qr/^# Time: ([0-9: ]{15})/; -my $slow_log_uh_line = qr/# User\@Host: ([^\[]+|\[[^[]+\]).*?@ (\S*) \[(.*)\]/; -my $slow_log_hd_line = qr{ - ^(?: - T[cC][pP]\s[pP]ort:\s+\d+ # case differs on windows/unix - | - [/A-Z].*mysqld,\sVersion.*(?:started\swith:|embedded\slibrary) - | - Time\s+Id\s+Command - ).*\n - }xm; - -sub parse_event { - my ( $self, %args ) = @_; - my @required_args = qw(next_event tell); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($next_event, $tell) = @args{@required_args}; - - my $pending = $self->{pending}; - local $INPUT_RECORD_SEPARATOR = ";\n#"; - my $trimlen = length($INPUT_RECORD_SEPARATOR); - my $pos_in_log = $tell->(); - my $stmt; - - EVENT: - while ( - defined($stmt = shift @$pending) - or defined($stmt = $next_event->()) - ) { - my @properties = ('cmd', 'Query', 'pos_in_log', $pos_in_log); - $pos_in_log = $tell->(); - - if ( $stmt =~ s/$slow_log_hd_line//go ){ # Throw away header lines in log - my @chunks = split(/$INPUT_RECORD_SEPARATOR/o, $stmt); - if ( @chunks > 1 ) { - PTDEBUG && _d("Found multiple chunks"); - $stmt = shift @chunks; - unshift @$pending, @chunks; - } - } - - $stmt = '#' . $stmt unless $stmt =~ m/\A#/; - $stmt =~ s/;\n#?\Z//; - - - my ($got_ts, $got_uh, $got_ac, $got_db, $got_set, $got_embed); - my $pos = 0; - my $len = length($stmt); - my $found_arg = 0; - LINE: - while ( $stmt =~ m/^(.*)$/mg ) { # /g is important, requires scalar match. - $pos = pos($stmt); # Be careful not to mess this up! - my $line = $1; # Necessary for /g and pos() to work. - PTDEBUG && _d($line); - - if ($line =~ m/^(?:#|use |SET (?:last_insert_id|insert_id|timestamp))/o) { - - if ( !$got_ts && (my ( $time ) = $line =~ m/$slow_log_ts_line/o)) { - PTDEBUG && _d("Got ts", $time); - push @properties, 'ts', $time; - ++$got_ts; - if ( !$got_uh - && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) - ) { - PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); - push @properties, 'user', $user, 'host', $host, 'ip', $ip; - ++$got_uh; - } - } - - elsif ( !$got_uh - && ( my ( $user, $host, $ip ) = $line =~ m/$slow_log_uh_line/o ) - ) { - PTDEBUG && _d("Got user, host, ip", $user, $host, $ip); - push @properties, 'user', $user, 'host', $host, 'ip', $ip; - ++$got_uh; - } - - elsif (!$got_ac && $line =~ m/^# (?:administrator command:.*)$/) { - PTDEBUG && _d("Got admin command"); - $line =~ s/^#\s+//; # string leading "# ". - push @properties, 'cmd', 'Admin', 'arg', $line; - push @properties, 'bytes', length($properties[-1]); - ++$found_arg; - ++$got_ac; - } - - elsif ( $line =~ m/^# +[A-Z][A-Za-z_]+: \S+/ ) { # Make the test cheap! - PTDEBUG && _d("Got some line with properties"); - - if ( $line =~ m/Schema:\s+\w+: / ) { - PTDEBUG && _d('Removing empty Schema attrib'); - $line =~ s/Schema:\s+//; - PTDEBUG && _d($line); - } - - my @temp = $line =~ m/(\w+):\s+(\S+|\Z)/g; - push @properties, @temp; - } - - elsif ( !$got_db && (my ( $db ) = $line =~ m/^use ([^;]+)/ ) ) { - PTDEBUG && _d("Got a default database:", $db); - push @properties, 'db', $db; - ++$got_db; - } - - elsif (!$got_set && (my ($setting) = $line =~ m/^SET\s+([^;]*)/)) { - PTDEBUG && _d("Got some setting:", $setting); - push @properties, split(/,|\s*=\s*/, $setting); - ++$got_set; - } - - if ( !$found_arg && $pos == $len ) { - PTDEBUG && _d("Did not find arg, looking for special cases"); - local $INPUT_RECORD_SEPARATOR = ";\n"; # get next line - if ( defined(my $l = $next_event->()) ) { - if ( $l =~ /^\s*[A-Z][a-z_]+: / ) { - PTDEBUG && _d("Found NULL query before", $l); - local $INPUT_RECORD_SEPARATOR = ";\n#"; - my $rest_of_event = $next_event->(); - push @{$self->{pending}}, $l . $rest_of_event; - push @properties, 'cmd', 'Query', 'arg', '/* No query */'; - push @properties, 'bytes', 0; - $found_arg++; - } - else { - chomp $l; - $l =~ s/^\s+//; - PTDEBUG && _d("Found admin statement", $l); - push @properties, 'cmd', 'Admin', 'arg', $l; - push @properties, 'bytes', length($properties[-1]); - $found_arg++; - } - } - else { - PTDEBUG && _d("I can't figure out what to do with this line"); - next EVENT; - } - } - } - else { - PTDEBUG && _d("Got the query/arg line"); - my $arg = substr($stmt, $pos - length($line)); - push @properties, 'arg', $arg, 'bytes', length($arg); - if ( $args{misc} && $args{misc}->{embed} - && ( my ($e) = $arg =~ m/($args{misc}->{embed})/) - ) { - push @properties, $e =~ m/$args{misc}->{capture}/g; - } - last LINE; - } - } - - PTDEBUG && _d('Properties of event:', Dumper(\@properties)); - my $event = { @properties }; - if ( $args{stats} ) { - $args{stats}->{events_read}++; - $args{stats}->{events_parsed}++; - } - return $event; - } # EVENT - - @$pending = (); - $args{oktorun}->(0) if $args{oktorun}; - return; -} - -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 SlowLogParser package -# ########################################################################### - -# ########################################################################### -# GeneralLogParser package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/GeneralLogParser.pm -# t/lib/GeneralLogParser.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package GeneralLogParser; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Data::Dumper; -$Data::Dumper::Indent = 1; -$Data::Dumper::Sortkeys = 1; -$Data::Dumper::Quotekeys = 0; - -sub new { - my ( $class ) = @_; - my $self = { - pending => [], - db_for => {}, - }; - return bless $self, $class; -} - -my $genlog_line_1= qr{ - \A - (?:(\d{6}\s+\d{1,2}:\d\d:\d\d))? # Timestamp - \s+ - (?:\s*(\d+)) # Thread ID - \s - (\w+) # Command - \s+ - (.*) # Argument - \Z -}xs; - -sub parse_event { - my ( $self, %args ) = @_; - my @required_args = qw(next_event tell); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($next_event, $tell) = @args{@required_args}; - - my $pending = $self->{pending}; - my $db_for = $self->{db_for}; - my $line; - my $pos_in_log = $tell->(); - LINE: - while ( - defined($line = shift @$pending) - or defined($line = $next_event->()) - ) { - PTDEBUG && _d($line); - my ($ts, $thread_id, $cmd, $arg) = $line =~ m/$genlog_line_1/; - if ( !($thread_id && $cmd) ) { - PTDEBUG && _d('Not start of general log event'); - next; - } - my @properties = ('pos_in_log', $pos_in_log, 'ts', $ts, - 'Thread_id', $thread_id); - - $pos_in_log = $tell->(); - - @$pending = (); - if ( $cmd eq 'Query' ) { - my $done = 0; - do { - $line = $next_event->(); - if ( $line ) { - my (undef, $next_thread_id, $next_cmd) - = $line =~ m/$genlog_line_1/; - if ( $next_thread_id && $next_cmd ) { - PTDEBUG && _d('Event done'); - $done = 1; - push @$pending, $line; - } - else { - PTDEBUG && _d('More arg:', $line); - $arg .= $line; - } - } - else { - PTDEBUG && _d('No more lines'); - $done = 1; - } - } until ( $done ); - - chomp $arg; - push @properties, 'cmd', 'Query', 'arg', $arg; - push @properties, 'bytes', length($properties[-1]); - push @properties, 'db', $db_for->{$thread_id} if $db_for->{$thread_id}; - } - else { - push @properties, 'cmd', 'Admin'; - - if ( $cmd eq 'Connect' ) { - if ( $arg =~ m/^Access denied/ ) { - $cmd = $arg; - } - else { - my ($user) = $arg =~ m/(\S+)/; - my ($db) = $arg =~ m/on (\S+)/; - my $host; - ($user, $host) = split(/@/, $user); - PTDEBUG && _d('Connect', $user, '@', $host, 'on', $db); - - push @properties, 'user', $user if $user; - push @properties, 'host', $host if $host; - push @properties, 'db', $db if $db; - $db_for->{$thread_id} = $db; - } - } - elsif ( $cmd eq 'Init' ) { - $cmd = 'Init DB'; - $arg =~ s/^DB\s+//; - my ($db) = $arg =~ /(\S+)/; - PTDEBUG && _d('Init DB:', $db); - push @properties, 'db', $db if $db; - $db_for->{$thread_id} = $db; - } - - push @properties, 'arg', "administrator command: $cmd"; - push @properties, 'bytes', length($properties[-1]); - } - - push @properties, 'Query_time', 0; - - PTDEBUG && _d('Properties of event:', Dumper(\@properties)); - my $event = { @properties }; - if ( $args{stats} ) { - $args{stats}->{events_read}++; - $args{stats}->{events_parsed}++; - } - return $event; - } # LINE - - @{$self->{pending}} = (); - $args{oktorun}->(0) if $args{oktorun}; - return; -} - -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 GeneralLogParser package -# ########################################################################### - -# ########################################################################### -# QueryParser package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/QueryParser.pm -# t/lib/QueryParser.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package QueryParser; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -our $tbl_ident = qr/(?:`[^`]+`|\w+)(?:\.(?:`[^`]+`|\w+))?/; -our $tbl_regex = qr{ - \b(?:FROM|JOIN|(?get_tables($select); - } - my ($tbl) = $query =~ m/TABLE\s+($tbl_ident)(\s+.*)?/i; - PTDEBUG && _d('Matches table:', $tbl); - return ($tbl); - } - - $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; - - if ( $query =~ s/^\s*LOCK TABLES\s+//i ) { - PTDEBUG && _d('Special table type: LOCK TABLES'); - $query =~ s/\s+(?:READ(?:\s+LOCAL)?|WRITE)\s*//gi; - PTDEBUG && _d('Locked tables:', $query); - $query = "FROM $query"; - } - - $query =~ s/\\["']//g; # quoted strings - $query =~ s/".*?"/?/sg; # quoted strings - $query =~ s/'.*?'/?/sg; # quoted strings - - my @tables; - foreach my $tbls ( $query =~ m/$tbl_regex/gio ) { - PTDEBUG && _d('Match tables:', $tbls); - - next if $tbls =~ m/\ASELECT\b/i; - - foreach my $tbl ( split(',', $tbls) ) { - $tbl =~ s/\s*($tbl_ident)(\s+.*)?/$1/gio; - - if ( $tbl !~ m/[a-zA-Z]/ ) { - PTDEBUG && _d('Skipping suspicious table name:', $tbl); - next; - } - - push @tables, $tbl; - } - } - return @tables; -} - -sub has_derived_table { - my ( $self, $query ) = @_; - my $match = $query =~ m/$has_derived/; - PTDEBUG && _d($query, 'has ' . ($match ? 'a' : 'no') . ' derived table'); - return $match; -} - -sub get_aliases { - my ( $self, $query, $list ) = @_; - - my $result = { - DATABASE => {}, - TABLE => {}, - }; - return $result unless $query; - - $query =~ s/ (?:LOW_PRIORITY|IGNORE|STRAIGHT_JOIN)//ig; - - $query =~ s/ (?:INNER|OUTER|CROSS|LEFT|RIGHT|NATURAL)//ig; - - my @tbl_refs; - my ($tbl_refs, $from) = $query =~ m{ - ( - (FROM|INTO|UPDATE)\b\s* # Keyword before table refs - .+? # Table refs - ) - (?:\s+|\z) # If the query does not end with the table - (?:WHERE|ORDER|LIMIT|HAVING|SET|VALUES|\z) # Keyword after table refs - }ix; - - if ( $tbl_refs ) { - - if ( $query =~ m/^(?:INSERT|REPLACE)/i ) { - $tbl_refs =~ s/\([^\)]+\)\s*//; - } - - PTDEBUG && _d('tbl refs:', $tbl_refs); - - my $before_tbl = qr/(?:,|JOIN|\s|$from)+/i; - - my $after_tbl = qr/(?:,|JOIN|ON|USING|\z)/i; - - $tbl_refs =~ s/ = /=/g; - - while ( - $tbl_refs =~ m{ - $before_tbl\b\s* - ( ($tbl_ident) (?:\s+ (?:AS\s+)? (\w+))? ) - \s*$after_tbl - }xgio ) - { - my ( $tbl_ref, $db_tbl, $alias ) = ($1, $2, $3); - PTDEBUG && _d('Match table:', $tbl_ref); - push @tbl_refs, $tbl_ref; - $alias = $self->trim_identifier($alias); - - if ( $tbl_ref =~ m/^AS\s+\w+/i ) { - PTDEBUG && _d('Subquery', $tbl_ref); - $result->{TABLE}->{$alias} = undef; - next; - } - - my ( $db, $tbl ) = $db_tbl =~ m/^(?:(.*?)\.)?(.*)/; - $db = $self->trim_identifier($db); - $tbl = $self->trim_identifier($tbl); - $result->{TABLE}->{$alias || $tbl} = $tbl; - $result->{DATABASE}->{$tbl} = $db if $db; - } - } - else { - PTDEBUG && _d("No tables ref in", $query); - } - - if ( $list ) { - return \@tbl_refs; - } - else { - return $result; - } -} - -sub split { - my ( $self, $query ) = @_; - return unless $query; - $query = $self->clean_query($query); - PTDEBUG && _d('Splitting', $query); - - my $verbs = qr{SELECT|INSERT|UPDATE|DELETE|REPLACE|UNION|CREATE}i; - - my @split_statements = grep { $_ } split(m/\b($verbs\b(?!(?:\s*\()))/io, $query); - - my @statements; - if ( @split_statements == 1 ) { - push @statements, $query; - } - else { - for ( my $i = 0; $i <= $#split_statements; $i += 2 ) { - push @statements, $split_statements[$i].$split_statements[$i+1]; - - if ( $statements[-2] && $statements[-2] =~ m/on duplicate key\s+$/i ) { - $statements[-2] .= pop @statements; - } - } - } - - PTDEBUG && _d('statements:', map { $_ ? "<$_>" : 'none' } @statements); - return @statements; -} - -sub clean_query { - my ( $self, $query ) = @_; - return unless $query; - $query =~ s!/\*.*?\*/! !g; # Remove /* comment blocks */ - $query =~ s/^\s+//; # Remove leading spaces - $query =~ s/\s+$//; # Remove trailing spaces - $query =~ s/\s{2,}/ /g; # Remove extra spaces - return $query; -} - -sub split_subquery { - my ( $self, $query ) = @_; - return unless $query; - $query = $self->clean_query($query); - $query =~ s/;$//; - - my @subqueries; - my $sqno = 0; # subquery number - my $pos = 0; - while ( $query =~ m/(\S+)(?:\s+|\Z)/g ) { - $pos = pos($query); - my $word = $1; - PTDEBUG && _d($word, $sqno); - if ( $word =~ m/^\(?SELECT\b/i ) { - my $start_pos = $pos - length($word) - 1; - if ( $start_pos ) { - $sqno++; - PTDEBUG && _d('Subquery', $sqno, 'starts at', $start_pos); - $subqueries[$sqno] = { - start_pos => $start_pos, - end_pos => 0, - len => 0, - words => [$word], - lp => 1, # left parentheses - rp => 0, # right parentheses - done => 0, - }; - } - else { - PTDEBUG && _d('Main SELECT at pos 0'); - } - } - else { - next unless $sqno; # next unless we're in a subquery - PTDEBUG && _d('In subquery', $sqno); - my $sq = $subqueries[$sqno]; - if ( $sq->{done} ) { - PTDEBUG && _d('This subquery is done; SQL is for', - ($sqno - 1 ? "subquery $sqno" : "the main SELECT")); - next; - } - push @{$sq->{words}}, $word; - my $lp = ($word =~ tr/\(//) || 0; - my $rp = ($word =~ tr/\)//) || 0; - PTDEBUG && _d('parentheses left', $lp, 'right', $rp); - if ( ($sq->{lp} + $lp) - ($sq->{rp} + $rp) == 0 ) { - my $end_pos = $pos - 1; - PTDEBUG && _d('Subquery', $sqno, 'ends at', $end_pos); - $sq->{end_pos} = $end_pos; - $sq->{len} = $end_pos - $sq->{start_pos}; - } - } - } - - for my $i ( 1..$#subqueries ) { - my $sq = $subqueries[$i]; - next unless $sq; - $sq->{sql} = join(' ', @{$sq->{words}}); - substr $query, - $sq->{start_pos} + 1, # +1 for ( - $sq->{len} - 1, # -1 for ) - "__subquery_$i"; - } - - return $query, map { $_->{sql} } grep { defined $_ } @subqueries; -} - -sub query_type { - my ( $self, $query, $qr ) = @_; - my ($type, undef) = $qr->distill_verbs($query); - my $rw; - if ( $type =~ m/^SELECT\b/ ) { - $rw = 'read'; - } - elsif ( $type =~ m/^$data_manip_stmts\b/ - || $type =~ m/^$data_def_stmts\b/ ) { - $rw = 'write' - } - - return { - type => $type, - rw => $rw, - } -} - -sub get_columns { - my ( $self, $query ) = @_; - my $cols = []; - return $cols unless $query; - my $cols_def; - - if ( $query =~ m/^SELECT/i ) { - $query =~ s/ - ^SELECT\s+ - (?: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 - )\s+ - /SELECT /xgi; - ($cols_def) = $query =~ m/^SELECT\s+(.+?)\s+FROM/i; - } - elsif ( $query =~ m/^(?:INSERT|REPLACE)/i ) { - ($cols_def) = $query =~ m/\(([^\)]+)\)\s*VALUE/i; - } - - PTDEBUG && _d('Columns:', $cols_def); - if ( $cols_def ) { - @$cols = split(',', $cols_def); - map { - my $col = $_; - $col = s/^\s+//g; - $col = s/\s+$//g; - $col; - } @$cols; - } - - return $cols; -} - -sub parse { - my ( $self, $query ) = @_; - return unless $query; - my $parsed = {}; - - $query =~ s/\n/ /g; - $query = $self->clean_query($query); - - $parsed->{query} = $query, - $parsed->{tables} = $self->get_aliases($query, 1); - $parsed->{columns} = $self->get_columns($query); - - my ($type) = $query =~ m/^(\w+)/; - $parsed->{type} = lc $type; - - - $parsed->{sub_queries} = []; - - return $parsed; -} - -sub extract_tables { - my ( $self, %args ) = @_; - my $query = $args{query}; - my $default_db = $args{default_db}; - my $q = $self->{Quoter} || $args{Quoter}; - return unless $query; - PTDEBUG && _d('Extracting tables'); - my @tables; - my %seen; - foreach my $db_tbl ( $self->get_tables($query) ) { - next unless $db_tbl; - next if $seen{$db_tbl}++; # Unique-ify for issue 337. - my ( $db, $tbl ) = $q->split_unquote($db_tbl); - push @tables, [ $db || $default_db, $tbl ]; - } - return @tables; -} - -sub trim_identifier { - my ($self, $str) = @_; - return unless defined $str; - $str =~ s/`//g; - $str =~ s/^\s+//; - $str =~ s/\s+$//; - return $str; -} - -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 QueryParser package -# ########################################################################### - -# ########################################################################### -# QueryRewriter package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/QueryRewriter.pm -# t/lib/QueryRewriter.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package QueryRewriter; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -our $verbs = qr{^SHOW|^FLUSH|^COMMIT|^ROLLBACK|^BEGIN|SELECT|INSERT - |UPDATE|DELETE|REPLACE|^SET|UNION|^START|^LOCK}xi; -my $quote_re = qr/"(?:(?!(? [^()]+ ) # Non-parens without backtracking - | - (??{ $bal }) # Group with matching parens - )* - \) - /x; - -my $olc_re = qr/(?:--|#)[^'"\r\n]*(?=[\r\n]|\Z)/; # One-line comments -my $mlc_re = qr#/\*[^!].*?\*/#sm; # But not /*!version */ -my $vlc_re = qr#/\*.*?[0-9+].*?\*/#sm; # For SHOW + /*!version */ -my $vlc_rf = qr#^(SHOW).*?/\*![0-9+].*?\*/#sm; # Variation for SHOW - - -sub new { - my ( $class, %args ) = @_; - my $self = { %args }; - return bless $self, $class; -} - -sub strip_comments { - my ( $self, $query ) = @_; - return unless $query; - $query =~ s/$olc_re//go; - $query =~ s/$mlc_re//go; - if ( $query =~ m/$vlc_rf/i ) { # contains show + version - $query =~ s/$vlc_re//go; - } - return $query; -} - -sub shorten { - my ( $self, $query, $length ) = @_; - $query =~ s{ - \A( - (?:INSERT|REPLACE) - (?:\s+LOW_PRIORITY|DELAYED|HIGH_PRIORITY|IGNORE)? - (?:\s\w+)*\s+\S+\s+VALUES\s*\(.*?\) - ) - \s*,\s*\(.*?(ON\s+DUPLICATE|\Z)} - {$1 /*... omitted ...*/$2}xsi; - - return $query unless $query =~ m/IN\s*\(\s*(?!select)/i; - - my $last_length = 0; - my $query_length = length($query); - while ( - $length > 0 - && $query_length > $length - && $query_length < ( $last_length || $query_length + 1 ) - ) { - $last_length = $query_length; - $query =~ s{ - (\bIN\s*\() # The opening of an IN list - ([^\)]+) # Contents of the list, assuming no item contains paren - (?=\)) # Close of the list - } - { - $1 . __shorten($2) - }gexsi; - } - - return $query; -} - -sub __shorten { - my ( $snippet ) = @_; - my @vals = split(/,/, $snippet); - return $snippet unless @vals > 20; - my @keep = splice(@vals, 0, 20); # Remove and save the first 20 items - return - join(',', @keep) - . "/*... omitted " - . scalar(@vals) - . " items ...*/"; -} - -sub fingerprint { - my ( $self, $query ) = @_; - - $query =~ m#\ASELECT /\*!40001 SQL_NO_CACHE \*/ \* FROM `# # mysqldump query - && return 'mysqldump'; - $query =~ m#/\*\w+\.\w+:[0-9]/[0-9]\*/# # pt-table-checksum, etc query - && return 'percona-toolkit'; - $query =~ m/\Aadministrator command: / - && return $query; - $query =~ m/\A\s*(call\s+\S+)\(/i - && return lc($1); # Warning! $1 used, be careful. - if ( my ($beginning) = $query =~ m/\A((?:INSERT|REPLACE)(?: IGNORE)?\s+INTO.+?VALUES\s*\(.*?\))\s*,\s*\(/is ) { - $query = $beginning; # Shorten multi-value INSERT statements ASAP - } - - $query =~ s/$olc_re//go; - $query =~ s/$mlc_re//go; - $query =~ s/\Ause \S+\Z/use ?/i # Abstract the DB in USE - && return $query; - - $query =~ s/\\["']//g; # quoted strings - $query =~ s/".*?"/?/sg; # quoted strings - $query =~ s/'.*?'/?/sg; # quoted strings - - if ( $self->{match_md5_checksums} ) { - $query =~ s/([._-])[a-f0-9]{32}/$1?/g; - } - - if ( !$self->{match_embedded_numbers} ) { - $query =~ s/[0-9+-][0-9a-f.xb+-]*/?/g; - } - else { - $query =~ s/\b[0-9+-][0-9a-f.xb+-]*/?/g; - } - - if ( $self->{match_md5_checksums} ) { - $query =~ s/[xb+-]\?/?/g; - } - else { - $query =~ s/[xb.+-]\?/?/g; - } - - $query =~ s/\A\s+//; # Chop off leading whitespace - chomp $query; # Kill trailing whitespace - $query =~ tr[ \n\t\r\f][ ]s; # Collapse whitespace - $query = lc $query; - $query =~ s/\bnull\b/?/g; # Get rid of NULLs - $query =~ s{ # Collapse IN and VALUES lists - \b(in|values?)(?:[\s,]*\([\s?,]*\))+ - } - {$1(?+)}gx; - $query =~ s{ # Collapse UNION - \b(select\s.*?)(?:(\sunion(?:\sall)?)\s\1)+ - } - {$1 /*repeat$2*/}xg; - $query =~ s/\blimit \?(?:, ?\?| offset \?)?/limit ?/; # LIMIT - - if ( $query =~ m/\bORDER BY /gi ) { # Find, anchor on ORDER BY clause - 1 while $query =~ s/\G(.+?)\s+ASC/$1/gi && pos $query; - } - - return $query; -} - -sub distill_verbs { - my ( $self, $query ) = @_; - - $query =~ m/\A\s*call\s+(\S+)\(/i && return "CALL $1"; - $query =~ m/\A\s*use\s+/ && return "USE"; - $query =~ m/\A\s*UNLOCK TABLES/i && return "UNLOCK"; - $query =~ m/\A\s*xa\s+(\S+)/i && return "XA_$1"; - - if ( $query =~ m/\Aadministrator command:/ ) { - $query =~ s/administrator command:/ADMIN/; - $query = uc $query; - return $query; - } - - $query = $self->strip_comments($query); - - if ( $query =~ m/\A\s*SHOW\s+/i ) { - PTDEBUG && _d($query); - - $query = uc $query; - $query =~ s/\s+(?:GLOBAL|SESSION|FULL|STORAGE|ENGINE)\b/ /g; - $query =~ s/\s+COUNT[^)]+\)//g; - - $query =~ s/\s+(?:FOR|FROM|LIKE|WHERE|LIMIT|IN)\b.+//ms; - - $query =~ s/\A(SHOW(?:\s+\S+){1,2}).*\Z/$1/s; - $query =~ s/\s+/ /g; - PTDEBUG && _d($query); - return $query; - } - - eval $QueryParser::data_def_stmts; - eval $QueryParser::tbl_ident; - my ( $dds ) = $query =~ /^\s*($QueryParser::data_def_stmts)\b/i; - if ( $dds) { - my ( $obj ) = $query =~ m/$dds.+(DATABASE|TABLE)\b/i; - $obj = uc $obj if $obj; - PTDEBUG && _d('Data def statment:', $dds, 'obj:', $obj); - my ($db_or_tbl) - = $query =~ m/(?:TABLE|DATABASE)\s+($QueryParser::tbl_ident)(\s+.*)?/i; - PTDEBUG && _d('Matches db or table:', $db_or_tbl); - return uc($dds . ($obj ? " $obj" : '')), $db_or_tbl; - } - - my @verbs = $query =~ m/\b($verbs)\b/gio; - @verbs = do { - my $last = ''; - grep { my $pass = $_ ne $last; $last = $_; $pass } map { uc } @verbs; - }; - - if ( ($verbs[0] || '') eq 'SELECT' && @verbs > 1 ) { - PTDEBUG && _d("False-positive verbs after SELECT:", @verbs[1..$#verbs]); - my $union = grep { $_ eq 'UNION' } @verbs; - @verbs = $union ? qw(SELECT UNION) : qw(SELECT); - } - - my $verb_str = join(q{ }, @verbs); - return $verb_str; -} - -sub __distill_tables { - my ( $self, $query, $table, %args ) = @_; - my $qp = $args{QueryParser} || $self->{QueryParser}; - die "I need a QueryParser argument" unless $qp; - - my @tables = map { - $_ =~ s/`//g; - $_ =~ s/(_?)[0-9]+/$1?/g; - $_; - } grep { defined $_ } $qp->get_tables($query); - - push @tables, $table if $table; - - @tables = do { - my $last = ''; - grep { my $pass = $_ ne $last; $last = $_; $pass } @tables; - }; - - return @tables; -} - -sub distill { - my ( $self, $query, %args ) = @_; - - if ( $args{generic} ) { - my ($cmd, $arg) = $query =~ m/^(\S+)\s+(\S+)/; - return '' unless $cmd; - $query = (uc $cmd) . ($arg ? " $arg" : ''); - } - else { - my ($verbs, $table) = $self->distill_verbs($query, %args); - - if ( $verbs && $verbs =~ m/^SHOW/ ) { - my %alias_for = qw( - SCHEMA DATABASE - KEYS INDEX - INDEXES INDEX - ); - map { $verbs =~ s/$_/$alias_for{$_}/ } keys %alias_for; - $query = $verbs; - } - else { - my @tables = $self->__distill_tables($query, $table, %args); - $query = join(q{ }, $verbs, @tables); - } - } - - if ( $args{trf} ) { - $query = $args{trf}->($query, %args); - } - - return $query; -} - -sub convert_to_select { - my ( $self, $query ) = @_; - return unless $query; - - return if $query =~ m/=\s*\(\s*SELECT /i; - - $query =~ s{ - \A.*? - update(?:\s+(?:low_priority|ignore))?\s+(.*?) - \s+set\b(.*?) - (?:\s*where\b(.*?))? - (limit\s*[0-9]+(?:\s*,\s*[0-9]+)?)? - \Z - } - {__update_to_select($1, $2, $3, $4)}exsi - || $query =~ s{ - \A.*? - (?:insert(?:\s+ignore)?|replace)\s+ - .*?\binto\b(.*?)\(([^\)]+)\)\s* - values?\s*(\(.*?\))\s* - (?:\blimit\b|on\s+duplicate\s+key.*)?\s* - \Z - } - {__insert_to_select($1, $2, $3)}exsi - || $query =~ s{ - \A.*? - (?:insert(?:\s+ignore)?|replace)\s+ - (?:.*?\binto)\b(.*?)\s* - set\s+(.*?)\s* - (?:\blimit\b|on\s+duplicate\s+key.*)?\s* - \Z - } - {__insert_to_select_with_set($1, $2)}exsi - || $query =~ s{ - \A.*? - delete\s+(.*?) - \bfrom\b(.*) - \Z - } - {__delete_to_select($1, $2)}exsi; - $query =~ s/\s*on\s+duplicate\s+key\s+update.*\Z//si; - $query =~ s/\A.*?(?=\bSELECT\s*\b)//ism; - return $query; -} - -sub convert_select_list { - my ( $self, $query ) = @_; - $query =~ s{ - \A\s*select(.*?)\bfrom\b - } - {$1 =~ m/\*/ ? "select 1 from" : "select isnull(coalesce($1)) from"}exi; - return $query; -} - -sub __delete_to_select { - my ( $delete, $join ) = @_; - if ( $join =~ m/\bjoin\b/ ) { - return "select 1 from $join"; - } - return "select * from $join"; -} - -sub __insert_to_select { - my ( $tbl, $cols, $vals ) = @_; - PTDEBUG && _d('Args:', @_); - my @cols = split(/,/, $cols); - PTDEBUG && _d('Cols:', @cols); - $vals =~ s/^\(|\)$//g; # Strip leading/trailing parens - my @vals = $vals =~ m/($quote_re|[^,]*${bal}[^,]*|[^,]+)/g; - PTDEBUG && _d('Vals:', @vals); - if ( @cols == @vals ) { - return "select * from $tbl where " - . join(' and ', map { "$cols[$_]=$vals[$_]" } (0..$#cols)); - } - else { - return "select * from $tbl limit 1"; - } -} - -sub __insert_to_select_with_set { - my ( $from, $set ) = @_; - $set =~ s/,/ and /g; - return "select * from $from where $set "; -} - -sub __update_to_select { - my ( $from, $set, $where, $limit ) = @_; - return "select $set from $from " - . ( $where ? "where $where" : '' ) - . ( $limit ? " $limit " : '' ); -} - -sub wrap_in_derived { - my ( $self, $query ) = @_; - return unless $query; - return $query =~ m/\A\s*select/i - ? "select 1 from ($query) as x limit 1" - : $query; -} - -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 QueryRewriter package -# ########################################################################### - -# ########################################################################### -# Transformers package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Transformers.pm -# t/lib/Transformers.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Transformers; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Time::Local qw(timegm timelocal); -use Digest::MD5 qw(md5_hex); -use B qw(); - -BEGIN { - require Exporter; - our @ISA = qw(Exporter); - our %EXPORT_TAGS = (); - our @EXPORT = (); - our @EXPORT_OK = qw( - micro_t - percentage_of - secs_to_time - time_to_secs - shorten - ts - parse_timestamp - unix_timestamp - any_unix_timestamp - make_checksum - crc32 - encode_json - ); -} - -our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/; -our $proper_ts = qr/(\d\d\d\d)-(\d\d)-(\d\d)[T ](\d\d):(\d\d):(\d\d)(\.\d+)?/; -our $n_ts = qr/(\d{1,5})([shmd]?)/; # Limit \d{1,5} because \d{6} looks - -sub micro_t { - my ( $t, %args ) = @_; - my $p_ms = defined $args{p_ms} ? $args{p_ms} : 0; # precision for ms vals - my $p_s = defined $args{p_s} ? $args{p_s} : 0; # precision for s vals - my $f; - - $t = 0 if $t < 0; - - $t = sprintf('%.17f', $t) if $t =~ /e/; - - $t =~ s/\.(\d{1,6})\d*/\.$1/; - - if ($t > 0 && $t <= 0.000999) { - $f = ($t * 1000000) . 'us'; - } - elsif ($t >= 0.001000 && $t <= 0.999999) { - $f = sprintf("%.${p_ms}f", $t * 1000); - $f = ($f * 1) . 'ms'; # * 1 to remove insignificant zeros - } - elsif ($t >= 1) { - $f = sprintf("%.${p_s}f", $t); - $f = ($f * 1) . 's'; # * 1 to remove insignificant zeros - } - else { - $f = 0; # $t should = 0 at this point - } - - return $f; -} - -sub percentage_of { - my ( $is, $of, %args ) = @_; - my $p = $args{p} || 0; # float precision - my $fmt = $p ? "%.${p}f" : "%d"; - return sprintf $fmt, ($is * 100) / ($of ||= 1); -} - -sub secs_to_time { - my ( $secs, $fmt ) = @_; - $secs ||= 0; - return '00:00' unless $secs; - - $fmt ||= $secs >= 86_400 ? 'd' - : $secs >= 3_600 ? 'h' - : 'm'; - - return - $fmt eq 'd' ? sprintf( - "%d+%02d:%02d:%02d", - int($secs / 86_400), - int(($secs % 86_400) / 3_600), - int(($secs % 3_600) / 60), - $secs % 60) - : $fmt eq 'h' ? sprintf( - "%02d:%02d:%02d", - int(($secs % 86_400) / 3_600), - int(($secs % 3_600) / 60), - $secs % 60) - : sprintf( - "%02d:%02d", - int(($secs % 3_600) / 60), - $secs % 60); -} - -sub time_to_secs { - my ( $val, $default_suffix ) = @_; - die "I need a val argument" unless defined $val; - my $t = 0; - my ( $prefix, $num, $suffix ) = $val =~ m/([+-]?)(\d+)([a-z])?$/; - $suffix = $suffix || $default_suffix || 's'; - if ( $suffix =~ m/[smhd]/ ) { - $t = $suffix eq 's' ? $num * 1 # Seconds - : $suffix eq 'm' ? $num * 60 # Minutes - : $suffix eq 'h' ? $num * 3600 # Hours - : $num * 86400; # Days - - $t *= -1 if $prefix && $prefix eq '-'; - } - else { - die "Invalid suffix for $val: $suffix"; - } - return $t; -} - -sub shorten { - my ( $num, %args ) = @_; - my $p = defined $args{p} ? $args{p} : 2; # float precision - my $d = defined $args{d} ? $args{d} : 1_024; # divisor - my $n = 0; - my @units = ('', qw(k M G T P E Z Y)); - while ( $num >= $d && $n < @units - 1 ) { - $num /= $d; - ++$n; - } - return sprintf( - $num =~ m/\./ || $n - ? "%.${p}f%s" - : '%d', - $num, $units[$n]); -} - -sub ts { - my ( $time, $gmt ) = @_; - my ( $sec, $min, $hour, $mday, $mon, $year ) - = $gmt ? gmtime($time) : localtime($time); - $mon += 1; - $year += 1900; - my $val = sprintf("%d-%02d-%02dT%02d:%02d:%02d", - $year, $mon, $mday, $hour, $min, $sec); - if ( my ($us) = $time =~ m/(\.\d+)$/ ) { - $us = sprintf("%.6f", $us); - $us =~ s/^0\././; - $val .= $us; - } - return $val; -} - -sub parse_timestamp { - my ( $val ) = @_; - if ( my($y, $m, $d, $h, $i, $s, $f) - = $val =~ m/^$mysql_ts$/ ) - { - return sprintf "%d-%02d-%02d %02d:%02d:" - . (defined $f ? '%09.6f' : '%02d'), - $y + 2000, $m, $d, $h, $i, (defined $f ? $s + $f : $s); - } - elsif ( $val =~ m/^$proper_ts$/ ) { - return $val; - } - return $val; -} - -sub unix_timestamp { - my ( $val, $gmt ) = @_; - if ( my($y, $m, $d, $h, $i, $s, $us) = $val =~ m/^$proper_ts$/ ) { - $val = $gmt - ? timegm($s, $i, $h, $d, $m - 1, $y) - : timelocal($s, $i, $h, $d, $m - 1, $y); - if ( defined $us ) { - $us = sprintf('%.6f', $us); - $us =~ s/^0\././; - $val .= $us; - } - } - return $val; -} - -sub any_unix_timestamp { - my ( $val, $callback ) = @_; - - if ( my ($n, $suffix) = $val =~ m/^$n_ts$/ ) { - $n = $suffix eq 's' ? $n # Seconds - : $suffix eq 'm' ? $n * 60 # Minutes - : $suffix eq 'h' ? $n * 3600 # Hours - : $suffix eq 'd' ? $n * 86400 # Days - : $n; # default: Seconds - PTDEBUG && _d('ts is now - N[shmd]:', $n); - return time - $n; - } - elsif ( $val =~ m/^\d{9,}/ ) { - PTDEBUG && _d('ts is already a unix timestamp'); - return $val; - } - elsif ( my ($ymd, $hms) = $val =~ m/^(\d{6})(?:\s+(\d+:\d+:\d+))?/ ) { - PTDEBUG && _d('ts is MySQL slow log timestamp'); - $val .= ' 00:00:00' unless $hms; - return unix_timestamp(parse_timestamp($val)); - } - elsif ( ($ymd, $hms) = $val =~ m/^(\d{4}-\d\d-\d\d)(?:[T ](\d+:\d+:\d+))?/) { - PTDEBUG && _d('ts is properly formatted timestamp'); - $val .= ' 00:00:00' unless $hms; - return unix_timestamp($val); - } - else { - PTDEBUG && _d('ts is MySQL expression'); - return $callback->($val) if $callback && ref $callback eq 'CODE'; - } - - PTDEBUG && _d('Unknown ts type:', $val); - return; -} - -sub make_checksum { - my ( $val ) = @_; - my $checksum = uc substr(md5_hex($val), -16); - PTDEBUG && _d($checksum, 'checksum for', $val); - return $checksum; -} - -sub crc32 { - my ( $string ) = @_; - return unless $string; - my $poly = 0xEDB88320; - my $crc = 0xFFFFFFFF; - foreach my $char ( split(//, $string) ) { - my $comp = ($crc ^ ord($char)) & 0xFF; - for ( 1 .. 8 ) { - $comp = $comp & 1 ? $poly ^ ($comp >> 1) : $comp >> 1; - } - $crc = (($crc >> 8) & 0x00FFFFFF) ^ $comp; - } - return $crc ^ 0xFFFFFFFF; -} - -my $got_json = eval { require JSON }; -sub encode_json { - return JSON::encode_json(@_) if $got_json; - my ( $data ) = @_; - return (object_to_json($data) || ''); -} - - -sub object_to_json { - my ($obj) = @_; - my $type = ref($obj); - - if($type eq 'HASH'){ - return hash_to_json($obj); - } - elsif($type eq 'ARRAY'){ - return array_to_json($obj); - } - else { - return value_to_json($obj); - } -} - -sub hash_to_json { - my ($obj) = @_; - my @res; - for my $k ( sort { $a cmp $b } keys %$obj ) { - push @res, string_to_json( $k ) - . ":" - . ( object_to_json( $obj->{$k} ) || value_to_json( $obj->{$k} ) ); - } - return '{' . ( @res ? join( ",", @res ) : '' ) . '}'; -} - -sub array_to_json { - my ($obj) = @_; - my @res; - - for my $v (@$obj) { - push @res, object_to_json($v) || value_to_json($v); - } - - return '[' . ( @res ? join( ",", @res ) : '' ) . ']'; -} - -sub value_to_json { - my ($value) = @_; - - return 'null' if(!defined $value); - - my $b_obj = B::svref_2object(\$value); # for round trip problem - my $flags = $b_obj->FLAGS; - return $value # as is - if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? - - my $type = ref($value); - - if( !$type ) { - return string_to_json($value); - } - else { - return 'null'; - } - -} - -my %esc = ( - "\n" => '\n', - "\r" => '\r', - "\t" => '\t', - "\f" => '\f', - "\b" => '\b', - "\"" => '\"', - "\\" => '\\\\', - "\'" => '\\\'', -); - -sub string_to_json { - my ($arg) = @_; - - $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g; - $arg =~ s/\//\\\//g; - $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg; - - utf8::upgrade($arg); - utf8::encode($arg); - - return '"' . $arg . '"'; -} - -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 Transformers package -# ########################################################################### - -# ########################################################################### -# Daemon package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Daemon.pm -# t/lib/Daemon.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Daemon; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use POSIX qw(setsid); - -sub new { - my ( $class, %args ) = @_; - foreach my $arg ( qw(o) ) { - die "I need a $arg argument" unless $args{$arg}; - } - my $o = $args{o}; - my $self = { - o => $o, - log_file => $o->has('log') ? $o->get('log') : undef, - PID_file => $o->has('pid') ? $o->get('pid') : undef, - }; - - check_PID_file(undef, $self->{PID_file}); - - PTDEBUG && _d('Daemonized child will log to', $self->{log_file}); - return bless $self, $class; -} - -sub daemonize { - my ( $self ) = @_; - - PTDEBUG && _d('About to fork and daemonize'); - defined (my $pid = fork()) or die "Cannot fork: $OS_ERROR"; - if ( $pid ) { - PTDEBUG && _d('Parent PID', $PID, 'exiting after forking child PID',$pid); - exit; - } - - PTDEBUG && _d('Daemonizing child PID', $PID); - $self->{PID_owner} = $PID; - $self->{child} = 1; - - POSIX::setsid() or die "Cannot start a new session: $OS_ERROR"; - chdir '/' or die "Cannot chdir to /: $OS_ERROR"; - - $self->_make_PID_file(); - - $OUTPUT_AUTOFLUSH = 1; - - PTDEBUG && _d('Redirecting STDIN to /dev/null'); - close STDIN; - open STDIN, '/dev/null' - or die "Cannot reopen STDIN to /dev/null: $OS_ERROR"; - - if ( $self->{log_file} ) { - PTDEBUG && _d('Redirecting STDOUT and STDERR to', $self->{log_file}); - close STDOUT; - open STDOUT, '>>', $self->{log_file} - or die "Cannot open log file $self->{log_file}: $OS_ERROR"; - - close STDERR; - open STDERR, ">&STDOUT" - or die "Cannot dupe STDERR to STDOUT: $OS_ERROR"; - } - else { - if ( -t STDOUT ) { - PTDEBUG && _d('No log file and STDOUT is a terminal;', - 'redirecting to /dev/null'); - close STDOUT; - open STDOUT, '>', '/dev/null' - or die "Cannot reopen STDOUT to /dev/null: $OS_ERROR"; - } - if ( -t STDERR ) { - PTDEBUG && _d('No log file and STDERR is a terminal;', - 'redirecting to /dev/null'); - close STDERR; - open STDERR, '>', '/dev/null' - or die "Cannot reopen STDERR to /dev/null: $OS_ERROR"; - } - } - - return; -} - -sub check_PID_file { - my ( $self, $file ) = @_; - my $PID_file = $self ? $self->{PID_file} : $file; - PTDEBUG && _d('Checking PID file', $PID_file); - if ( $PID_file && -f $PID_file ) { - my $pid; - eval { - chomp($pid = (slurp_file($PID_file) || '')); - }; - if ( $EVAL_ERROR ) { - die "The PID file $PID_file already exists but it cannot be read: " - . $EVAL_ERROR; - } - PTDEBUG && _d('PID file exists; it contains PID', $pid); - if ( $pid ) { - my $pid_is_alive = kill 0, $pid; - if ( $pid_is_alive ) { - die "The PID file $PID_file already exists " - . " and the PID that it contains, $pid, is running"; - } - else { - warn "Overwriting PID file $PID_file because the PID that it " - . "contains, $pid, is not running"; - } - } - else { - die "The PID file $PID_file already exists but it does not " - . "contain a PID"; - } - } - else { - PTDEBUG && _d('No PID file'); - } - return; -} - -sub make_PID_file { - my ( $self ) = @_; - if ( exists $self->{child} ) { - die "Do not call Daemon::make_PID_file() for daemonized scripts"; - } - $self->_make_PID_file(); - $self->{PID_owner} = $PID; - return; -} - -sub _make_PID_file { - my ( $self ) = @_; - - my $PID_file = $self->{PID_file}; - if ( !$PID_file ) { - PTDEBUG && _d('No PID file to create'); - return; - } - - $self->check_PID_file(); - - open my $PID_FH, '>', $PID_file - or die "Cannot open PID file $PID_file: $OS_ERROR"; - print $PID_FH $PID - or die "Cannot print to PID file $PID_file: $OS_ERROR"; - close $PID_FH - or die "Cannot close PID file $PID_file: $OS_ERROR"; - - PTDEBUG && _d('Created PID file:', $self->{PID_file}); - return; -} - -sub _remove_PID_file { - my ( $self ) = @_; - if ( $self->{PID_file} && -f $self->{PID_file} ) { - unlink $self->{PID_file} - or warn "Cannot remove PID file $self->{PID_file}: $OS_ERROR"; - PTDEBUG && _d('Removed PID file'); - } - else { - PTDEBUG && _d('No PID to remove'); - } - return; -} - -sub DESTROY { - my ( $self ) = @_; - - $self->_remove_PID_file() if ($self->{PID_owner} || 0) == $PID; - - return; -} - -sub slurp_file { - my ($file) = @_; - return unless $file; - open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; - return do { local $/; <$fh> }; -} - -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 Daemon package -# ########################################################################### - -# ########################################################################### -# Advisor package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/Advisor.pm -# t/lib/Advisor.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package Advisor; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -sub new { - my ( $class, %args ) = @_; - foreach my $arg ( qw(match_type) ) { - die "I need a $arg argument" unless $args{$arg}; - } - - my $self = { - %args, - rules => [], # Rules from all advisor modules. - rule_index_for => {}, # Maps rules by ID to their array index in $rules. - rule_info => {}, # ID, severity, description, etc. for each rule. - }; - - return bless $self, $class; -} - -sub load_rules { - my ( $self, $advisor ) = @_; - return unless $advisor; - PTDEBUG && _d('Loading rules from', ref $advisor); - - my $i = scalar @{$self->{rules}}; - - RULE: - foreach my $rule ( $advisor->get_rules() ) { - my $id = $rule->{id}; - if ( $self->{ignore_rules}->{"$id"} ) { - PTDEBUG && _d("Ignoring rule", $id); - next RULE; - } - die "Rule $id already exists and cannot be redefined" - if defined $self->{rule_index_for}->{$id}; - push @{$self->{rules}}, $rule; - $self->{rule_index_for}->{$id} = $i++; - } - - return; -} - -sub load_rule_info { - my ( $self, $advisor ) = @_; - return unless $advisor; - PTDEBUG && _d('Loading rule info from', ref $advisor); - my $rules = $self->{rules}; - foreach my $rule ( @$rules ) { - my $id = $rule->{id}; - if ( $self->{ignore_rules}->{"$id"} ) { - die "Rule $id was loaded but should be ignored"; - } - my $rule_info = $advisor->get_rule_info($id); - next unless $rule_info; - die "Info for rule $id already exists and cannot be redefined" - if $self->{rule_info}->{$id}; - $self->{rule_info}->{$id} = $rule_info; - } - return; -} - - -sub run_rules { - my ( $self, %args ) = @_; - my @matched_rules; - my @matched_pos; - my $rules = $self->{rules}; - my $match_type = lc $self->{match_type}; - foreach my $rule ( @$rules ) { - eval { - my $match = $rule->{code}->(%args); - if ( $match_type eq 'pos' ) { - if ( defined $match ) { - PTDEBUG && _d('Matches rule', $rule->{id}, 'near pos', $match); - push @matched_rules, $rule->{id}; - push @matched_pos, $match; - } - } - elsif ( $match_type eq 'bool' ) { - if ( $match ) { - PTDEBUG && _d("Matches rule", $rule->{id}); - push @matched_rules, $rule->{id}; - } - } - }; - if ( $EVAL_ERROR ) { - warn "Code for rule $rule->{id} caused an error: $EVAL_ERROR"; - } - } - return \@matched_rules, \@matched_pos; -}; - - -sub get_rule_info { - my ( $self, $id ) = @_; - return unless $id; - return $self->{rule_info}->{$id}; -} - -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 Advisor package -# ########################################################################### - -# ########################################################################### -# AdvisorRules package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/AdvisorRules.pm -# t/lib/AdvisorRules.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package AdvisorRules; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -sub new { - my ( $class, %args ) = @_; - foreach my $arg ( qw(PodParser) ) { - die "I need a $arg argument" unless $args{$arg}; - } - my $self = { - %args, - rules => [], - rule_info => {}, - }; - return bless $self, $class; -} - -sub load_rule_info { - my ( $self, %args ) = @_; - foreach my $arg ( qw(file section ) ) { - die "I need a $arg argument" unless $args{$arg}; - } - my $rules = $args{rules} || $self->{rules}; - my $p = $self->{PodParser}; - - $p->parse_from_file($args{file}); - my $rule_items = $p->get_items($args{section}); - my %seen; - foreach my $rule_id ( keys %$rule_items ) { - my $rule = $rule_items->{$rule_id}; - die "Rule $rule_id has no description" unless $rule->{desc}; - die "Rule $rule_id has no severity" unless $rule->{severity}; - die "Rule $rule_id is already defined" - if exists $self->{rule_info}->{$rule_id}; - $self->{rule_info}->{$rule_id} = { - id => $rule_id, - severity => $rule->{severity}, - description => $rule->{desc}, - }; - } - - foreach my $rule ( @$rules ) { - die "There is no info for rule $rule->{id} in $args{file}" - unless $self->{rule_info}->{ $rule->{id} }; - } - - return; -} - -sub get_rule_info { - my ( $self, $id ) = @_; - return unless $id; - return $self->{rule_info}->{$id}; -} - -sub _reset_rule_info { - my ( $self ) = @_; - $self->{rule_info} = {}; - return; -} - -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 AdvisorRules package -# ########################################################################### - -# ########################################################################### -# QueryAdvisorRules package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/QueryAdvisorRules.pm -# t/lib/QueryAdvisorRules.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package QueryAdvisorRules; -use base 'AdvisorRules'; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -sub new { - my ( $class, %args ) = @_; - my $self = $class->SUPER::new(%args); - @{$self->{rules}} = $self->get_rules(); - PTDEBUG && _d(scalar @{$self->{rules}}, "rules"); - return $self; -} - -sub get_rules { - return - { - id => 'ALI.001', # Implicit alias - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - foreach my $tbl ( @$tbls ) { - return 0 if $tbl->{alias} && !$tbl->{explicit_alias}; - } - my $cols = $struct->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{alias} && !$col->{explicit_alias}; - } - return; - }, - }, - { - id => 'ALI.002', # tbl.* alias - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $cols = $event->{query_struct}->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{tbl} && $col->{col} eq '*' && $col->{alias}; - } - return; - }, - }, - { - id => 'ALI.003', # tbl AS tbl - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - foreach my $tbl ( @$tbls ) { - return 0 if $tbl->{alias} && $tbl->{alias} eq $tbl->{tbl}; - } - my $cols = $struct->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{alias} && $col->{alias} eq $col->{col}; - } - return; - }, - }, - { - id => 'ARG.001', # col = '%foo' - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $where = $event->{query_struct}->{where}; - return unless $where && @$where; - foreach my $arg ( @$where ) { - return 0 - if ($arg->{operator} || '') eq 'like' - && $arg->{right_arg} =~ m/[\'\"][\%\_]./; - } - return; - }, - }, - { - id => 'ARG.002', # LIKE w/o wildcard - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $where = $event->{query_struct}->{where}; - return unless $where && @$where; - foreach my $arg ( @$where ) { - return 0 - if ($arg->{operator} || '') eq 'like' - && $arg->{right_arg} !~ m/[%_]/; - } - return; - }, - }, - { - id => 'CLA.001', # SELECT w/o WHERE - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless ($event->{query_struct}->{type} || '') eq 'select'; - return unless $event->{query_struct}->{from}; - return 0 unless $event->{query_struct}->{where}; - return; - }, - }, - { - id => 'CLA.002', # ORDER BY RAND() - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $orderby = $event->{query_struct}->{order_by}; - return unless $orderby; - foreach my $ident ( @$orderby ) { - return 0 if $ident->{function} && $ident->{function} eq 'RAND'; - } - return; - }, - }, - { - id => 'CLA.003', # LIMIT w/ OFFSET - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless $event->{query_struct}->{limit}; - return unless defined $event->{query_struct}->{limit}->{offset}; - return 0; - }, - }, - { - id => 'CLA.004', # GROUP BY - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $groupby = $event->{query_struct}->{group_by}; - return unless $groupby; - foreach my $ident ( @$groupby ) { - return 0 if exists $ident->{position}; - } - return; - }, - }, - { - id => 'CLA.005', # ORDER BY col where col= - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $orderby = $event->{query_struct}->{order_by}; - return unless $orderby; - my $where = $event->{query_struct}->{where}; - return unless $where; - my %orderby_col = map { lc $_->{column} => 1 } - grep { $_->{column} } - @$orderby; - foreach my $pred ( @$where ) { - my $val = $pred->{right_arg}; - next unless $val; - return 0 if $val =~ m/^\d+$/ && $orderby_col{lc($pred->{left_arg} || '')}; - } - return; - }, - }, - { - id => 'CLA.006', # GROUP BY or ORDER BY different tables - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $groupby = $event->{query_struct}->{group_by}; - my $orderby = $event->{query_struct}->{order_by}; - return unless $groupby || $orderby; - - my %groupby_tbls = map { $_->{table} => 1 } - grep { $_->{table} } - @$groupby; - return 0 if scalar keys %groupby_tbls > 1; - - my %orderby_tbls = map { $_->{table} => 1 } - grep { $_->{table} } - @$orderby; - return 0 if scalar keys %orderby_tbls > 1; - - map { delete $groupby_tbls{$_} } keys %orderby_tbls; - return 0 if scalar keys %groupby_tbls; - - return; - }, - }, - { - id => 'CLA.007', # ORDER BY ASC/DESC mix can't use index - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $order_by = $event->{query_struct}->{order_by}; - return unless $order_by; - my ($asc, $desc) = (0, 0); - foreach my $col ( @$order_by ) { - if ( ($col->{sort} || 'ASC') eq 'ASC' ) { - $asc++; - } - else { - $desc++; - } - return 0 if $asc && $desc; - } - return; - }, - }, - { - id => 'COL.001', # SELECT * - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless ($event->{query_struct}->{type} || '') eq 'select'; - my $cols = $event->{query_struct}->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{col} eq '*' && !$col->{func}; - } - return; - }, - }, - { - id => 'COL.002', # INSERT w/o (cols) def - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $type = $event->{query_struct}->{type} || ''; - return unless $type eq 'insert' || $type eq 'replace'; - return 0 unless $event->{query_struct}->{columns}; - return; - }, - }, - { - id => 'LIT.001', # IP as string - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - if ( $event->{arg} =~ m/['"]\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/gc ) { - return (pos $event->{arg}) || 0; - } - return; - }, - }, - { - id => 'LIT.002', # Date not quoted - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - if ( $event->{arg} =~ m/(?{arg}) || 0; - } - if ( $event->{arg} =~ m/(?{arg}) || 0; - } - return; - }, - }, - { - id => 'KWR.001', # SQL_CALC_FOUND_ROWS - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return 0 if $event->{query_struct}->{keywords}->{sql_calc_found_rows}; - return; - }, - }, - { - id => 'JOI.001', # comma and ansi joins - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my $comma_join = 0; - my $ansi_join = 0; - foreach my $tbl ( @$tbls ) { - if ( $tbl->{join} ) { - if ( $tbl->{join}->{ansi} ) { - $ansi_join = 1; - } - else { - $comma_join = 1; - } - } - return 0 if $comma_join && $ansi_join; - } - return; - }, - }, - { - id => 'RES.001', # non-deterministic GROUP BY - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless ($event->{query_struct}->{type} || '') eq 'select'; - my $groupby = $event->{query_struct}->{group_by}; - return unless $groupby; - my %groupby_col = map { $_->{column} => 1 } - grep { $_->{column} } - @$groupby; - return unless scalar %groupby_col; - my $cols = [ - grep { _looks_like_column($_->{col}) } - grep { ! exists $_->{func} } - @{$event->{query_struct}->{columns}} - ]; - foreach my $col ( @$cols ) { - return 0 unless $groupby_col{ $col->{col} } - || ($col->{alias} && $groupby_col{ $col->{alias} }); - } - return; - }, - }, - { - id => 'RES.002', # non-deterministic LIMIT w/o ORDER BY - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless $event->{query_struct}->{limit}; - return unless $event->{query_struct}->{from} - || $event->{query_struct}->{into} - || $event->{query_struct}->{tables}; - return 0 unless $event->{query_struct}->{order_by}; - return; - }, - }, - { - id => 'STA.001', # != instead of <> - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return 0 if $event->{arg} =~ m/!=/; - return; - }, - }, - { - id => 'SUB.001', # IN() - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - if ( $event->{arg} =~ m/\bIN\s*\(\s*SELECT\b/gi ) { - return pos $event->{arg}; - } - return; - }, - }, - { - id => 'JOI.002', # table joined more than once, but not self-join - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - return unless $struct; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my %tbl_cnt; - my $n_tbls = scalar @$tbls; - - for my $i ( 0..($n_tbls-1) ) { - my $tbl = $tbls->[$i]; - my $tbl_name = lc $tbl->{tbl}; - - $tbl_cnt{$tbl_name}->{cnt}++; - $tbl_cnt{$tbl_name}->{ansi_join}++ - if $tbl->{join} && $tbl->{join}->{ansi}; - $tbl_cnt{$tbl_name}->{comma_join}++ - if $tbl->{join} && !$tbl->{join}->{ansi}; - - if ( $tbl_cnt{$tbl_name}->{cnt} > 1 ) { - return 0 - if $tbl_cnt{$tbl_name}->{ansi_join} - && $tbl_cnt{$tbl_name}->{comma_join}; - } - } - return; - }, - }, - { - id => 'JOI.003', # OUTER JOIN converted to INNER JOIN - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - return unless $struct; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my $where = $struct->{where}; - return unless $where; - - my %outer_tbls = map { $_->{tbl} => 1 } get_outer_tables($tbls); - PTDEBUG && _d("Outer tables:", keys %outer_tbls); - return unless %outer_tbls; - - foreach my $pred ( @$where ) { - next unless $pred->{left_arg}; # skip constants like 1 in "WHERE 1" - my ($tbl, $col) = split /\./, $pred->{left_arg}; - if ( $tbl && $col && $outer_tbls{$tbl} ) { - if ($pred->{operator} ne 'is' || $pred->{right_arg} !~ m/null/i) - { - PTDEBUG && _d("Predicate prevents OUTER JOIN:", - map { $pred->{$_} } qw(left_arg operator right_arg)); - return 0; - } - } - } - - return; - } - }, - { - id => 'JOI.004', # broken exclusion join - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - return unless $struct; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my $where = $struct->{where}; - return unless $where; - - my %outer_tbls; - my %outer_tbl_join_cols; - my @unknown_join_cols; - foreach my $outer_tbl ( get_outer_tables($tbls) ) { - $outer_tbls{$outer_tbl->{tbl}} = 1; - - my $join = $outer_tbl->{join}; - if ( !$join ) { - my ($inner_tbl) = grep { - exists $_->{join} - && $_->{join}->{to} eq $outer_tbl->{tbl} - } @$tbls; - $join = $inner_tbl->{join}; - die "Cannot find join structure for $outer_tbl->{tbl}" - unless $join; - } - - if ( $join->{condition} eq 'using' ) { - %outer_tbl_join_cols = map { $_ => 1 } @{$join->{columns}}; - } - else { - my $where = $join->{where}; - die "Join structure for ON condition has no where structure" - unless $where; - my @join_cols; - foreach my $pred ( @$where ) { - next unless $pred->{operator} eq '='; - push @join_cols, $pred->{left_arg}, $pred->{right_arg}; - } - PTDEBUG && _d("Join columns:", @join_cols); - foreach my $join_col ( @join_cols ) { - my ($tbl, $col) = split /\./, $join_col; - if ( !$col ) { - $col = $tbl; - $tbl = determine_table_for_column( - column => $col, - tbl_structs => $event->{tbl_structs}, - ); - } - if ( !$tbl ) { - PTDEBUG && _d("Cannot determine the table for join column", - $col); - push @unknown_join_cols, $col; - } - else { - $outer_tbl_join_cols{$col} = 1 - if $tbl eq $outer_tbl->{tbl}; - } - } - } - } - PTDEBUG && _d("Outer table join columns:", keys %outer_tbl_join_cols); - PTDEBUG && _d("Unknown join columns:", @unknown_join_cols); - - foreach my $pred ( @$where ) { - next unless $pred->{left_arg}; # skip constants like 1 in "WHERE 1" - next unless $pred->{operator} eq 'is' - && $pred->{right_arg} =~ m/NULL/i; - - my ($tbl, $col) = split /\./, $pred->{left_arg}; - if ( !$col ) { - $col = $tbl; - $tbl = determine_table_for_column( - column => $col, - tbl_structs => $event->{tbl_structs}, - ); - } - next unless $tbl; # can't check tbl if tbl is unknown - next unless $outer_tbls{$tbl}; # only want outer tbl cols - - next if $outer_tbl_join_cols{$col}; - - return 0 unless grep { $col eq $_ } @unknown_join_cols; - } - - return; # rule does not match, as best as we can determine - } - }, -}; - - -sub get_outer_tables { - my ( $tbls ) = @_; - return unless $tbls; - my @outer_tbls; - my $n_tbls = scalar @$tbls; - for my $i( 0..($n_tbls-1) ) { - my $tbl = $tbls->[$i]; - next unless $tbl->{join} && $tbl->{join}->{type} =~ m/left|right/i; - push @outer_tbls, - $tbl->{join}->{type} =~ m/left/i ? $tbl - : $tbls->[$i - 1]; - } - return @outer_tbls; -} - - -sub determine_table_for_column { - my ( %args ) = @_; - my @required_args = qw(column); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($col) = @args{@required_args}; - - my $tbl_structs = $args{tbl_structs}; - return unless $tbl_structs; - - foreach my $db ( keys %$tbl_structs ) { - foreach my $tbl ( keys %{$tbl_structs->{$db}} ) { - if ( $tbl_structs->{$db}->{$tbl}->{is_col}->{$col} ) { - PTDEBUG && _d($col, "column belongs to", $db, $tbl); - return $tbl; - } - } - } - - PTDEBUG && _d("Cannot determine table for column", $col); - return; -} - -sub _looks_like_column { - my $col = shift; - return if $col eq '*' || uc($col) eq 'NULL'; - return if $col =~ /\A(?:\b[0-9]+\b|\@{1,2}.+)/; - return $col; -} - -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 QueryAdvisorRules package -# ########################################################################### - -# ########################################################################### -# PodParser package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/PodParser.pm -# t/lib/PodParser.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package PodParser; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -my %parse_items_from = ( - 'OPTIONS' => 1, - 'DSN OPTIONS' => 1, - 'RULES' => 1, -); - -my %item_pattern_for = ( - 'OPTIONS' => qr/--(.*)/, - 'DSN OPTIONS' => qr/\* (.)/, - 'RULES' => qr/(.*)/, -); - -my %section_has_rules = ( - 'OPTIONS' => 1, - 'DSN OPTIONS' => 0, - 'RULES' => 0, -); - -sub new { - my ( $class, %args ) = @_; - my $self = { - current_section => '', - current_item => '', - items => {}, # keyed off SECTION - magic => {}, # keyed off SECTION->magic ident (without MAGIC_) - magic_ident => '', # set when next para is a magic para - }; - return bless $self, $class; -} - -sub get_items { - my ( $self, $section ) = @_; - return $section ? $self->{items}->{$section} : $self->{items}; -} - -sub get_magic { - my ( $self, $section ) = @_; - return $section ? $self->{magic}->{$section} : $self->{magic}; -} - -sub parse_from_file { - my ( $self, $file ) = @_; - return unless $file; - PTDEBUG && _d('Parsing POD in', $file); - open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; - local $INPUT_RECORD_SEPARATOR = ''; # read paragraphs - my $para; - - 1 while defined($para = <$fh>) && $para !~ m/^=pod/; - die "$file does not contain =pod" unless $para; - - while ( defined($para = <$fh>) && $para !~ m/^=cut/ ) { - if ( $para =~ m/^=(head|item|over|back)/ ) { - my ($cmd, $name) = $para =~ m/^=(\w+)(?:\s+(.+))?/; - $name ||= ''; - PTDEBUG && _d('cmd:', $cmd, 'name:', $name); - $self->command($cmd, $name); - } - elsif ( $parse_items_from{$self->{current_section}} ) { - $self->textblock($para); - } - } - - close $fh; -} - -sub command { - my ( $self, $cmd, $name ) = @_; - - $name =~ s/\s+\Z//m; # Remove \n and blank line after name. - - if ( $cmd eq 'head1' ) { - PTDEBUG && _d('In section', $name); - $self->{current_section} = $name; - } - elsif ( $cmd eq 'over' ) { - if ( $parse_items_from{$name} ) { - PTDEBUG && _d('Start items in', $self->{current_section}); - $self->{items}->{$self->{current_section}} = {}; - } - } - elsif ( $cmd eq 'item' && $parse_items_from{$self->{current_section}} ) { - my $pat = $item_pattern_for{ $self->{current_section} }; - my ($item) = $name =~ m/$pat/; - if ( $item ) { - PTDEBUG && _d($self->{current_section}, 'item:', $item); - $self->{items}->{ $self->{current_section} }->{$item} = { - desc => '', # every item should have a desc - }; - $self->{current_item} = $item; - } - else { - warn "Item $name does not match $pat"; - } - } - elsif ( $cmd eq 'back' ) { - if ( $parse_items_from{$self->{current_section}} ) { - PTDEBUG && _d('End items in', $self->{current_section}); - } - } - else { - $self->{current_section} = ''; - } - - return; -} - -sub textblock { - my ( $self, $para ) = @_; - - return unless $self->{current_section} && $self->{current_item}; - - my $section = $self->{current_section}; - my $item = $self->{items}->{$section}->{ $self->{current_item} }; - - $para =~ s/\s+\Z//; - - if ( $para =~ m/^[a-z]\w+[:;] / ) { - PTDEBUG && _d('Item attributes:', $para); - map { - my ($attrib, $val) = split(/: /, $_); - $item->{$attrib} = defined $val ? $val : 1; - } split(/; /, $para); - } - else { - if ( $self->{magic_ident} ) { - - my ($leading_space) = $para =~ m/^(\s+)/; - my $indent = length($leading_space || ''); - if ( $indent ) { - $para =~ s/^\s{$indent}//mg; - $para =~ s/\s+$//; - PTDEBUG && _d("MAGIC", $self->{magic_ident}, "para:", $para); - $self->{magic}->{$self->{current_section}}->{$self->{magic_ident}} - = $para; - } - else { - PTDEBUG && _d("MAGIC", $self->{magic_ident}, - "para is not indented; treating as normal para"); - } - - $self->{magic_ident} = ''; # must unset this! - } - - PTDEBUG && _d('Item desc:', substr($para, 0, 40), - length($para) > 40 ? '...' : ''); - $para =~ s/\n+/ /g; - $item->{desc} .= $para; - - if ( $para =~ m/MAGIC_(\w+)/ ) { - $self->{magic_ident} = $1; # XXX - PTDEBUG && _d("MAGIC", $self->{magic_ident}, "follows"); - } - } - - return; -} - -sub verbatim { - my ( $self, $para ) = @_; - return; -} - -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 PodParser package -# ########################################################################### - -# ########################################################################### -# SQLParser package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/SQLParser.pm -# t/lib/SQLParser.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package SQLParser; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Data::Dumper; -$Data::Dumper::Indent = 1; -$Data::Dumper::Sortkeys = 1; -$Data::Dumper::Quotekeys = 0; - -my $quoted_ident = qr/`[^`]+`/; -my $unquoted_ident = qr/ - \@{0,2} # optional @ or @@ for variables - \w+ # the ident name - (?:\([^\)]*\))? # optional function params -/x; - -my $ident_alias = qr/ - \s+ # space before alias - (?:(AS)\s+)? # optional AS keyword - ((?>$quoted_ident|$unquoted_ident)) # alais -/xi; - -my $table_ident = qr/(?: - ((?:(?>$quoted_ident|$unquoted_ident)\.?){1,2}) # table - (?:$ident_alias)? # optional alias -)/xo; - -my $column_ident = qr/(?: - ((?:(?>$quoted_ident|$unquoted_ident|\*)\.?){1,3}) # column - (?:$ident_alias)? # optional alias -)/xo; - -my $function_ident = qr/ - \b - ( - \w+ # function name - \( # opening parenthesis - [^\)]+ # function args, if any - \) # closing parenthesis - ) -/x; - -my %ignore_function = ( - INDEX => 1, - KEY => 1, -); - -sub new { - my ( $class, %args ) = @_; - my $self = { - %args, - }; - return bless $self, $class; -} - -sub parse { - my ( $self, $query ) = @_; - return unless $query; - - my $allowed_types = qr/(?: - DELETE - |INSERT - |REPLACE - |SELECT - |UPDATE - |CREATE - )/xi; - - $query = $self->clean_query($query); - - my $type; - if ( $query =~ s/^(\w+)\s+// ) { - $type = lc $1; - PTDEBUG && _d('Query type:', $type); - die "Cannot parse " . uc($type) . " queries" - unless $type =~ m/$allowed_types/i; - } - else { - die "Query does not begin with a word"; # shouldn't happen - } - - $query = $self->normalize_keyword_spaces($query); - - my @subqueries; - if ( $query =~ m/(\(SELECT )/i ) { - PTDEBUG && _d('Removing subqueries'); - @subqueries = $self->remove_subqueries($query); - $query = shift @subqueries; - } - elsif ( $type eq 'create' && $query =~ m/\s+SELECT/ ) { - PTDEBUG && _d('CREATE..SELECT'); - ($subqueries[0]->{query}) = $query =~ m/\s+(SELECT .+)/; - $query =~ s/\s+SELECT.+//; - } - - my $parse_func = "parse_$type"; - my $struct = $self->$parse_func($query); - if ( !$struct ) { - PTDEBUG && _d($parse_func, 'failed to parse query'); - return; - } - $struct->{type} = $type; - $self->_parse_clauses($struct); - - if ( @subqueries ) { - PTDEBUG && _d('Parsing subqueries'); - foreach my $subquery ( @subqueries ) { - my $subquery_struct = $self->parse($subquery->{query}); - @{$subquery_struct}{keys %$subquery} = values %$subquery; - push @{$struct->{subqueries}}, $subquery_struct; - } - } - - PTDEBUG && _d('Query struct:', Dumper($struct)); - return $struct; -} - - -sub _parse_clauses { - my ( $self, $struct ) = @_; - foreach my $clause ( keys %{$struct->{clauses}} ) { - if ( $clause =~ m/ / ) { - (my $clause_no_space = $clause) =~ s/ /_/g; - $struct->{clauses}->{$clause_no_space} = $struct->{clauses}->{$clause}; - delete $struct->{clauses}->{$clause}; - $clause = $clause_no_space; - } - - my $parse_func = "parse_$clause"; - $struct->{$clause} = $self->$parse_func($struct->{clauses}->{$clause}); - - if ( $clause eq 'select' ) { - PTDEBUG && _d('Parsing subquery clauses'); - $struct->{select}->{type} = 'select'; - $self->_parse_clauses($struct->{select}); - } - } - return; -} - -sub clean_query { - my ( $self, $query ) = @_; - return unless $query; - - $query =~ s/^\s*--.*$//gm; # -- comments - $query =~ s/\s+/ /g; # extra spaces/flatten - $query =~ s!/\*.*?\*/!!g; # /* comments */ - $query =~ s/^\s+//; # leading spaces - $query =~ s/\s+$//; # trailing spaces - - return $query; -} - -sub normalize_keyword_spaces { - my ( $self, $query ) = @_; - - $query =~ s/\b(VALUE(?:S)?)\(/$1 (/i; - $query =~ s/\bON\(/on (/gi; - $query =~ s/\bUSING\(/using (/gi; - - $query =~ s/\(\s+SELECT\s+/(SELECT /gi; - - return $query; -} - -sub _parse_query { - my ( $self, $query, $keywords, $first_clause, $clauses ) = @_; - return unless $query; - my $struct = {}; - - 1 while $query =~ s/$keywords\s+/$struct->{keywords}->{lc $1}=1, ''/gie; - - my @clause = grep { defined $_ } - ($query =~ m/\G(.+?)(?:$clauses\s+|\Z)/gci); - - my $clause = $first_clause, - my $value = shift @clause; - $struct->{clauses}->{$clause} = $value; - PTDEBUG && _d('Clause:', $clause, $value); - - while ( @clause ) { - $clause = shift @clause; - $value = shift @clause; - $struct->{clauses}->{lc $clause} = $value; - PTDEBUG && _d('Clause:', $clause, $value); - } - - ($struct->{unknown}) = ($query =~ m/\G(.+)/); - - return $struct; -} - -sub parse_delete { - my ( $self, $query ) = @_; - if ( $query =~ s/FROM\s+//i ) { - my $keywords = qr/(LOW_PRIORITY|QUICK|IGNORE)/i; - my $clauses = qr/(FROM|WHERE|ORDER BY|LIMIT)/i; - return $self->_parse_query($query, $keywords, 'from', $clauses); - } - else { - die "DELETE without FROM: $query"; - } -} - -sub parse_insert { - my ( $self, $query ) = @_; - return unless $query; - my $struct = {}; - - my $keywords = qr/(LOW_PRIORITY|DELAYED|HIGH_PRIORITY|IGNORE)/i; - 1 while $query =~ s/$keywords\s+/$struct->{keywords}->{lc $1}=1, ''/gie; - - if ( $query =~ m/ON DUPLICATE KEY UPDATE (.+)/i ) { - my $values = $1; - die "No values after ON DUPLICATE KEY UPDATE: $query" unless $values; - $struct->{clauses}->{on_duplicate} = $values; - PTDEBUG && _d('Clause: on duplicate key update', $values); - - $query =~ s/\s+ON DUPLICATE KEY UPDATE.+//; - } - - if ( my @into = ($query =~ m/ - (?=.*?(?:VALUE|SE(?:T|LECT))) # Avoid a backtracking explosion - (?:INTO\s+)? # INTO, optional - (.+?)\s+ # table ref - (\([^\)]+\)\s+)? # column list, optional - (VALUE.?|SET|SELECT)\s+ # start of next caluse - /xgci) - ) { - my $tbl = shift @into; # table ref - $struct->{clauses}->{into} = $tbl; - PTDEBUG && _d('Clause: into', $tbl); - - my $cols = shift @into; # columns, maybe - if ( $cols ) { - $cols =~ s/[\(\)]//g; - $struct->{clauses}->{columns} = $cols; - PTDEBUG && _d('Clause: columns', $cols); - } - - my $next_clause = lc(shift @into); # VALUES, SET or SELECT - die "INSERT/REPLACE without clause after table: $query" - unless $next_clause; - $next_clause = 'values' if $next_clause eq 'value'; - my ($values) = ($query =~ m/\G(.+)/gci); - die "INSERT/REPLACE without values: $query" unless $values; - $struct->{clauses}->{$next_clause} = $values; - PTDEBUG && _d('Clause:', $next_clause, $values); - } - - ($struct->{unknown}) = ($query =~ m/\G(.+)/); - - return $struct; -} -{ - no warnings; - *parse_replace = \&parse_insert; -} - -sub parse_select { - my ( $self, $query ) = @_; - - my @keywords; - my $final_keywords = qr/(FOR UPDATE|LOCK IN SHARE MODE)/i; - 1 while $query =~ s/\s+$final_keywords/(push @keywords, $1), ''/gie; - - my $keywords = qr/( - 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 - )/xi; - my $clauses = qr/( - FROM - |WHERE - |GROUP\sBY - |HAVING - |ORDER\sBY - |LIMIT - |PROCEDURE - |INTO OUTFILE - )/xi; - my $struct = $self->_parse_query($query, $keywords, 'columns', $clauses); - - map { s/ /_/g; $struct->{keywords}->{lc $_} = 1; } @keywords; - - return $struct; -} - -sub parse_update { - my $keywords = qr/(LOW_PRIORITY|IGNORE)/i; - my $clauses = qr/(SET|WHERE|ORDER BY|LIMIT)/i; - return _parse_query(@_, $keywords, 'tables', $clauses); - -} - -sub parse_create { - my ($self, $query) = @_; - my ($obj, $name) = $query =~ m/ - (\S+)\s+ - (?:IF NOT EXISTS\s+)? - (\S+) - /xi; - return { - object => lc $obj, - name => $name, - unknown => undef, - }; -} - -sub parse_from { - my ( $self, $from ) = @_; - return unless $from; - PTDEBUG && _d('Parsing FROM', $from); - - my $using_cols; - ($from, $using_cols) = $self->remove_using_columns($from); - - my $funcs; - ($from, $funcs) = $self->remove_functions($from); - - my $comma_join = qr/(?>\s*,\s*)/; - my $ansi_join = qr/(?> - \s+ - (?:(?:INNER|CROSS|STRAIGHT_JOIN|LEFT|RIGHT|OUTER|NATURAL)\s+)* - JOIN - \s+ - )/xi; - - my @tbls; # all table refs, a hashref for each - my $tbl_ref; # current table ref hashref - my $join; # join info hahsref for current table ref - foreach my $thing ( split /($comma_join|$ansi_join)/io, $from ) { - die "Error parsing FROM clause" unless $thing; - - $thing =~ s/^\s+//; - $thing =~ s/\s+$//; - PTDEBUG && _d('Table thing:', $thing); - - if ( $thing =~ m/\s+(?:ON|USING)\s+/i ) { - PTDEBUG && _d("JOIN condition"); - my ($tbl_ref_txt, $join_condition_verb, $join_condition_value) - = $thing =~ m/^(.+?)\s+(ON|USING)\s+(.+)/i; - - $tbl_ref = $self->parse_table_reference($tbl_ref_txt); - - $join->{condition} = lc $join_condition_verb; - if ( $join->{condition} eq 'on' ) { - $join->{where} = $self->parse_where($join_condition_value, $funcs); - } - else { # USING - $join->{columns} = $self->_parse_csv(shift @$using_cols); - } - } - elsif ( $thing =~ m/(?:,|JOIN)/i ) { - if ( $join ) { - $tbl_ref->{join} = $join; - } - push @tbls, $tbl_ref; - PTDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); - - $tbl_ref = undef; - $join = {}; - - $join->{to} = $tbls[-1]->{tbl}; - if ( $thing eq ',' ) { - $join->{type} = 'inner'; - $join->{ansi} = 0; - } - else { # ansi join - my $type = $thing =~ m/^(.+?)\s+JOIN$/i ? lc $1 : 'inner'; - $join->{type} = $type; - $join->{ansi} = 1; - } - } - else { - $tbl_ref = $self->parse_table_reference($thing); - PTDEBUG && _d('Table reference:', Dumper($tbl_ref)); - } - } - - if ( $tbl_ref ) { - if ( $join ) { - $tbl_ref->{join} = $join; - } - push @tbls, $tbl_ref; - PTDEBUG && _d("Complete table reference:", Dumper($tbl_ref)); - } - - return \@tbls; -} - -sub parse_table_reference { - my ( $self, $tbl_ref ) = @_; - return unless $tbl_ref; - PTDEBUG && _d('Parsing table reference:', $tbl_ref); - my %tbl; - - if ( $tbl_ref =~ s/ - \s+( - (?:FORCE|USE|INGORE)\s - (?:INDEX|KEY) - \s*\([^\)]+\)\s* - )//xi) - { - $tbl{index_hint} = $1; - PTDEBUG && _d('Index hint:', $tbl{index_hint}); - } - - if ( $tbl_ref =~ m/$table_ident/ ) { - my ($db_tbl, $as, $alias) = ($1, $2, $3); # XXX - my $ident_struct = $self->parse_identifier('table', $db_tbl); - $alias =~ s/`//g if $alias; - @tbl{keys %$ident_struct} = values %$ident_struct; - $tbl{explicit_alias} = 1 if $as; - $tbl{alias} = $alias if $alias; - } - else { - die "Table ident match failed"; # shouldn't happen - } - - return \%tbl; -} -{ - no warnings; # Why? See same line above. - *parse_into = \&parse_from; - *parse_tables = \&parse_from; -} - -sub parse_where { - my ( $self, $where, $functions ) = @_; - return unless $where; - PTDEBUG && _d("Parsing WHERE", $where); - - my $op_symbol = qr/ - (?: - <=(?:>)? - |>= - |<> - |!= - |< - |> - |= - )/xi; - my $op_verb = qr/ - (?: - (?:(?:NOT\s)?LIKE) - |(?:IS(?:\sNOT\s)?) - |(?:(?:\sNOT\s)?BETWEEN) - |(?:(?:NOT\s)?IN) - ) - /xi; - my $op_pat = qr/ - ( - (?> - (?:$op_symbol) # don't need spaces around the symbols, e.g.: col=1 - |(?:\s+$op_verb) # must have space before verb op, e.g.: col LIKE ... - ) - )/x; - - my $offset = 0; - my $pred = ""; - my @pred; - my @has_op; - while ( $where =~ m/\b(and|or)\b/gi ) { - my $pos = (pos $where) - (length $1); # pos at and|or, not after - - $pred = substr $where, $offset, ($pos-$offset); - push @pred, $pred; - push @has_op, $pred =~ m/$op_pat/o ? 1 : 0; - - $offset = $pos; - } - $pred = substr $where, $offset; - push @pred, $pred; - push @has_op, $pred =~ m/$op_pat/o ? 1 : 0; - PTDEBUG && _d("Predicate fragments:", Dumper(\@pred)); - PTDEBUG && _d("Predicate frags with operators:", @has_op); - - my $n = scalar @pred - 1; - for my $i ( 1..$n ) { - $i *= -1; - my $j = $i - 1; # preceding pred frag - - next if $pred[$j] !~ m/\s+between\s+/i && $self->_is_constant($pred[$i]); - - if ( !$has_op[$i] ) { - $pred[$j] .= $pred[$i]; - $pred[$i] = undef; - } - } - PTDEBUG && _d("Predicate fragments joined:", Dumper(\@pred)); - - for my $i ( 0..@pred ) { - $pred = $pred[$i]; - next unless defined $pred; - my $n_single_quotes = ($pred =~ tr/'//); - my $n_double_quotes = ($pred =~ tr/"//); - if ( ($n_single_quotes % 2) || ($n_double_quotes % 2) ) { - $pred[$i] .= $pred[$i + 1]; - $pred[$i + 1] = undef; - } - } - PTDEBUG && _d("Predicate fragments balanced:", Dumper(\@pred)); - - my @predicates; - foreach my $pred ( @pred ) { - next unless defined $pred; - $pred =~ s/^\s+//; - $pred =~ s/\s+$//; - my $conj; - if ( $pred =~ s/^(and|or)\s+//i ) { - $conj = lc $1; - } - my ($col, $op, $val) = $pred =~ m/^(.+?)$op_pat(.+)$/o; - if ( !$col || !$op ) { - if ( $self->_is_constant($pred) ) { - $val = lc $pred; - } - else { - die "Failed to parse WHERE condition: $pred"; - } - } - - if ( $col ) { - $col =~ s/\s+$//; - $col =~ s/^\(+//; # no unquoted column name begins with ( - } - if ( $op ) { - $op = lc $op; - $op =~ s/^\s+//; - $op =~ s/\s+$//; - } - $val =~ s/^\s+//; - - if ( ($op || '') !~ m/IN/i && $val !~ m/^\w+\([^\)]+\)$/ ) { - $val =~ s/\)+$//; - } - - if ( $val =~ m/NULL|TRUE|FALSE/i ) { - $val = lc $val; - } - - if ( $functions ) { - $col = shift @$functions if $col =~ m/__FUNC\d+__/; - $val = shift @$functions if $val =~ m/__FUNC\d+__/; - } - - push @predicates, { - predicate => $conj, - left_arg => $col, - operator => $op, - right_arg => $val, - }; - } - - return \@predicates; -} - -sub _is_constant { - my ( $self, $val ) = @_; - return 0 unless defined $val; - $val =~ s/^\s*(?:and|or)\s+//; - return - $val =~ m/^\s*(?:TRUE|FALSE)\s*$/i || $val =~ m/^\s*-?\d+\s*$/ ? 1 : 0; -} - -sub parse_having { - my ( $self, $having ) = @_; - return $having; -} - -sub parse_group_by { - my ( $self, $group_by ) = @_; - return unless $group_by; - PTDEBUG && _d('Parsing GROUP BY', $group_by); - - my $with_rollup = $group_by =~ s/\s+WITH ROLLUP\s*//i; - - my $idents = $self->parse_identifiers( $self->_parse_csv($group_by) ); - - $idents->{with_rollup} = 1 if $with_rollup; - - return $idents; -} - -sub parse_order_by { - my ( $self, $order_by ) = @_; - return unless $order_by; - PTDEBUG && _d('Parsing ORDER BY', $order_by); - my $idents = $self->parse_identifiers( $self->_parse_csv($order_by) ); - return $idents; -} - -sub parse_limit { - my ( $self, $limit ) = @_; - return unless $limit; - my $struct = { - row_count => undef, - }; - if ( $limit =~ m/(\S+)\s+OFFSET\s+(\S+)/i ) { - $struct->{explicit_offset} = 1; - $struct->{row_count} = $1; - $struct->{offset} = $2; - } - else { - my ($offset, $cnt) = $limit =~ m/(?:(\S+),\s+)?(\S+)/i; - $struct->{row_count} = $cnt; - $struct->{offset} = $offset if defined $offset; - } - return $struct; -} - -sub parse_values { - my ( $self, $values ) = @_; - return unless $values; - $values =~ s/^\s*\(//; - $values =~ s/\s*\)//; - my $vals = $self->_parse_csv( - $values, - quoted_values => 1, - remove_quotes => 0, - ); - return $vals; -} - -sub parse_set { - my ( $self, $set ) = @_; - PTDEBUG && _d("Parse SET", $set); - return unless $set; - my $vals = $self->_parse_csv($set); - return unless $vals && @$vals; - - my @set; - foreach my $col_val ( @$vals ) { - my ($col, $val) = $col_val =~ m/^([^=]+)\s*=\s*(.+)/; - my $ident_struct = $self->parse_identifier('column', $col); - my $set_struct = { - %$ident_struct, - value => $val, - }; - PTDEBUG && _d("SET:", Dumper($set_struct)); - push @set, $set_struct; - } - return \@set; -} - -sub _parse_csv { - my ( $self, $vals, %args ) = @_; - return unless $vals; - - my @vals; - if ( $args{quoted_values} ) { - my $quote_char = ''; - VAL: - foreach my $val ( split(',', $vals) ) { - PTDEBUG && _d("Next value:", $val); - if ( $quote_char ) { - PTDEBUG && _d("Value is part of previous quoted value"); - $vals[-1] .= ",$val"; - - if ( $val =~ m/[^\\]*$quote_char$/ ) { - if ( $args{remove_quotes} ) { - $vals[-1] =~ s/^\s*$quote_char//; - $vals[-1] =~ s/$quote_char\s*$//; - } - PTDEBUG && _d("Previous quoted value is complete:", $vals[-1]); - $quote_char = ''; - } - - next VAL; - } - - $val =~ s/^\s+//; - - if ( $val =~ m/^(['"])/ ) { - PTDEBUG && _d("Value is quoted"); - $quote_char = $1; # XXX - if ( $val =~ m/.$quote_char$/ ) { - PTDEBUG && _d("Value is complete"); - $quote_char = ''; - if ( $args{remove_quotes} ) { - $vals[-1] =~ s/^\s*$quote_char//; - $vals[-1] =~ s/$quote_char\s*$//; - } - } - else { - PTDEBUG && _d("Quoted value is not complete"); - } - } - else { - $val =~ s/\s+$//; - } - - PTDEBUG && _d("Saving value", ($quote_char ? "fragment" : "")); - push @vals, $val; - } - } - else { - @vals = map { s/^\s+//; s/\s+$//; $_ } split(',', $vals); - } - - return \@vals; -} -{ - no warnings; # Why? See same line above. - *parse_on_duplicate = \&_parse_csv; -} - -sub parse_columns { - my ( $self, $cols ) = @_; - PTDEBUG && _d('Parsing columns list:', $cols); - - my @cols; - pos $cols = 0; - while (pos $cols < length $cols) { - if ($cols =~ m/\G\s*$column_ident\s*(?>,|\Z)/gcxo) { - my ($db_tbl_col, $as, $alias) = ($1, $2, $3); # XXX - my $ident_struct = $self->parse_identifier('column', $db_tbl_col); - $alias =~ s/`//g if $alias; - my $col_struct = { - %$ident_struct, - ($as ? (explicit_alias => 1) : ()), - ($alias ? (alias => $alias) : ()), - }; - push @cols, $col_struct; - } - else { - die "Column ident match failed"; # shouldn't happen - } - } - - return \@cols; -} - -sub remove_subqueries { - my ( $self, $query ) = @_; - - my @start_pos; - while ( $query =~ m/(\(SELECT )/gi ) { - my $pos = (pos $query) - (length $1); - push @start_pos, $pos; - } - - @start_pos = reverse @start_pos; - my @end_pos; - for my $i ( 0..$#start_pos ) { - my $closed = 0; - pos $query = $start_pos[$i]; - while ( $query =~ m/([\(\)])/cg ) { - my $c = $1; - $closed += ($c eq '(' ? 1 : -1); - last unless $closed; - } - push @end_pos, pos $query; - } - - my @subqueries; - my $len_adj = 0; - my $n = 0; - for my $i ( 0..$#start_pos ) { - PTDEBUG && _d('Query:', $query); - my $offset = $start_pos[$i]; - my $len = $end_pos[$i] - $start_pos[$i] - $len_adj; - PTDEBUG && _d("Subquery $n start", $start_pos[$i], - 'orig end', $end_pos[$i], 'adj', $len_adj, 'adj end', - $offset + $len, 'len', $len); - - my $struct = {}; - my $token = '__SQ' . $n . '__'; - my $subquery = substr($query, $offset, $len, $token); - PTDEBUG && _d("Subquery $n:", $subquery); - - my $outer_start = $start_pos[$i + 1]; - my $outer_end = $end_pos[$i + 1]; - if ( $outer_start && ($outer_start < $start_pos[$i]) - && $outer_end && ($outer_end > $end_pos[$i]) ) { - PTDEBUG && _d("Subquery $n nested in next subquery"); - $len_adj += $len - length $token; - $struct->{nested} = $i + 1; - } - else { - PTDEBUG && _d("Subquery $n not nested"); - $len_adj = 0; - if ( $subqueries[-1] && $subqueries[-1]->{nested} ) { - PTDEBUG && _d("Outermost subquery"); - } - } - - if ( $query =~ m/(?:=|>|<|>=|<=|<>|!=|<=>)\s*$token/ ) { - $struct->{context} = 'scalar'; - } - elsif ( $query =~ m/\b(?:IN|ANY|SOME|ALL|EXISTS)\s*$token/i ) { - if ( $query !~ m/\($token\)/ ) { - $query =~ s/$token/\($token\)/; - $len_adj -= 2 if $struct->{nested}; - } - $struct->{context} = 'list'; - } - else { - $struct->{context} = 'identifier'; - } - PTDEBUG && _d("Subquery $n context:", $struct->{context}); - - $subquery =~ s/^\s*\(//; - $subquery =~ s/\s*\)\s*$//; - - $struct->{query} = $subquery; - push @subqueries, $struct; - $n++; - } - - return $query, @subqueries; -} - -sub remove_using_columns { - my ($self, $from) = @_; - return unless $from; - PTDEBUG && _d('Removing cols from USING clauses'); - my $using = qr/ - \bUSING - \s* - \( - ([^\)]+) - \) - /xi; - my @cols; - $from =~ s/$using/push @cols, $1; "USING ($#cols)"/eg; - PTDEBUG && _d('FROM:', $from, Dumper(\@cols)); - return $from, \@cols; -} - -sub replace_function { - my ($func, $funcs) = @_; - my ($func_name) = $func =~ m/^(\w+)/; - if ( !$ignore_function{uc $func_name} ) { - my $n = scalar @$funcs; - push @$funcs, $func; - return "__FUNC${n}__"; - } - return $func; -} - -sub remove_functions { - my ($self, $clause) = @_; - return unless $clause; - PTDEBUG && _d('Removing functions from clause:', $clause); - my @funcs; - $clause =~ s/$function_ident/replace_function($1, \@funcs)/eg; - PTDEBUG && _d('Function-stripped clause:', $clause, Dumper(\@funcs)); - return $clause, \@funcs; -} - -sub parse_identifiers { - my ( $self, $idents ) = @_; - return unless $idents; - PTDEBUG && _d("Parsing identifiers"); - - my @ident_parts; - foreach my $ident ( @$idents ) { - PTDEBUG && _d("Identifier:", $ident); - my $parts = {}; - - if ( $ident =~ s/\s+(ASC|DESC)\s*$//i ) { - $parts->{sort} = uc $1; # XXX - } - - if ( $ident =~ m/^\d+$/ ) { # Position like 5 - PTDEBUG && _d("Positional ident"); - $parts->{position} = $ident; - } - elsif ( $ident =~ m/^\w+\(/ ) { # Function like MIN(col) - PTDEBUG && _d("Expression ident"); - my ($func, $expr) = $ident =~ m/^(\w+)\(([^\)]*)\)/; - $parts->{function} = uc $func; - $parts->{expression} = $expr if $expr; - } - else { # Ref like (table.)column - PTDEBUG && _d("Table/column ident"); - my ($tbl, $col) = $self->split_unquote($ident); - $parts->{table} = $tbl if $tbl; - $parts->{column} = $col; - } - push @ident_parts, $parts; - } - - return \@ident_parts; -} - -sub parse_identifier { - my ( $self, $type, $ident ) = @_; - return unless $type && $ident; - PTDEBUG && _d("Parsing", $type, "identifier:", $ident); - - my ($func, $expr); - if ( $ident =~ m/^\w+\(/ ) { # Function like MIN(col) - ($func, $expr) = $ident =~ m/^(\w+)\(([^\)]*)\)/; - PTDEBUG && _d('Function', $func, 'arg', $expr); - return { col => $ident } unless $expr; # NOW() - $ident = $expr; # col from MAX(col) - } - - my %ident_struct; - my @ident_parts = map { s/`//g; $_; } split /[.]/, $ident; - if ( @ident_parts == 3 ) { - @ident_struct{qw(db tbl col)} = @ident_parts; - } - elsif ( @ident_parts == 2 ) { - my @parts_for_type = $type eq 'column' ? qw(tbl col) - : $type eq 'table' ? qw(db tbl) - : die "Invalid identifier type: $type"; - @ident_struct{@parts_for_type} = @ident_parts; - } - elsif ( @ident_parts == 1 ) { - my $part = $type eq 'column' ? 'col' : 'tbl'; - @ident_struct{($part)} = @ident_parts; - } - else { - die "Invalid number of parts in $type reference: $ident"; - } - - if ( $self->{Schema} ) { - if ( $type eq 'column' && (!$ident_struct{tbl} || !$ident_struct{db}) ) { - my $qcol = $self->{Schema}->find_column(%ident_struct); - if ( $qcol && @$qcol == 1 ) { - @ident_struct{qw(db tbl)} = @{$qcol->[0]}{qw(db tbl)}; - } - } - elsif ( !$ident_struct{db} ) { - my $qtbl = $self->{Schema}->find_table(%ident_struct); - if ( $qtbl && @$qtbl == 1 ) { - $ident_struct{db} = $qtbl->[0]; - } - } - } - - if ( $func ) { - $ident_struct{func} = uc $func; - } - - PTDEBUG && _d($type, "identifier struct:", Dumper(\%ident_struct)); - return \%ident_struct; -} - -sub split_unquote { - my ( $self, $db_tbl, $default_db ) = @_; - $db_tbl =~ s/`//g; - my ( $db, $tbl ) = split(/[.]/, $db_tbl); - if ( !$tbl ) { - $tbl = $db; - $db = $default_db; - } - return ($db, $tbl); -} - -sub is_identifier { - my ( $self, $thing ) = @_; - - return 0 unless $thing; - - return 0 if $thing =~ m/\s*['"]/; - - return 0 if $thing =~ m/^\s*\d+(?:\.\d+)?\s*$/; - - return 0 if $thing =~ m/^\s*(?> - NULL - |DUAL - )\s*$/xi; - - return 1 if $thing =~ m/^\s*$column_ident\s*$/; - - return 0; -} - -sub set_Schema { - my ( $self, $sq ) = @_; - $self->{Schema} = $sq; - return; -} - -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 SQLParser package -# ########################################################################### - -# ########################################################################### -# TableParser package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/TableParser.pm -# t/lib/TableParser.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package TableParser; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Data::Dumper; -$Data::Dumper::Indent = 1; -$Data::Dumper::Sortkeys = 1; -$Data::Dumper::Quotekeys = 0; - -local $EVAL_ERROR; -eval { - require Quoter; -}; - -sub new { - my ( $class, %args ) = @_; - my $self = { %args }; - $self->{Quoter} ||= Quoter->new(); - return bless $self, $class; -} - -sub Quoter { shift->{Quoter} } - -sub get_create_table { - my ( $self, $dbh, $db, $tbl ) = @_; - die "I need a dbh parameter" unless $dbh; - die "I need a db parameter" unless $db; - die "I need a tbl parameter" unless $tbl; - my $q = $self->{Quoter}; - - my $new_sql_mode - = q{/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, } - . q{@@SQL_MODE := '', } - . q{@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, } - . q{@@SQL_QUOTE_SHOW_CREATE := 1 */}; - - my $old_sql_mode - = q{/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, } - . q{@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */}; - - PTDEBUG && _d($new_sql_mode); - eval { $dbh->do($new_sql_mode); }; - PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); - - my $use_sql = 'USE ' . $q->quote($db); - PTDEBUG && _d($dbh, $use_sql); - $dbh->do($use_sql); - - my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl); - PTDEBUG && _d($show_sql); - my $href; - eval { $href = $dbh->selectrow_hashref($show_sql); }; - if ( my $e = $EVAL_ERROR ) { - PTDEBUG && _d($old_sql_mode); - $dbh->do($old_sql_mode); - - die $e; - } - - PTDEBUG && _d($old_sql_mode); - $dbh->do($old_sql_mode); - - my ($key) = grep { m/create (?:table|view)/i } keys %$href; - if ( !$key ) { - die "Error: no 'Create Table' or 'Create View' in result set from " - . "$show_sql: " . Dumper($href); - } - - return $href->{$key}; -} - -sub parse { - my ( $self, $ddl, $opts ) = @_; - return unless $ddl; - - if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) { - $ddl = $self->ansi_to_legacy($ddl); - } - elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { - die "TableParser doesn't handle CREATE TABLE without quoting."; - } - - my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; - (undef, $name) = $self->{Quoter}->split_unquote($name) if $name; - - $ddl =~ s/(`[^`]+`)/\L$1/g; - - my $engine = $self->get_engine($ddl); - - my @defs = $ddl =~ m/^(\s+`.*?),?$/gm; - my @cols = map { $_ =~ m/`([^`]+)`/ } @defs; - PTDEBUG && _d('Table cols:', join(', ', map { "`$_`" } @cols)); - - my %def_for; - @def_for{@cols} = @defs; - - my (@nums, @null); - my (%type_for, %is_nullable, %is_numeric, %is_autoinc); - foreach my $col ( @cols ) { - my $def = $def_for{$col}; - my ( $type ) = $def =~ m/`[^`]+`\s([a-z]+)/; - die "Can't determine column type for $def" unless $type; - $type_for{$col} = $type; - if ( $type =~ m/(?:(?:tiny|big|medium|small)?int|float|double|decimal|year)/ ) { - push @nums, $col; - $is_numeric{$col} = 1; - } - if ( $def !~ m/NOT NULL/ ) { - push @null, $col; - $is_nullable{$col} = 1; - } - $is_autoinc{$col} = $def =~ m/AUTO_INCREMENT/i ? 1 : 0; - } - - my ($keys, $clustered_key) = $self->get_keys($ddl, $opts, \%is_nullable); - - my ($charset) = $ddl =~ m/DEFAULT CHARSET=(\w+)/; - - return { - name => $name, - cols => \@cols, - col_posn => { map { $cols[$_] => $_ } 0..$#cols }, - is_col => { map { $_ => 1 } @cols }, - null_cols => \@null, - is_nullable => \%is_nullable, - is_autoinc => \%is_autoinc, - clustered_key => $clustered_key, - keys => $keys, - defs => \%def_for, - numeric_cols => \@nums, - is_numeric => \%is_numeric, - engine => $engine, - type_for => \%type_for, - charset => $charset, - }; -} - -sub sort_indexes { - my ( $self, $tbl ) = @_; - - my @indexes - = sort { - (($a ne 'PRIMARY') <=> ($b ne 'PRIMARY')) - || ( !$tbl->{keys}->{$a}->{is_unique} <=> !$tbl->{keys}->{$b}->{is_unique} ) - || ( $tbl->{keys}->{$a}->{is_nullable} <=> $tbl->{keys}->{$b}->{is_nullable} ) - || ( scalar(@{$tbl->{keys}->{$a}->{cols}}) <=> scalar(@{$tbl->{keys}->{$b}->{cols}}) ) - } - grep { - $tbl->{keys}->{$_}->{type} eq 'BTREE' - } - sort keys %{$tbl->{keys}}; - - PTDEBUG && _d('Indexes sorted best-first:', join(', ', @indexes)); - return @indexes; -} - -sub find_best_index { - my ( $self, $tbl, $index ) = @_; - my $best; - if ( $index ) { - ($best) = grep { uc $_ eq uc $index } keys %{$tbl->{keys}}; - } - if ( !$best ) { - if ( $index ) { - die "Index '$index' does not exist in table"; - } - else { - ($best) = $self->sort_indexes($tbl); - } - } - PTDEBUG && _d('Best index found is', $best); - return $best; -} - -sub find_possible_keys { - my ( $self, $dbh, $database, $table, $quoter, $where ) = @_; - return () unless $where; - my $sql = 'EXPLAIN SELECT * FROM ' . $quoter->quote($database, $table) - . ' WHERE ' . $where; - PTDEBUG && _d($sql); - my $expl = $dbh->selectrow_hashref($sql); - $expl = { map { lc($_) => $expl->{$_} } keys %$expl }; - if ( $expl->{possible_keys} ) { - PTDEBUG && _d('possible_keys =', $expl->{possible_keys}); - my @candidates = split(',', $expl->{possible_keys}); - my %possible = map { $_ => 1 } @candidates; - if ( $expl->{key} ) { - PTDEBUG && _d('MySQL chose', $expl->{key}); - unshift @candidates, grep { $possible{$_} } split(',', $expl->{key}); - PTDEBUG && _d('Before deduping:', join(', ', @candidates)); - my %seen; - @candidates = grep { !$seen{$_}++ } @candidates; - } - PTDEBUG && _d('Final list:', join(', ', @candidates)); - return @candidates; - } - else { - PTDEBUG && _d('No keys in possible_keys'); - return (); - } -} - -sub check_table { - my ( $self, %args ) = @_; - my @required_args = qw(dbh db tbl); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($dbh, $db, $tbl) = @args{@required_args}; - my $q = $self->{Quoter} || 'Quoter'; - my $db_tbl = $q->quote($db, $tbl); - PTDEBUG && _d('Checking', $db_tbl); - - my $sql = "SHOW TABLES FROM " . $q->quote($db) - . ' LIKE ' . $q->literal_like($tbl); - PTDEBUG && _d($sql); - my $row; - eval { - $row = $dbh->selectrow_arrayref($sql); - }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d($EVAL_ERROR); - return 0; - } - if ( !$row->[0] || $row->[0] ne $tbl ) { - PTDEBUG && _d('Table does not exist'); - return 0; - } - - PTDEBUG && _d('Table', $db, $tbl, 'exists'); - return 1; - -} - -sub get_engine { - my ( $self, $ddl, $opts ) = @_; - my ( $engine ) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; - PTDEBUG && _d('Storage engine:', $engine); - return $engine || undef; -} - -sub get_keys { - my ( $self, $ddl, $opts, $is_nullable ) = @_; - my $engine = $self->get_engine($ddl); - my $keys = {}; - my $clustered_key = undef; - - KEY: - foreach my $key ( $ddl =~ m/^ ((?:[A-Z]+ )?KEY .*)$/gm ) { - - next KEY if $key =~ m/FOREIGN/; - - my $key_ddl = $key; - PTDEBUG && _d('Parsed key:', $key_ddl); - - if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) { - $key =~ s/USING HASH/USING BTREE/; - } - - my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; - my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; - $type = $type || $special || 'BTREE'; - my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; - my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; - my @cols; - my @col_prefixes; - foreach my $col_def ( $cols =~ m/`[^`]+`(?:\(\d+\))?/g ) { - my ($name, $prefix) = $col_def =~ m/`([^`]+)`(?:\((\d+)\))?/; - push @cols, $name; - push @col_prefixes, $prefix; - } - $name =~ s/`//g; - - PTDEBUG && _d( $name, 'key cols:', join(', ', map { "`$_`" } @cols)); - - $keys->{$name} = { - name => $name, - type => $type, - colnames => $cols, - cols => \@cols, - col_prefixes => \@col_prefixes, - is_unique => $unique, - is_nullable => scalar(grep { $is_nullable->{$_} } @cols), - is_col => { map { $_ => 1 } @cols }, - ddl => $key_ddl, - }; - - if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) { - my $this_key = $keys->{$name}; - if ( $this_key->{name} eq 'PRIMARY' ) { - $clustered_key = 'PRIMARY'; - } - elsif ( $this_key->{is_unique} && !$this_key->{is_nullable} ) { - $clustered_key = $this_key->{name}; - } - PTDEBUG && $clustered_key && _d('This key is the clustered key'); - } - } - - return $keys, $clustered_key; -} - -sub get_fks { - my ( $self, $ddl, $opts ) = @_; - my $q = $self->{Quoter}; - my $fks = {}; - - foreach my $fk ( - $ddl =~ m/CONSTRAINT .* FOREIGN KEY .* REFERENCES [^\)]*\)/mg ) - { - my ( $name ) = $fk =~ m/CONSTRAINT `(.*?)`/; - my ( $cols ) = $fk =~ m/FOREIGN KEY \(([^\)]+)\)/; - my ( $parent, $parent_cols ) = $fk =~ m/REFERENCES (\S+) \(([^\)]+)\)/; - - my ($db, $tbl) = $q->split_unquote($parent, $opts->{database}); - my %parent_tbl = (tbl => $tbl); - $parent_tbl{db} = $db if $db; - - if ( $parent !~ m/\./ && $opts->{database} ) { - $parent = $q->quote($opts->{database}) . ".$parent"; - } - - $fks->{$name} = { - name => $name, - colnames => $cols, - cols => [ map { s/[ `]+//g; $_; } split(',', $cols) ], - parent_tbl => \%parent_tbl, - parent_tblname => $parent, - parent_cols => [ map { s/[ `]+//g; $_; } split(',', $parent_cols) ], - parent_colnames=> $parent_cols, - ddl => $fk, - }; - } - - return $fks; -} - -sub remove_auto_increment { - my ( $self, $ddl ) = @_; - $ddl =~ s/(^\).*?) AUTO_INCREMENT=\d+\b/$1/m; - return $ddl; -} - -sub get_table_status { - my ( $self, $dbh, $db, $like ) = @_; - my $q = $self->{Quoter}; - my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db); - my @params; - if ( $like ) { - $sql .= ' LIKE ?'; - push @params, $like; - } - PTDEBUG && _d($sql, @params); - my $sth = $dbh->prepare($sql); - eval { $sth->execute(@params); }; - if ($EVAL_ERROR) { - PTDEBUG && _d($EVAL_ERROR); - return; - } - my @tables = @{$sth->fetchall_arrayref({})}; - @tables = map { - my %tbl; # Make a copy with lowercased keys - @tbl{ map { lc $_ } keys %$_ } = values %$_; - $tbl{engine} ||= $tbl{type} || $tbl{comment}; - delete $tbl{type}; - \%tbl; - } @tables; - return @tables; -} - -my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx; -sub ansi_to_legacy { - my ($self, $ddl) = @_; - $ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge; - return $ddl; -} - -sub ansi_quote_replace { - my ($val) = @_; - $val =~ s/^"|"$//g; - $val =~ s/`/``/g; - $val =~ s/""/"/g; - return "`$val`"; -} - -sub _d { - 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 TableParser package -# ########################################################################### - -# ########################################################################### -# ReportFormatter package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/ReportFormatter.pm -# t/lib/ReportFormatter.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package ReportFormatter; - -use Lmo; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use List::Util qw(min max); -use POSIX qw(ceil); - -eval { require Term::ReadKey }; -my $have_term = $EVAL_ERROR ? 0 : 1; - - -has underline_header => ( - is => 'ro', - isa => 'Bool', - default => sub { 1 }, -); -has line_prefix => ( - is => 'ro', - isa => 'Str', - default => sub { '# ' }, -); -has line_width => ( - is => 'ro', - isa => 'Int', - default => sub { 78 }, -); -has column_spacing => ( - is => 'ro', - isa => 'Str', - default => sub { ' ' }, -); -has extend_right => ( - is => 'ro', - isa => 'Bool', - default => sub { '' }, -); -has truncate_line_mark => ( - is => 'ro', - isa => 'Str', - default => sub { '...' }, -); -has column_errors => ( - is => 'ro', - isa => 'Str', - default => sub { 'warn' }, -); -has truncate_header_side => ( - is => 'ro', - isa => 'Str', - default => sub { 'left' }, -); -has strip_whitespace => ( - is => 'ro', - isa => 'Bool', - default => sub { 1 }, -); -has title => ( - is => 'rw', - isa => 'Str', - predicate => 'has_title', -); - - -has n_cols => ( - is => 'rw', - isa => 'Int', - default => sub { 0 }, - init_arg => undef, -); - -has cols => ( - is => 'ro', - isa => 'ArrayRef', - init_arg => undef, - default => sub { [] }, - clearer => 'clear_cols', -); - -has lines => ( - is => 'ro', - isa => 'ArrayRef', - init_arg => undef, - default => sub { [] }, - clearer => 'clear_lines', -); - -has truncate_headers => ( - is => 'rw', - isa => 'Bool', - default => sub { undef }, - init_arg => undef, - clearer => 'clear_truncate_headers', -); - -sub BUILDARGS { - my $class = shift; - my $args = $class->SUPER::BUILDARGS(@_); - - if ( ($args->{line_width} || '') eq 'auto' ) { - die "Cannot auto-detect line width because the Term::ReadKey module " - . "is not installed" unless $have_term; - ($args->{line_width}) = GetTerminalSize(); - PTDEBUG && _d('Line width:', $args->{line_width}); - } - - return $args; -} - -sub set_columns { - my ( $self, @cols ) = @_; - my $min_hdr_wid = 0; # check that header fits on line - my $used_width = 0; - my @auto_width_cols; - - for my $i ( 0..$#cols ) { - my $col = $cols[$i]; - my $col_name = $col->{name}; - my $col_len = length $col_name; - die "Column does not have a name" unless defined $col_name; - - if ( $col->{width} ) { - $col->{width_pct} = ceil(($col->{width} * 100) / $self->line_width()); - PTDEBUG && _d('col:', $col_name, 'width:', $col->{width}, 'chars =', - $col->{width_pct}, '%'); - } - - if ( $col->{width_pct} ) { - $used_width += $col->{width_pct}; - } - else { - PTDEBUG && _d('Auto width col:', $col_name); - $col->{auto_width} = 1; - push @auto_width_cols, $i; - } - - $col->{truncate} = 1 unless defined $col->{truncate}; - $col->{truncate_mark} = '...' unless defined $col->{truncate_mark}; - $col->{truncate_side} ||= 'right'; - $col->{undef_value} = '' unless defined $col->{undef_value}; - - $col->{min_val} = 0; - $col->{max_val} = 0; - - $min_hdr_wid += $col_len; - $col->{header_width} = $col_len; - - $col->{right_most} = 1 if $i == $#cols; - - push @{$self->cols}, $col; - } - - $self->n_cols( scalar @cols ); - - if ( ($used_width || 0) > 100 ) { - die "Total width_pct for all columns is >100%"; - } - - if ( @auto_width_cols ) { - my $wid_per_col = int((100 - $used_width) / scalar @auto_width_cols); - PTDEBUG && _d('Line width left:', (100-$used_width), '%;', - 'each auto width col:', $wid_per_col, '%'); - map { $self->cols->[$_]->{width_pct} = $wid_per_col } @auto_width_cols; - } - - $min_hdr_wid += ($self->n_cols() - 1) * length $self->column_spacing(); - PTDEBUG && _d('min header width:', $min_hdr_wid); - if ( $min_hdr_wid > $self->line_width() ) { - PTDEBUG && _d('Will truncate headers because min header width', - $min_hdr_wid, '> line width', $self->line_width()); - $self->truncate_headers(1); - } - - return; -} - -sub add_line { - my ( $self, @vals ) = @_; - my $n_vals = scalar @vals; - if ( $n_vals != $self->n_cols() ) { - $self->_column_error("Number of values $n_vals does not match " - . "number of columns " . $self->n_cols()); - } - for my $i ( 0..($n_vals-1) ) { - my $col = $self->cols->[$i]; - my $val = defined $vals[$i] ? $vals[$i] : $col->{undef_value}; - if ( $self->strip_whitespace() ) { - $val =~ s/^\s+//g; - $val =~ s/\s+$//; - $vals[$i] = $val; - } - my $width = length $val; - $col->{min_val} = min($width, ($col->{min_val} || $width)); - $col->{max_val} = max($width, ($col->{max_val} || $width)); - } - push @{$self->lines}, \@vals; - return; -} - -sub get_report { - my ( $self, %args ) = @_; - - $self->_calculate_column_widths(); - if ( $self->truncate_headers() ) { - $self->_truncate_headers(); - } - $self->_truncate_line_values(%args); - - my @col_fmts = $self->_make_column_formats(); - my $fmt = $self->line_prefix() - . join($self->column_spacing(), @col_fmts); - PTDEBUG && _d('Format:', $fmt); - - (my $hdr_fmt = $fmt) =~ s/%([^-])/%-$1/g; - - my @lines; - push @lines, $self->line_prefix() . $self->title() if $self->has_title(); - push @lines, $self->_truncate_line( - sprintf($hdr_fmt, map { $_->{name} } @{$self->cols}), - strip => 1, - mark => '', - ); - - if ( $self->underline_header() ) { - my @underlines = map { '=' x $_->{print_width} } @{$self->cols}; - push @lines, $self->_truncate_line( - sprintf($fmt, map { $_ || '' } @underlines), - mark => '', - ); - } - - push @lines, map { - my $vals = $_; - my $i = 0; - my @vals = map { - my $val = defined $_ ? $_ : $self->cols->[$i++]->{undef_value}; - $val = '' if !defined $val; - $val =~ s/\n/ /g; - $val; - } @$vals; - my $line = sprintf($fmt, @vals); - if ( $self->extend_right() ) { - $line; - } - else { - $self->_truncate_line($line); - } - } @{$self->lines}; - - $self->clear_cols(); - $self->clear_lines(); - $self->clear_truncate_headers(); - - return join("\n", @lines) . "\n"; -} - -sub truncate_value { - my ( $self, $col, $val, $width, $side ) = @_; - return $val if length $val <= $width; - return $val if $col->{right_most} && $self->extend_right(); - $side ||= $col->{truncate_side}; - my $mark = $col->{truncate_mark}; - if ( $side eq 'right' ) { - $val = substr($val, 0, $width - length $mark); - $val .= $mark; - } - elsif ( $side eq 'left') { - $val = $mark . substr($val, -1 * $width + length $mark); - } - else { - PTDEBUG && _d("I don't know how to", $side, "truncate values"); - } - return $val; -} - -sub _calculate_column_widths { - my ( $self ) = @_; - - my $extra_space = 0; - foreach my $col ( @{$self->cols} ) { - my $print_width = int($self->line_width() * ($col->{width_pct} / 100)); - - PTDEBUG && _d('col:', $col->{name}, 'width pct:', $col->{width_pct}, - 'char width:', $print_width, - 'min val:', $col->{min_val}, 'max val:', $col->{max_val}); - - if ( $col->{auto_width} ) { - if ( $col->{min_val} && $print_width < $col->{min_val} ) { - PTDEBUG && _d('Increased to min val width:', $col->{min_val}); - $print_width = $col->{min_val}; - } - elsif ( $col->{max_val} && $print_width > $col->{max_val} ) { - PTDEBUG && _d('Reduced to max val width:', $col->{max_val}); - $extra_space += $print_width - $col->{max_val}; - $print_width = $col->{max_val}; - } - } - - $col->{print_width} = $print_width; - PTDEBUG && _d('print width:', $col->{print_width}); - } - - PTDEBUG && _d('Extra space:', $extra_space); - while ( $extra_space-- ) { - foreach my $col ( @{$self->cols} ) { - if ( $col->{auto_width} - && ( $col->{print_width} < $col->{max_val} - || $col->{print_width} < $col->{header_width}) - ) { - $col->{print_width}++; - } - } - } - - return; -} - -sub _truncate_headers { - my ( $self, $col ) = @_; - my $side = $self->truncate_header_side(); - foreach my $col ( @{$self->cols} ) { - my $col_name = $col->{name}; - my $print_width = $col->{print_width}; - next if length $col_name <= $print_width; - $col->{name} = $self->truncate_value($col, $col_name, $print_width, $side); - PTDEBUG && _d('Truncated hdr', $col_name, 'to', $col->{name}, - 'max width:', $print_width); - } - return; -} - -sub _truncate_line_values { - my ( $self, %args ) = @_; - my $n_vals = $self->n_cols() - 1; - foreach my $vals ( @{$self->lines} ) { - for my $i ( 0..$n_vals ) { - my $col = $self->cols->[$i]; - my $val = defined $vals->[$i] ? $vals->[$i] : $col->{undef_value}; - my $width = length $val; - - if ( $col->{print_width} && $width > $col->{print_width} ) { - if ( !$col->{truncate} ) { - $self->_column_error("Value '$val' is too wide for column " - . $col->{name}); - } - - my $callback = $args{truncate_callback}; - my $print_width = $col->{print_width}; - $val = $callback ? $callback->($col, $val, $print_width) - : $self->truncate_value($col, $val, $print_width); - PTDEBUG && _d('Truncated val', $vals->[$i], 'to', $val, - '; max width:', $print_width); - $vals->[$i] = $val; - } - } - } - return; -} - -sub _make_column_formats { - my ( $self ) = @_; - my @col_fmts; - my $n_cols = $self->n_cols() - 1; - for my $i ( 0..$n_cols ) { - my $col = $self->cols->[$i]; - - my $width = $col->{right_most} && !$col->{right_justify} ? '' - : $col->{print_width}; - - my $col_fmt = '%' . ($col->{right_justify} ? '' : '-') . $width . 's'; - push @col_fmts, $col_fmt; - } - return @col_fmts; -} - -sub _truncate_line { - my ( $self, $line, %args ) = @_; - my $mark = defined $args{mark} ? $args{mark} : $self->truncate_line_mark(); - if ( $line ) { - $line =~ s/\s+$// if $args{strip}; - my $len = length($line); - if ( $len > $self->line_width() ) { - $line = substr($line, 0, $self->line_width() - length $mark); - $line .= $mark if $mark; - } - } - return $line; -} - -sub _column_error { - my ( $self, $err ) = @_; - my $msg = "Column error: $err"; - $self->column_errors() eq 'die' ? die $msg : warn $msg; - return; -} - -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"; -} - -no Lmo; -1; -} -# ########################################################################### -# End ReportFormatter package -# ########################################################################### - -# ########################################################################### -# HTTPMicro package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/HTTPMicro.pm -# t/lib/HTTPMicro.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ - -package HTTPMicro; -BEGIN { - $HTTPMicro::VERSION = '0.001'; -} -use strict; -use warnings; - -use Carp (); - - -my @attributes; -BEGIN { - @attributes = qw(agent timeout); - no strict 'refs'; - for my $accessor ( @attributes ) { - *{$accessor} = sub { - @_ > 1 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor}; - }; - } -} - -sub new { - my($class, %args) = @_; - (my $agent = $class) =~ s{::}{-}g; - my $self = { - agent => $agent . "/" . ($class->VERSION || 0), - timeout => 60, - }; - for my $key ( @attributes ) { - $self->{$key} = $args{$key} if exists $args{$key} - } - return bless $self, $class; -} - -my %DefaultPort = ( - http => 80, - https => 443, -); - -sub request { - my ($self, $method, $url, $args) = @_; - @_ == 3 || (@_ == 4 && ref $args eq 'HASH') - or Carp::croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/); - $args ||= {}; # we keep some state in this during _request - - my $response; - for ( 0 .. 1 ) { - $response = eval { $self->_request($method, $url, $args) }; - last unless $@ && $method eq 'GET' - && $@ =~ m{^(?:Socket closed|Unexpected end)}; - } - - if (my $e = "$@") { - $response = { - success => q{}, - status => 599, - reason => 'Internal Exception', - content => $e, - headers => { - 'content-type' => 'text/plain', - 'content-length' => length $e, - } - }; - } - return $response; -} - -sub _request { - my ($self, $method, $url, $args) = @_; - - my ($scheme, $host, $port, $path_query) = $self->_split_url($url); - - my $request = { - method => $method, - scheme => $scheme, - host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"), - uri => $path_query, - headers => {}, - }; - - my $handle = HTTPMicro::Handle->new(timeout => $self->{timeout}); - - $handle->connect($scheme, $host, $port); - - $self->_prepare_headers_and_cb($request, $args); - $handle->write_request_header(@{$request}{qw/method uri headers/}); - $handle->write_content_body($request) if $request->{content}; - - my $response; - do { $response = $handle->read_response_header } - until (substr($response->{status},0,1) ne '1'); - - if (!($method eq 'HEAD' || $response->{status} =~ /^[23]04/)) { - $response->{content} = ''; - $handle->read_content_body(sub { $_[1]->{content} .= $_[0] }, $response); - } - - $handle->close; - $response->{success} = substr($response->{status},0,1) eq '2'; - return $response; -} - -sub _prepare_headers_and_cb { - my ($self, $request, $args) = @_; - - for ($args->{headers}) { - next unless defined; - while (my ($k, $v) = each %$_) { - $request->{headers}{lc $k} = $v; - } - } - $request->{headers}{'host'} = $request->{host_port}; - $request->{headers}{'connection'} = "close"; - $request->{headers}{'user-agent'} ||= $self->{agent}; - - if (defined $args->{content}) { - $request->{headers}{'content-type'} ||= "application/octet-stream"; - utf8::downgrade($args->{content}, 1) - or Carp::croak(q/Wide character in request message body/); - $request->{headers}{'content-length'} = length $args->{content}; - $request->{content} = $args->{content}; - } - return; -} - -sub _split_url { - my $url = pop; - - my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> - or Carp::croak(qq/Cannot parse URL: '$url'/); - - $scheme = lc $scheme; - $path_query = "/$path_query" unless $path_query =~ m<\A/>; - - my $host = (length($authority)) ? lc $authority : 'localhost'; - $host =~ s/\A[^@]*@//; # userinfo - my $port = do { - $host =~ s/:([0-9]*)\z// && length $1 - ? $1 - : $DefaultPort{$scheme} - }; - - return ($scheme, $host, $port, $path_query); -} - -package - HTTPMicro::Handle; # hide from PAUSE/indexers -use strict; -use warnings; - -use Carp qw[croak]; -use Errno qw[EINTR EPIPE]; -use IO::Socket qw[SOCK_STREAM]; - -sub BUFSIZE () { 32768 } - -my $Printable = sub { - local $_ = shift; - s/\r/\\r/g; - s/\n/\\n/g; - s/\t/\\t/g; - s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge; - $_; -}; - -sub new { - my ($class, %args) = @_; - return bless { - rbuf => '', - timeout => 60, - max_line_size => 16384, - %args - }, $class; -} - -my $ssl_verify_args = { - check_cn => "when_only", - wildcards_in_alt => "anywhere", - wildcards_in_cn => "anywhere" -}; - -sub connect { - @_ == 4 || croak(q/Usage: $handle->connect(scheme, host, port)/); - my ($self, $scheme, $host, $port) = @_; - - if ( $scheme eq 'https' ) { - eval "require IO::Socket::SSL" - unless exists $INC{'IO/Socket/SSL.pm'}; - croak(qq/IO::Socket::SSL must be installed for https support\n/) - unless $INC{'IO/Socket/SSL.pm'}; - } - elsif ( $scheme ne 'http' ) { - croak(qq/Unsupported URL scheme '$scheme'\n/); - } - - $self->{fh} = 'IO::Socket::INET'->new( - PeerHost => $host, - PeerPort => $port, - Proto => 'tcp', - Type => SOCK_STREAM, - Timeout => $self->{timeout} - ) or croak(qq/Could not connect to '$host:$port': $@/); - - binmode($self->{fh}) - or croak(qq/Could not binmode() socket: '$!'/); - - if ( $scheme eq 'https') { - IO::Socket::SSL->start_SSL($self->{fh}); - ref($self->{fh}) eq 'IO::Socket::SSL' - or die(qq/SSL connection failed for $host\n/); - if ( $self->{fh}->can("verify_hostname") ) { - $self->{fh}->verify_hostname( $host, $ssl_verify_args ); - } - else { - my $fh = $self->{fh}; - _verify_hostname_of_cert($host, _peer_certificate($fh), $ssl_verify_args) - or die(qq/SSL certificate not valid for $host\n/); - } - } - - $self->{host} = $host; - $self->{port} = $port; - - return $self; -} - -sub close { - @_ == 1 || croak(q/Usage: $handle->close()/); - my ($self) = @_; - CORE::close($self->{fh}) - or croak(qq/Could not close socket: '$!'/); -} - -sub write { - @_ == 2 || croak(q/Usage: $handle->write(buf)/); - my ($self, $buf) = @_; - - my $len = length $buf; - my $off = 0; - - local $SIG{PIPE} = 'IGNORE'; - - while () { - $self->can_write - or croak(q/Timed out while waiting for socket to become ready for writing/); - my $r = syswrite($self->{fh}, $buf, $len, $off); - if (defined $r) { - $len -= $r; - $off += $r; - last unless $len > 0; - } - elsif ($! == EPIPE) { - croak(qq/Socket closed by remote server: $!/); - } - elsif ($! != EINTR) { - croak(qq/Could not write to socket: '$!'/); - } - } - return $off; -} - -sub read { - @_ == 2 || @_ == 3 || croak(q/Usage: $handle->read(len)/); - my ($self, $len) = @_; - - my $buf = ''; - my $got = length $self->{rbuf}; - - if ($got) { - my $take = ($got < $len) ? $got : $len; - $buf = substr($self->{rbuf}, 0, $take, ''); - $len -= $take; - } - - while ($len > 0) { - $self->can_read - or croak(q/Timed out while waiting for socket to become ready for reading/); - my $r = sysread($self->{fh}, $buf, $len, length $buf); - if (defined $r) { - last unless $r; - $len -= $r; - } - elsif ($! != EINTR) { - croak(qq/Could not read from socket: '$!'/); - } - } - if ($len) { - croak(q/Unexpected end of stream/); - } - return $buf; -} - -sub readline { - @_ == 1 || croak(q/Usage: $handle->readline()/); - my ($self) = @_; - - while () { - if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) { - return $1; - } - $self->can_read - or croak(q/Timed out while waiting for socket to become ready for reading/); - my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf}); - if (defined $r) { - last unless $r; - } - elsif ($! != EINTR) { - croak(qq/Could not read from socket: '$!'/); - } - } - croak(q/Unexpected end of stream while looking for line/); -} - -sub read_header_lines { - @_ == 1 || @_ == 2 || croak(q/Usage: $handle->read_header_lines([headers])/); - my ($self, $headers) = @_; - $headers ||= {}; - my $lines = 0; - my $val; - - while () { - my $line = $self->readline; - - if ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) { - my ($field_name) = lc $1; - $val = \($headers->{$field_name} = $2); - } - elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) { - $val - or croak(q/Unexpected header continuation line/); - next unless length $1; - $$val .= ' ' if length $$val; - $$val .= $1; - } - elsif ($line =~ /\A \x0D?\x0A \z/x) { - last; - } - else { - croak(q/Malformed header line: / . $Printable->($line)); - } - } - return $headers; -} - -sub write_header_lines { - (@_ == 2 && ref $_[1] eq 'HASH') || croak(q/Usage: $handle->write_header_lines(headers)/); - my($self, $headers) = @_; - - my $buf = ''; - while (my ($k, $v) = each %$headers) { - my $field_name = lc $k; - $field_name =~ /\A [\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]+ \z/x - or croak(q/Invalid HTTP header field name: / . $Printable->($field_name)); - $field_name =~ s/\b(\w)/\u$1/g; - $buf .= "$field_name: $v\x0D\x0A"; - } - $buf .= "\x0D\x0A"; - return $self->write($buf); -} - -sub read_content_body { - @_ == 3 || @_ == 4 || croak(q/Usage: $handle->read_content_body(callback, response, [read_length])/); - my ($self, $cb, $response, $len) = @_; - $len ||= $response->{headers}{'content-length'}; - - croak("No content-length in the returned response, and this " - . "UA doesn't implement chunking") unless defined $len; - - while ($len > 0) { - my $read = ($len > BUFSIZE) ? BUFSIZE : $len; - $cb->($self->read($read), $response); - $len -= $read; - } - - return; -} - -sub write_content_body { - @_ == 2 || croak(q/Usage: $handle->write_content_body(request)/); - my ($self, $request) = @_; - my ($len, $content_length) = (0, $request->{headers}{'content-length'}); - - $len += $self->write($request->{content}); - - $len == $content_length - or croak(qq/Content-Length missmatch (got: $len expected: $content_length)/); - - return $len; -} - -sub read_response_header { - @_ == 1 || croak(q/Usage: $handle->read_response_header()/); - my ($self) = @_; - - my $line = $self->readline; - - $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x - or croak(q/Malformed Status-Line: / . $Printable->($line)); - - my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4); - - return { - status => $status, - reason => $reason, - headers => $self->read_header_lines, - protocol => $protocol, - }; -} - -sub write_request_header { - @_ == 4 || croak(q/Usage: $handle->write_request_header(method, request_uri, headers)/); - my ($self, $method, $request_uri, $headers) = @_; - - return $self->write("$method $request_uri HTTP/1.1\x0D\x0A") - + $self->write_header_lines($headers); -} - -sub _do_timeout { - my ($self, $type, $timeout) = @_; - $timeout = $self->{timeout} - unless defined $timeout && $timeout >= 0; - - my $fd = fileno $self->{fh}; - defined $fd && $fd >= 0 - or croak(q/select(2): 'Bad file descriptor'/); - - my $initial = time; - my $pending = $timeout; - my $nfound; - - vec(my $fdset = '', $fd, 1) = 1; - - while () { - $nfound = ($type eq 'read') - ? select($fdset, undef, undef, $pending) - : select(undef, $fdset, undef, $pending) ; - if ($nfound == -1) { - $! == EINTR - or croak(qq/select(2): '$!'/); - redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0; - $nfound = 0; - } - last; - } - $! = 0; - return $nfound; -} - -sub can_read { - @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_read([timeout])/); - my $self = shift; - return $self->_do_timeout('read', @_) -} - -sub can_write { - @_ == 1 || @_ == 2 || croak(q/Usage: $handle->can_write([timeout])/); - my $self = shift; - return $self->_do_timeout('write', @_) -} - -my $prog = <<'EOP'; -BEGIN { - if ( defined &IO::Socket::SSL::CAN_IPV6 ) { - *CAN_IPV6 = \*IO::Socket::SSL::CAN_IPV6; - } - else { - constant->import( CAN_IPV6 => '' ); - } - my %const = ( - NID_CommonName => 13, - GEN_DNS => 2, - GEN_IPADD => 7, - ); - while ( my ($name,$value) = each %const ) { - no strict 'refs'; - *{$name} = UNIVERSAL::can( 'Net::SSLeay', $name ) || sub { $value }; - } -} -{ - my %dispatcher = ( - issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) }, - subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) }, - ); - if ( $Net::SSLeay::VERSION >= 1.30 ) { - $dispatcher{commonName} = sub { - my $cn = Net::SSLeay::X509_NAME_get_text_by_NID( - Net::SSLeay::X509_get_subject_name( shift ), NID_CommonName); - $cn =~s{\0$}{}; # work around Bug in Net::SSLeay <1.33 - $cn; - } - } else { - $dispatcher{commonName} = sub { - croak "you need at least Net::SSLeay version 1.30 for getting commonName" - } - } - - if ( $Net::SSLeay::VERSION >= 1.33 ) { - $dispatcher{subjectAltNames} = sub { Net::SSLeay::X509_get_subjectAltNames( shift ) }; - } else { - $dispatcher{subjectAltNames} = sub { - return; - }; - } - - $dispatcher{authority} = $dispatcher{issuer}; - $dispatcher{owner} = $dispatcher{subject}; - $dispatcher{cn} = $dispatcher{commonName}; - - sub _peer_certificate { - my ($self, $field) = @_; - my $ssl = $self->_get_ssl_object or return; - - my $cert = ${*$self}{_SSL_certificate} - ||= Net::SSLeay::get_peer_certificate($ssl) - or return $self->error("Could not retrieve peer certificate"); - - if ($field) { - my $sub = $dispatcher{$field} or croak - "invalid argument for peer_certificate, valid are: ".join( " ",keys %dispatcher ). - "\nMaybe you need to upgrade your Net::SSLeay"; - return $sub->($cert); - } else { - return $cert - } - } - - - my %scheme = ( - ldap => { - wildcards_in_cn => 0, - wildcards_in_alt => 'leftmost', - check_cn => 'always', - }, - http => { - wildcards_in_cn => 'anywhere', - wildcards_in_alt => 'anywhere', - check_cn => 'when_only', - }, - smtp => { - wildcards_in_cn => 0, - wildcards_in_alt => 0, - check_cn => 'always' - }, - none => {}, # do not check - ); - - $scheme{www} = $scheme{http}; # alias - $scheme{xmpp} = $scheme{http}; # rfc 3920 - $scheme{pop3} = $scheme{ldap}; # rfc 2595 - $scheme{imap} = $scheme{ldap}; # rfc 2595 - $scheme{acap} = $scheme{ldap}; # rfc 2595 - $scheme{nntp} = $scheme{ldap}; # rfc 4642 - $scheme{ftp} = $scheme{http}; # rfc 4217 - - - sub _verify_hostname_of_cert { - my $identity = shift; - my $cert = shift; - my $scheme = shift || 'none'; - if ( ! ref($scheme) ) { - $scheme = $scheme{$scheme} or croak "scheme $scheme not defined"; - } - - return 1 if ! %$scheme; # 'none' - - my $commonName = $dispatcher{cn}->($cert); - my @altNames = $dispatcher{subjectAltNames}->($cert); - - if ( my $sub = $scheme->{callback} ) { - return $sub->($identity,$commonName,@altNames); - } - - - my $ipn; - if ( CAN_IPV6 and $identity =~m{:} ) { - $ipn = IO::Socket::SSL::inet_pton(IO::Socket::SSL::AF_INET6,$identity) - or croak "'$identity' is not IPv6, but neither IPv4 nor hostname"; - } elsif ( $identity =~m{^\d+\.\d+\.\d+\.\d+$} ) { - $ipn = IO::Socket::SSL::inet_aton( $identity ) or croak "'$identity' is not IPv4, but neither IPv6 nor hostname"; - } else { - if ( $identity =~m{[^a-zA-Z0-9_.\-]} ) { - $identity =~m{\0} and croak("name '$identity' has \\0 byte"); - $identity = IO::Socket::SSL::idn_to_ascii($identity) or - croak "Warning: Given name '$identity' could not be converted to IDNA!"; - } - } - - my $check_name = sub { - my ($name,$identity,$wtyp) = @_; - $wtyp ||= ''; - my $pattern; - if ( $wtyp eq 'anywhere' and $name =~m{^([a-zA-Z0-9_\-]*)\*(.+)} ) { - $pattern = qr{^\Q$1\E[a-zA-Z0-9_\-]*\Q$2\E$}i; - } elsif ( $wtyp eq 'leftmost' and $name =~m{^\*(\..+)$} ) { - $pattern = qr{^[a-zA-Z0-9_\-]*\Q$1\E$}i; - } else { - $pattern = qr{^\Q$name\E$}i; - } - return $identity =~ $pattern; - }; - - my $alt_dnsNames = 0; - while (@altNames) { - my ($type, $name) = splice (@altNames, 0, 2); - if ( $ipn and $type == GEN_IPADD ) { - return 1 if $ipn eq $name; - - } elsif ( ! $ipn and $type == GEN_DNS ) { - $name =~s/\s+$//; $name =~s/^\s+//; - $alt_dnsNames++; - $check_name->($name,$identity,$scheme->{wildcards_in_alt}) - and return 1; - } - } - - if ( ! $ipn and ( - $scheme->{check_cn} eq 'always' or - $scheme->{check_cn} eq 'when_only' and !$alt_dnsNames)) { - $check_name->($commonName,$identity,$scheme->{wildcards_in_cn}) - and return 1; - } - - return 0; # no match - } -} -EOP - -eval { require IO::Socket::SSL }; -if ( $INC{"IO/Socket/SSL.pm"} ) { - eval $prog; - die $@ if $@; -} - -1; -} -# ########################################################################### -# End HTTPMicro package -# ########################################################################### - -# ########################################################################### -# VersionCheck package -# This package is a copy without comments from the original. The original -# with comments and its test file can be found in the Bazaar repository at, -# lib/VersionCheck.pm -# t/lib/VersionCheck.t -# See https://launchpad.net/percona-toolkit for more information. -# ########################################################################### -{ -package VersionCheck; - - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); - -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -use Data::Dumper; -local $Data::Dumper::Indent = 1; -local $Data::Dumper::Sortkeys = 1; -local $Data::Dumper::Quotekeys = 0; - -use Digest::MD5 qw(md5_hex); -use Sys::Hostname qw(hostname); -use File::Basename qw(); -use File::Spec; -use FindBin qw(); - -eval { - require Percona::Toolkit; - require HTTPMicro; -}; - -{ - my $file = 'percona-version-check'; - my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.'; - my @vc_dirs = ( - '/etc/percona', - '/etc/percona-toolkit', - '/tmp', - "$home", - ); - - sub version_check_file { - foreach my $dir ( @vc_dirs ) { - if ( -d $dir && -w $dir ) { - PTDEBUG && _d('Version check file', $file, 'in', $dir); - return $dir . '/' . $file; - } - } - PTDEBUG && _d('Version check file', $file, 'in', $ENV{PWD}); - return $file; # in the CWD - } -} - -sub version_check_time_limit { - return 60 * 60 * 24; # one day -} - - -sub version_check { - my (%args) = @_; - - my $instances = $args{instances} || []; - my $instances_to_check; - - PTDEBUG && _d('FindBin::Bin:', $FindBin::Bin); - if ( !$args{force} ) { - if ( $FindBin::Bin - && (-d "$FindBin::Bin/../.bzr" || -d "$FindBin::Bin/../../.bzr") ) { - PTDEBUG && _d("$FindBin::Bin/../.bzr disables --version-check"); - return; - } - } - - eval { - foreach my $instance ( @$instances ) { - my ($name, $id) = get_instance_id($instance); - $instance->{name} = $name; - $instance->{id} = $id; - } - - push @$instances, { name => 'system', id => 0 }; - - $instances_to_check = get_instances_to_check( - instances => $instances, - vc_file => $args{vc_file}, # testing - now => $args{now}, # testing - ); - PTDEBUG && _d(scalar @$instances_to_check, 'instances to check'); - return unless @$instances_to_check; - - my $protocol = 'https'; # optimistic, but... - eval { require IO::Socket::SSL; }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d($EVAL_ERROR); - $protocol = 'http'; - } - PTDEBUG && _d('Using', $protocol); - - my $advice = pingback( - instances => $instances_to_check, - protocol => $protocol, - url => $args{url} # testing - || $ENV{PERCONA_VERSION_CHECK_URL} # testing - || "$protocol://v.percona.com", - ); - if ( $advice ) { - PTDEBUG && _d('Advice:', Dumper($advice)); - if ( scalar @$advice > 1) { - print "\n# " . scalar @$advice . " software updates are " - . "available:\n"; - } - else { - print "\n# A software update is available:\n"; - } - print join("\n", map { "# * $_" } @$advice), "\n\n"; - } - }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d('Version check failed:', $EVAL_ERROR); - } - - if ( @$instances_to_check ) { - eval { - update_check_times( - instances => $instances_to_check, - vc_file => $args{vc_file}, # testing - now => $args{now}, # testing - ); - }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d('Error updating version check file:', $EVAL_ERROR); - } - } - - if ( $ENV{PTDEBUG_VERSION_CHECK} ) { - warn "Exiting because the PTDEBUG_VERSION_CHECK " - . "environment variable is defined.\n"; - exit 255; - } - - return; -} - -sub get_instances_to_check { - my (%args) = @_; - - my $instances = $args{instances}; - my $now = $args{now} || int(time); - my $vc_file = $args{vc_file} || version_check_file(); - - if ( !-f $vc_file ) { - PTDEBUG && _d('Version check file', $vc_file, 'does not exist;', - 'version checking all instances'); - return $instances; - } - - open my $fh, '<', $vc_file or die "Cannot open $vc_file: $OS_ERROR"; - chomp(my $file_contents = do { local $/ = undef; <$fh> }); - PTDEBUG && _d('Version check file', $vc_file, 'contents:', $file_contents); - close $fh; - my %last_check_time_for = $file_contents =~ /^([^,]+),(.+)$/mg; - - my $check_time_limit = version_check_time_limit(); - my @instances_to_check; - foreach my $instance ( @$instances ) { - my $last_check_time = $last_check_time_for{ $instance->{id} }; - PTDEBUG && _d('Intsance', $instance->{id}, 'last checked', - $last_check_time, 'now', $now, 'diff', $now - ($last_check_time || 0), - 'hours until next check', - sprintf '%.2f', - ($check_time_limit - ($now - ($last_check_time || 0))) / 3600); - if ( !defined $last_check_time - || ($now - $last_check_time) >= $check_time_limit ) { - PTDEBUG && _d('Time to check', Dumper($instance)); - push @instances_to_check, $instance; - } - } - - return \@instances_to_check; -} - -sub update_check_times { - my (%args) = @_; - - my $instances = $args{instances}; - my $now = $args{now} || int(time); - my $vc_file = $args{vc_file} || version_check_file(); - PTDEBUG && _d('Updating last check time:', $now); - - open my $fh, '>', $vc_file or die "Cannot write to $vc_file: $OS_ERROR"; - foreach my $instance ( sort { $a->{id} cmp $b->{id} } @$instances ) { - PTDEBUG && _d('Updated:', Dumper($instance)); - print { $fh } $instance->{id} . ',' . $now . "\n"; - } - close $fh; - - return; -} - -sub get_instance_id { - my ($instance) = @_; - - my $dbh = $instance->{dbh}; - my $dsn = $instance->{dsn}; - - my $sql = q{SELECT CONCAT(@@hostname, @@port)}; - PTDEBUG && _d($sql); - my ($name) = eval { $dbh->selectrow_array($sql) }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d($EVAL_ERROR); - $sql = q{SELECT @@hostname}; - PTDEBUG && _d($sql); - ($name) = eval { $dbh->selectrow_array($sql) }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d($EVAL_ERROR); - $name = ($dsn->{h} || 'localhost') . ($dsn->{P} || 3306); - } - else { - $sql = q{SHOW VARIABLES LIKE 'port'}; - PTDEBUG && _d($sql); - my (undef, $port) = eval { $dbh->selectrow_array($sql) }; - PTDEBUG && _d('port:', $port); - $name .= $port || ''; - } - } - my $id = md5_hex($name); - - PTDEBUG && _d('MySQL instance:', $id, $name, $dsn); - - return $name, $id; -} - - -sub pingback { - my (%args) = @_; - my @required_args = qw(url instances); - foreach my $arg ( @required_args ) { - die "I need a $arg arugment" unless $args{$arg}; - } - my $url = $args{url}; - my $instances = $args{instances}; - - my $ua = $args{ua} || HTTPMicro->new( timeout => 3 ); - - my $response = $ua->request('GET', $url); - PTDEBUG && _d('Server response:', Dumper($response)); - die "No response from GET $url" - if !$response; - die("GET on $url returned HTTP status $response->{status}; expected 200\n", - ($response->{content} || '')) if $response->{status} != 200; - die("GET on $url did not return any programs to check") - if !$response->{content}; - - my $items = parse_server_response( - response => $response->{content} - ); - die "Failed to parse server requested programs: $response->{content}" - if !scalar keys %$items; - - my $versions = get_versions( - items => $items, - instances => $instances, - ); - die "Failed to get any program versions; should have at least gotten Perl" - if !scalar keys %$versions; - - my $client_content = encode_client_response( - items => $items, - versions => $versions, - general_id => md5_hex( hostname() ), - ); - - my $client_response = { - headers => { "X-Percona-Toolkit-Tool" => File::Basename::basename($0) }, - content => $client_content, - }; - PTDEBUG && _d('Client response:', Dumper($client_response)); - - $response = $ua->request('POST', $url, $client_response); - PTDEBUG && _d('Server suggestions:', Dumper($response)); - die "No response from POST $url $client_response" - if !$response; - die "POST $url returned HTTP status $response->{status}; expected 200" - if $response->{status} != 200; - - return unless $response->{content}; - - $items = parse_server_response( - response => $response->{content}, - split_vars => 0, - ); - die "Failed to parse server suggestions: $response->{content}" - if !scalar keys %$items; - my @suggestions = map { $_->{vars} } - sort { $a->{item} cmp $b->{item} } - values %$items; - - return \@suggestions; -} - -sub encode_client_response { - my (%args) = @_; - my @required_args = qw(items versions general_id); - foreach my $arg ( @required_args ) { - die "I need a $arg arugment" unless $args{$arg}; - } - my ($items, $versions, $general_id) = @args{@required_args}; - - my @lines; - foreach my $item ( sort keys %$items ) { - next unless exists $versions->{$item}; - if ( ref($versions->{$item}) eq 'HASH' ) { - my $mysql_versions = $versions->{$item}; - for my $id ( sort keys %$mysql_versions ) { - push @lines, join(';', $id, $item, $mysql_versions->{$id}); - } - } - else { - push @lines, join(';', $general_id, $item, $versions->{$item}); - } - } - - my $client_response = join("\n", @lines) . "\n"; - return $client_response; -} - -sub parse_server_response { - my (%args) = @_; - my @required_args = qw(response); - foreach my $arg ( @required_args ) { - die "I need a $arg arugment" unless $args{$arg}; - } - my ($response) = @args{@required_args}; - - my %items = map { - my ($item, $type, $vars) = split(";", $_); - if ( !defined $args{split_vars} || $args{split_vars} ) { - $vars = [ split(",", ($vars || '')) ]; - } - $item => { - item => $item, - type => $type, - vars => $vars, - }; - } split("\n", $response); - - PTDEBUG && _d('Items:', Dumper(\%items)); - - return \%items; -} - -my %sub_for_type = ( - os_version => \&get_os_version, - perl_version => \&get_perl_version, - perl_module_version => \&get_perl_module_version, - mysql_variable => \&get_mysql_variable, - bin_version => \&get_bin_version, -); - -sub valid_item { - my ($item) = @_; - return unless $item; - if ( !exists $sub_for_type{ $item->{type} } ) { - PTDEBUG && _d('Invalid type:', $item->{type}); - return 0; - } - return 1; -} - -sub get_versions { - my (%args) = @_; - my @required_args = qw(items); - foreach my $arg ( @required_args ) { - die "I need a $arg arugment" unless $args{$arg}; - } - my ($items) = @args{@required_args}; - - my %versions; - foreach my $item ( values %$items ) { - next unless valid_item($item); - eval { - my $version = $sub_for_type{ $item->{type} }->( - item => $item, - instances => $args{instances}, - ); - if ( $version ) { - chomp $version unless ref($version); - $versions{$item->{item}} = $version; - } - }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d('Error getting version for', Dumper($item), $EVAL_ERROR); - } - } - - return \%versions; -} - - -sub get_os_version { - if ( $OSNAME eq 'MSWin32' ) { - require Win32; - return Win32::GetOSDisplayName(); - } - - chomp(my $platform = `uname -s`); - PTDEBUG && _d('platform:', $platform); - return $OSNAME unless $platform; - - chomp(my $lsb_release - = `which lsb_release 2>/dev/null | awk '{print \$1}'` || ''); - PTDEBUG && _d('lsb_release:', $lsb_release); - - my $release = ""; - - if ( $platform eq 'Linux' ) { - if ( -f "/etc/fedora-release" ) { - $release = `cat /etc/fedora-release`; - } - elsif ( -f "/etc/redhat-release" ) { - $release = `cat /etc/redhat-release`; - } - elsif ( -f "/etc/system-release" ) { - $release = `cat /etc/system-release`; - } - elsif ( $lsb_release ) { - $release = `$lsb_release -ds`; - } - elsif ( -f "/etc/lsb-release" ) { - $release = `grep DISTRIB_DESCRIPTION /etc/lsb-release`; - $release =~ s/^\w+="([^"]+)".+/$1/; - } - elsif ( -f "/etc/debian_version" ) { - chomp(my $rel = `cat /etc/debian_version`); - $release = "Debian $rel"; - if ( -f "/etc/apt/sources.list" ) { - chomp(my $code_name = `awk '/^deb/ {print \$3}' /etc/apt/sources.list | awk -F/ '{print \$1}'| awk 'BEGIN {FS="|"} {print \$1}' | sort | uniq -c | sort -rn | head -n1 | awk '{print \$2}'`); - $release .= " ($code_name)" if $code_name; - } - } - elsif ( -f "/etc/os-release" ) { # openSUSE - chomp($release = `grep PRETTY_NAME /etc/os-release`); - $release =~ s/^PRETTY_NAME="(.+)"$/$1/; - } - elsif ( `ls /etc/*release 2>/dev/null` ) { - if ( `grep DISTRIB_DESCRIPTION /etc/*release 2>/dev/null` ) { - $release = `grep DISTRIB_DESCRIPTION /etc/*release | head -n1`; - } - else { - $release = `cat /etc/*release | head -n1`; - } - } - } - elsif ( $platform =~ m/(?:BSD|^Darwin)$/ ) { - my $rel = `uname -r`; - $release = "$platform $rel"; - } - elsif ( $platform eq "SunOS" ) { - my $rel = `head -n1 /etc/release` || `uname -r`; - $release = "$platform $rel"; - } - - if ( !$release ) { - PTDEBUG && _d('Failed to get the release, using platform'); - $release = $platform; - } - chomp($release); - - $release =~ s/^"|"$//g; - - PTDEBUG && _d('OS version =', $release); - return $release; -} - -sub get_perl_version { - my (%args) = @_; - my $item = $args{item}; - return unless $item; - - my $version = sprintf '%vd', $PERL_VERSION; - PTDEBUG && _d('Perl version', $version); - return $version; -} - -sub get_perl_module_version { - my (%args) = @_; - my $item = $args{item}; - return unless $item; - - my $var = '$' . $item->{item} . '::VERSION'; - my $version = eval "use $item->{item}; $var;"; - PTDEBUG && _d('Perl version for', $var, '=', $version); - return $version; -} - -sub get_mysql_variable { - return get_from_mysql( - show => 'VARIABLES', - @_, - ); -} - -sub get_from_mysql { - my (%args) = @_; - my $show = $args{show}; - my $item = $args{item}; - my $instances = $args{instances}; - return unless $show && $item; - - if ( !$instances || !@$instances ) { - PTDEBUG && _d('Cannot check', $item, - 'because there are no MySQL instances'); - return; - } - - my @versions; - my %version_for; - foreach my $instance ( @$instances ) { - next unless $instance->{id}; # special system instance has id=0 - my $dbh = $instance->{dbh}; - local $dbh->{FetchHashKeyName} = 'NAME_lc'; - my $sql = qq/SHOW $show/; - PTDEBUG && _d($sql); - my $rows = $dbh->selectall_hashref($sql, 'variable_name'); - - my @versions; - foreach my $var ( @{$item->{vars}} ) { - $var = lc($var); - my $version = $rows->{$var}->{value}; - PTDEBUG && _d('MySQL version for', $item->{item}, '=', $version, - 'on', $instance->{name}); - push @versions, $version; - } - $version_for{ $instance->{id} } = join(' ', @versions); - } - - return \%version_for; -} - -sub get_bin_version { - my (%args) = @_; - my $item = $args{item}; - my $cmd = $item->{item}; - return unless $cmd; - - my $sanitized_command = File::Basename::basename($cmd); - PTDEBUG && _d('cmd:', $cmd, 'sanitized:', $sanitized_command); - return if $sanitized_command !~ /\A[a-zA-Z0-9_-]+\z/; - - my $output = `$sanitized_command --version 2>&1`; - PTDEBUG && _d('output:', $output); - - my ($version) = $output =~ /v?([0-9]+\.[0-9]+(?:\.[\w-]+)?)/; - - PTDEBUG && _d('Version for', $sanitized_command, '=', $version); - return $version; -} - -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 VersionCheck package -# ########################################################################### - -# ########################################################################### -# This is a combination of modules and programs in one -- a runnable module. -# http://www.perl.com/pub/a/2006/07/13/lightning-articles.html?page=last -# Or, look it up in the Camel book on pages 642 and 643 in the 3rd edition. -# -# Check at the end of this package for the call to main() which actually runs -# the program. -# ########################################################################### -package pt_query_advisor; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use Data::Dumper; -$Data::Dumper::Indent = 1; -$Data::Dumper::Sortkeys = 1; -$Data::Dumper::Quotekeys = 0; - -Transformers->import(qw(make_checksum)); - -use Percona::Toolkit; -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -# Some rules report their match pos. This sets how many -# characters before and after that pos are shown to give -# the user some context. -use constant POS_CONTEXT => 12; - -use sigtrap 'handler', \&sig_int, 'normal-signals'; - -my $oktorun = 1; # global for sig handler - -sub main { - local @ARGV = @_; # set global ARGV for this package - - my %seen_id; # already printed rule info (advice) - my %seen_fingerprint; # already seen queries - my %advice_queue; # queued up advice for --group-by - my %severity_count; # note/warn/crit count for each query id - - # ######################################################################## - # Get configuration information. - # ######################################################################## - my $o = new OptionParser(); - $o->get_specs(); - $o->get_opts(); - - my $dp = $o->DSNParser(); - $dp->prop('set-vars', $o->set_vars()); - - my $review_dsn = $o->get('review'); - my $groupby = lc $o->get('group-by'); - - if ( !$o->get('help') ) { - if ( $review_dsn - && (!defined $review_dsn->{D} || !defined $review_dsn->{t}) ) { - $o->save_error('The --review DSN requires a D (database) and t' - . ' (table) part specifying the query review table'); - } - if ( $groupby !~ m/rule_id|query_id|none/ ) { - $o->save_error("Invalid --group-by value. Valid values are: " - . "rule_id, query_id, none"); - } - } - - $o->usage_or_errors(); - - # ######################################################################### - # Load rules from POD and plugins. - # ######################################################################### - my $p = new PodParser(); - my $qar = new QueryAdvisorRules(PodParser => $p); - my $adv = new Advisor( - match_type => "pos", - ignore_rules => $o->get('ignore-rules'), - ); - - $qar->load_rule_info( - file => __FILE__, - section => 'RULES', - ); - $adv->load_rules($qar); - $adv->load_rule_info($qar); - - # TODO: load rules from plugins - - # ######################################################################### - # Make common modules. - # ######################################################################### - my $q = new Quoter(); - my $qp = new QueryParser(); - my $qr = new QueryRewriter( QueryParser => $qp ); - my $sp = new SQLParser(); - my $tp = new TableParser(Quoter => $q); - my %common_modules = ( - DSNParser => $dp, - Quoter => $q, - OptionParser => $o, - QueryParser => $qp, - QueryRewriter => $qr, - SQLParser => $sp, - TableParser => $tp, - ); - - # ######################################################################### - # Connect to review table if necessary. - # ######################################################################### - my $review_dbh; - if ( $review_dsn ) { - $review_dbh = get_cxn( - dsn => $review_dsn, - opts => { AutoCommit => 1 }, - %common_modules, - ); - } - - # ######################################################################### - # Try to connect to MySQL. - # ######################################################################### - my ($dbh, $dsn); - eval { - $dsn = $dp->parse_options($o); - $dbh = get_cxn( - dsn => $dsn, - %common_modules - ); - }; - # TODO: for now we don't report if connection to MySQL cannot be made - # because most rules don't need a connection. Not connecting means rules - # like JOI.004 may not be able to work in some cases. Maybe we can add - # a rule attrib like "uses cxn: yes" to determine if need a cxn? - if ( $EVAL_ERROR ) { - PTDEBUG && _d("Cannot connect to MySQL:", $EVAL_ERROR); - } - - # ######################################################################### - # Make pipeline. - # ######################################################################### - my @pipeline; - - if ( my $query = $o->get('query') ) { - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: query:', $query); - $args{oktorun}->(0) if $args{oktorun}; - return { - cmd => 'Query', - arg => $query, - pos_in_log => 0, # for compatibility - }; - }; - } - elsif ( $review_dbh ) { - my $where = $o->get('where'); - my $sql = "SELECT sample FROM " - . $q->quote($review_dsn->{D}, $review_dsn->{t}) - . ($where ? " WHERE $where" : ""); - PTDEBUG && _d($review_dbh, $sql); - my $queries = $review_dbh->selectall_arrayref($sql); - - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: review'); - my $query = shift @$queries; - if ( !$query ) { - $args{oktorun}->(0) if $args{oktorun}; - return; - } - return { - cmd => 'Query', - arg => $query->[0], - pos_in_log => 0, - }; - }; - } - else { - my %alias_for = ( - slowlog => ['SlowLogParser'], - genlog => ['GeneralLogParser'], - ); - my $type = $o->get('type'); - $type = $alias_for{$type->[0]} if $alias_for{$type->[0]}; - - foreach my $module ( @$type ) { - my $parser; - eval { - $parser = $module->new(o => $o); - }; - if ( $EVAL_ERROR ) { - die "Failed to load $module module: $EVAL_ERROR"; - } - push @pipeline, sub { - my ( %args ) = @_; - return $parser->parse_event(%args); - }; - PTDEBUG && _d('Added', $module, 'module to callbacks'); - } - } - - # This proc is important because all procs below, and some of the - # rules, expect the event to have an arg. - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: check cmd and arg'); - my $event = $args{event}; - if ( ($event->{cmd} || '') ne 'Query' ) { - PTDEBUG && _d('Skipping non-Query cmd'); - return; - } - if ( !$event->{arg} ) { - PTDEBUG && _d('Skipping empty arg'); - return; - } - return $event; - }; - - # Fingerprint query and check how many times we've seen it for --sample. - my %seen; - my $num_samples = $o->get('sample'); - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: fingerprint/sample'); - my $event = $args{event}; - $event->{fingerprint} = $qr->fingerprint($event->{arg}); - if ( ++$seen_fingerprint{ $event->{fingerprint} } > $num_samples ) { - PTDEBUG && _d("Event skipped because of --sample"); - return; - } - $event->{query_id} = make_checksum($event->{fingerprint}); - return $event; - }; - - # Parse the query. The query struct is a hashref with keys - # to various parts of the query. If this fails we still - # continue because some rules may not need the query struct. - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: parse query'); - my $event = $args{event}; - my $query_struct; - eval { - $query_struct = $sp->parse($event->{arg}); - if ( !$query_struct ) { - PTDEBUG && _d('Failed to parse query struct, no error'); - } - $event->{query_struct} = $query_struct; - }; - if ( $EVAL_ERROR ) { - PTDEBUG && _d('Failed to parse query struct:', $EVAL_ERROR); - } - return $event; - }; - - # Get info from MySQL related to the query, like tbl structs for - # tables it uses. - if ( $dbh ) { - my $default_db = $o->get('database'); - - if ( $o->get('show-create-table') ) { - my $tbl_structs = {}; - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: show create table'); - my $event = $args{event}; - my $query_struct = $event->{query_struct}; - if ( !$query_struct ) { - PTDEBUG && _d("No query struct"); - return $event; - } - my $tbls = $query_struct->{from} - || $query_struct->{into} - || $query_struct->{tables}; - if ( !$tbls || !@$tbls ) { - PTDEBUG && _d("Query has no tables"); - return $event; - } - - foreach my $tbl_info ( @$tbls ) { - my $tbl = $tbl_info->{tbl}; - my $db = $tbl_info->{db} || $event->{db} || $default_db; - if ( !$db ) { - PTDEBUG && _d("No database for table", $tbl); - next; - } - - if ( !$tbl_structs->{$db}->{$tbl} ) { - my $tbl_struct; - eval { - $tbl_struct = $tp->parse( - $tp->get_create_table($dbh, $db, $tbl)); - }; - if ( $EVAL_ERROR ) { - warn "Failed to get SHOW CREATE TABLE for $db.$tbl: " - . $EVAL_ERROR; - next; - } - $tbl_structs->{$db}->{$tbl} = $tbl_struct; - } - } - - $event->{tbl_structs} = $tbl_structs; - return $event; - }; - } - } - - # Run rules on query, get a list of rules that match (advice). - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: check query'); - my $event = $args{event}; - PTDEBUG && _d('Checking', $event->{arg}); - my ($advice, $near_pos) = $adv->run_rules(event => $event); - $event->{advice} = $advice; - $event->{near_pos} = $near_pos; - return $event; - }; - - my $json = $o->get('report-type')->{json} - ? {} : undef; - # Print info (advice) about each rule that matched this query. - if ( $groupby eq 'none' || $json ) { - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: print advice'); - my $event = $args{event}; - my $advice = $event->{advice}; - return $event unless @$advice || $o->get('print-all'); - $severity_count{$event->{query_id}}->{item} ||= $event->{fingerprint}; - print_advice( - %args, - seen_id => \%seen_id, - severity_count => \%severity_count, - verbose => $o->get('verbose'), - report_format => $o->get('report-format'), - json => $json, - Advisor => $adv, - ); - return $event; - }; - } - else { - push @pipeline, sub { - my ( %args ) = @_; - PTDEBUG && _d('callback: queue advice for group-by', $groupby); - my $event = $args{event}; - my $advice = $event->{advice}; - return $event unless @$advice || $o->get('print-all'); - $severity_count{$event->{query_id}}->{item} ||= $event->{fingerprint}; - queue_advice( - %args, - advice_queue => \%advice_queue, - severity_count => \%severity_count, - group_by => $groupby, - Advisor => $adv, - ); - return $event; - }; - } - - # ########################################################################## - # Get ready to do the main work. - # ########################################################################## - my $fh; - my $event = {}; - my $more_events = 1; - my $oktorun_sub = sub { $more_events = $_[0]; }; - my $next_event; - my $tell; - - if ( @ARGV == 0 ) { - push @ARGV, '-'; # Magical STDIN filename. - } - - # ######################################################################## - # Daemonize now that everything is setup and ready to work. - # ######################################################################## - my $daemon; - if ( $o->get('daemonize') ) { - $daemon = new Daemon(o=>$o); - $daemon->daemonize(); - PTDEBUG && _d('I am a daemon now'); - } - elsif ( $o->get('pid') ) { - # We're not daemoninzing, it just handles PID stuff. - $daemon = new Daemon(o=>$o); - $daemon->make_PID_file(); - } - - # ######################################################################## - # Do the version-check - # ######################################################################## - if ( $o->get('version-check') && (!$o->has('quiet') || !$o->get('quiet')) ) { - VersionCheck::version_check( - force => $o->got('version-check'), - instances => [ - ($review_dbh ? { dbh => $review_dbh, dsn => $review_dsn } : ()), - ($dbh ? { dbh => $dbh, dsn => $dsn } : ()), - ], - ); - } - - # ######################################################################### - # Do it! - # ######################################################################### - EVENT: - while ( $oktorun ) { - if ( !$fh ) { - my $file = shift @ARGV; - if ( !$file ) { - PTDEBUG && _d('No more files to parse'); - last EVENT; - } - if ( $file eq '-' ) { - $fh = *STDIN; - PTDEBUG && _d('Reading STDIN'); - } - else { - if ( !open $fh, "<", $file ) { - $fh = undef; - warn "Cannot open $file: $OS_ERROR\n"; - next EVENT; - } - PTDEBUG && _d('Reading', $file); - } - $next_event = sub { return <$fh>; }; - $tell = sub { return tell $fh; }; - } - - $event = {}; - $more_events = 1; - eval { - foreach my $proc ( @pipeline ) { - last unless $oktorun; # the global oktorun var - $event = $proc->( - event => $event, - fh => $fh, - next_event => $next_event, - tell => $tell, - oktorun => $oktorun_sub, - ); - last unless $event; - } - }; - if ( $EVAL_ERROR ) { - _d($EVAL_ERROR); - last EVENT unless $o->get('continue-on-error'); - } - if ( !$more_events ) { - PTDEBUG && _d('No more events'); - close $fh if $fh and $fh ne *STDIN; - $fh = undef; - } - } # EVENT - - $dbh->disconnect() if $dbh; - $review_dbh->disconnect() if $review_dbh; - - # ######################################################################## - # Aggregate and report items for group-by reports - # ######################################################################## - if ( $groupby ne 'none' && !$json ) { - print_grouped_report( - advice_queue => \%advice_queue, - group_by => $groupby, - verbose => $o->get('verbose'), - report_format => $o->get('report-format'), - ) - } - - # ######################################################################## - # Create and print profile of each items note/warn/crit count. - # ######################################################################## - if ( keys %severity_count && !$json ) { - eval { - my $profile = new ReportFormatter( - long_last_column => 1, - extend_right => 1, - ); - $profile->title("Profile"); - $profile->set_columns( - { name => 'Query ID', }, - { name => 'NOTE', right_justify => 1, }, - { name => 'WARN', right_justify => 1, }, - { name => 'CRIT', right_justify => 1, }, - { name => 'Item', }, - ); - foreach my $query_id ( sort keys %severity_count ) { - $profile->add_line( - "0x$query_id", - $severity_count{$query_id}->{note} || 0, - $severity_count{$query_id}->{warn} || 0, - $severity_count{$query_id}->{crit} || 0, - $severity_count{$query_id}->{item} || "", - ); - } - print "\n", $profile->get_report(); - }; - if ( $EVAL_ERROR ) { - # shouldn't happen but just in case ReportFormatter borks - warn "Error printing profile: $EVAL_ERROR"; - }; - } - - print Transformers::encode_json($json), "\n" if $json; - - return 0; -} - -# ########################################################################## -# Subroutines -# ########################################################################## - -sub print_advice { - my ( %args ) = @_; - my $event = $args{event}; - my $verbose = $args{verbose} || 0; - my $format = $args{report_format}; - my $adv = $args{Advisor}; - my $seen_id = $args{seen_id}; - my $severity_count = $args{severity_count}; - my $json = $args{json}; - - my $advice = $event->{advice}; - my $near_pos = $event->{near_pos}; - my $n_advice = scalar @$advice; - my @seen_ids; - - # Header - my $query_id = $event->{query_id} || ""; - - print "\n# Query ID 0x$query_id at byte " . ($event->{pos_in_log} || 0) . "\n" - unless $json; - - # New check IDs and their descriptions - foreach my $i ( 1..$n_advice ) { - my $rule_id = $advice->[$i - 1]; - my $pos = $near_pos->[$i - 1]; - my $info = $adv->get_rule_info($rule_id); - my $desc = $info->{description} || ''; # shouldn't be blank - if ( $format eq 'compact' && $seen_id->{$rule_id}++ ) { - push @seen_ids, $rule_id; - } - else { - # Haven't seen the description for this check ID yet so print it. - my @desc = map { - $_ .= '.' unless m/\.$/; - $_; - } split(/\.\s{1,2}/, $desc); - my $desc = $verbose == 1 ? $desc[0] # terse - : $verbose == 2 ? "$desc[0] $desc[1]" # fuller - : $verbose > 2 ? $desc # complete - : ''; # none - print "# ", uc $info->{severity}, " $rule_id $desc\n" - unless $json; - - if ( $pos && !$json ) { - my $offset = $pos > POS_CONTEXT ? $pos - POS_CONTEXT : 0; - print "# matches near: ", - substr($event->{arg}, $offset, ($pos - $offset) + POS_CONTEXT), - "\n"; - } - } - - if ( $json ) { - my $info_for_json = { - rule => $rule_id, - %$info - }; - push @{$json->{$query_id} ||= []}, $info_for_json; - } - - $severity_count->{$query_id}->{$info->{severity}}++; - } - - if ( !$json ) { - # Already seen check IDs - print "# Also: @seen_ids\n" if scalar @seen_ids; - - # The query - print "$event->{arg}\n"; - } - - return; -} - -sub queue_advice { - my ( %args ) = @_; - my @required_args = qw(advice_queue severity_count group_by event Advisor); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($advice_queue, $severity_count, $groupby, $event, $adv) - = @args{@required_args}; - - my $advice = $event->{advice}; - return unless scalar @$advice; - - my $query_id = $event->{query_id}; - if ( !$query_id ) { - warn "Event does not have a query ID"; # shouldn't happen - return; - } - - foreach my $rule_id ( @$advice ) { - my $info = $adv->get_rule_info($rule_id); - if ( $groupby eq 'query_id' ) { - $advice_queue->{$query_id}->{$rule_id}++; - } - elsif ( $groupby eq 'rule_id' ) { - $advice_queue->{$rule_id}->{$query_id}++; - } - else { - die "I don't know how to group items by $groupby"; - } - $severity_count->{$query_id}->{$info->{severity}}++; - } - - return; -} - -sub print_grouped_report { - my ( %args ) = @_; - my @required_args = qw(advice_queue group_by); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($advice_queue, $groupby) = @args{@required_args}; - my $verbose = $args{verbose} || 0; - my %seen; - - foreach my $groupby_attrib ( sort keys %$advice_queue ) { - print "\n" . ($groupby eq 'query_id' ? "0x" : "") . $groupby_attrib; - foreach my $groupby_value (sort keys %{$advice_queue->{$groupby_attrib}}){ - print " " . ($groupby ne 'query_id' ? '0x' : '') . $groupby_value; - } - print "\n"; - } - - return; -} - -sub get_cxn { - my ( %args ) = @_; - my @required_args = qw(dsn OptionParser DSNParser); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($dsn, $o, $dp) = @args{@required_args}; - - if ( $o->get('ask-pass') ) { - $dsn->{p} = OptionParser::prompt_noecho("Enter password: "); - } - - my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), $args{opts}); - $dbh->{FetchHashKeyName} = 'NAME_lc'; - PTDEBUG && _d('Connected dbh', $dbh); - return $dbh; -} - - -# Catches signals so we can exit gracefully. -sub sig_int { - my ( $signal ) = @_; - if ( $oktorun ) { - print STDERR "# Caught SIG$signal.\n"; - $oktorun = 0; - } - else { - print STDERR "# Exiting on SIG$signal.\n"; - exit 1; - } -} - -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"; -} - -# ############################################################################ -# Run the program. -# ############################################################################ -if ( !caller ) { exit main(@ARGV); } - -1; # Because this is a module as well as a script. - -# ############################################################################ -# Documentation -# ############################################################################ - -=pod - -=head1 NAME - -pt-query-advisor - Analyze queries and advise on possible problems. - -=head1 SYNOPSIS - -Usage: pt-query-advisor [OPTIONS] [FILE] - -pt-query-advisor analyzes queries and advises on possible problems. It can read -queries from several types of log files, or you can use the --query or --review -options. - -To analyze all queries in a MySQL slow query log file: - - pt-query-advisor /path/to/slow-query.log - -=head1 RISKS - -Percona Toolkit is mature, proven in the real world, and well tested, -but all database tools can pose a risk to the system and the database -server. Before using this tool, please: - -=over - -=item * Read the tool's documentation - -=item * Review the tool's known L<"BUGS"> - -=item * Test the tool on a non-production server - -=item * Backup your production server and verify the backups - -=back - -=head1 DESCRIPTION - -pt-query-advisor applies rules to queries, looking for potential problems. -It prints a report of queries that match rules. - -=head1 RULES - -These are the rules that pt-query-advisor will apply to the queries it -examines. Each rule has three bits of information: an ID, a severity -and a description. - -The rule's ID is its identifier. We use a seven-character ID, and the -naming convention is three characters, a period, and a three-digit -number. The first three characters are sort of an abbreviation of the -general class of the rule. For example, ALI.001 is some rule related -to how the query uses aliases. - -The rule's severity is an indication of how important it is that this -rule matched a query. We use NOTE, WARN, and CRIT to denote these -levels. - -The rule's description is a textual, human-readable explanation of -what it means when a query matches this rule. Depending on the -verbosity of the report you generate, you will see more of the text in -the description. By default, you'll see only the first sentence, -which is sort of a terse synopsis of the rule's meaning. At a higher -verbosity, you'll see subsequent sentences. - -=over - -=item ALI.001 - -severity: note - -Aliasing without the AS keyword. Explicitly using the AS keyword in -column or table aliases, such as "tbl AS alias," is more readable -than implicit aliases such as "tbl alias". - -=item ALI.002 - -severity: warn - -Aliasing the '*' wildcard. Aliasing a column wildcard, such as -"SELECT tbl.* col1, col2" probably indicates a bug in your SQL. -You probably meant for the query to retrieve col1, but instead it -renames the last column in the *-wildcarded list. - -=item ALI.003 - -severity: note - -Aliasing without renaming. The table or column's alias is the same as -its real name, and the alias just makes the query harder to read. - -=item ARG.001 - -severity: warn - -Argument with leading wildcard. An argument has a leading -wildcard character, such as "%foo". The predicate with this argument -is not sargable and cannot use an index if one exists. - -=item ARG.002 - -severity: note - -LIKE without a wildcard. A LIKE pattern that does not include a -wildcard is potentially a bug in the SQL. - -=item CLA.001 - -severity: warn - -SELECT without WHERE. The SELECT statement has no WHERE clause and could -examine many more rows than intended. - -=item CLA.002 - -severity: note - -ORDER BY RAND(). ORDER BY RAND() is a very inefficient way to -retrieve a random row from the results, because it sorts the entire result -and then throws most of it away. - -=item CLA.003 - -severity: note - -LIMIT with OFFSET. Paginating a result set with LIMIT and OFFSET is -O(n^2) complexity, and will cause performance problems as the data -grows larger. Pagination techniques such as bookmarked scans are much more -efficient. - -=item CLA.004 - -severity: note - -Ordinal in the GROUP BY clause. Using a number in the GROUP BY clause, -instead of an expression or column name, can cause problems if the -query is changed. - -=item CLA.005 - -severity: warn - -ORDER BY constant column. This is probably a bug in your SQL; at best it is a -useless operation that does not change the query results. - -=item CLA.006 - -severity: warn - -GROUP BY or ORDER BY on different tables. This will force the use of a temporary -table and filesort, which can be a huge performance problem and can consume -large amounts of memory and temporary space on disk. - -=item CLA.007 - -severity: warn - -ORDER BY clauses that sort the results in different directions prevents indexes -from being used. All expressions in the ORDER BY clause must be ordered either -ASC or DESC so that MySQL can use an index. - -=item COL.001 - -severity: note - -SELECT *. Selecting all columns with the * wildcard will cause the -query's meaning and behavior to change if the table's schema -changes, and might cause the query to retrieve too much data. - -=item COL.002 - -severity: note - -Blind INSERT. The INSERT or REPLACE query doesn't specify the -columns explicitly, so the query's behavior will change if the -table's schema changes; use "INSERT INTO tbl(col1, col2) VALUES..." -instead. - -=item LIT.001 - -severity: warn - -Storing an IP address as characters. The string literal looks like -an IP address, but is not an argument to INET_ATON(), indicating that -the data is stored as characters instead of as integers. It is -more efficient to store IP addresses as integers. - -=item LIT.002 - -severity: warn - -Unquoted date/time literal. A query such as "WHERE col<2010-02-12" is valid SQL -but is probably a bug, because it will be interpreted as "WHERE col<1996"; the -literal should be quoted. - -=item KWR.001 - -severity: note - -SQL_CALC_FOUND_ROWS is inefficient. SQL_CALC_FOUND_ROWS can cause -performance problems because it does not scale well; use -alternative strategies to build functionality such as paginated -result screens. - -=item JOI.001 - -severity: crit - -Mixing comma and ANSI joins. Mixing comma joins and ANSI joins is confusing to -humans, and the behavior and precedence differs between some MySQL versions, -which can introduce bugs. - -=item JOI.002 - -severity: crit - -A table is joined twice. The same table appears at least twice in the -FROM clause in a manner that can be reduced to a single access to the table. - -=item JOI.003 - -severity: warn - -OUTER JOIN defeated. The reference to an outer table column in the WHERE clause -prevents the OUTER JOIN from returning any non-matched rows, which implicitly -converts the query to an INNER JOIN. This is probably a bug in the query or a -misunderstanding of how OUTER JOIN works, as LEFT/RIGHT joins are a shortcut -for LEFT/RIGHT OUTER JOIN. - -=item JOI.004 - -severity: warn - -Exclusion join uses wrong column in WHERE. The exclusion join (LEFT -OUTER JOIN with a WHERE clause that is satisfied only if there is no row in -the right-hand table) seems to use the wrong column in the WHERE clause. A -query such as "... FROM l LEFT OUTER JOIN r ON l.l=r.r WHERE r.z IS NULL" -probably ought to list r.r in the WHERE IS NULL clause. - -=item RES.001 - -severity: warn - -Non-deterministic GROUP BY. The SQL retrieves columns that are -neither in an aggregate function nor the GROUP BY expression, so -these values will be non-deterministic in the result. - -=item RES.002 - -severity: warn - -LIMIT without ORDER BY. LIMIT without ORDER BY causes -non-deterministic results, depending on the query execution plan. - -=item STA.001 - -severity: note - -The != operator is non-standard. Use the <> operator to test for inequality -instead. - -=item SUB.001 - -severity: crit - -IN() and NOT IN() subqueries are poorly optimized. MySQL executes the subquery -as a dependent subquery for each row in the outer query. This is a frequent -cause of serious performance problems. This might improve in version 5.6 of -MySQL, but for versions 5.1 and older, the query should be rewritten as a JOIN -or a LEFT OUTER JOIN, respectively. - -=back - -=head1 OPTIONS - -L<"--query"> and L<"--review"> are mutually exclusive. - -This tool accepts additional command-line arguments. Refer to the -L<"SYNOPSIS"> and usage information for details. - -=over - -=item --ask-pass - -Prompt for a password when connecting to MySQL. - -=item --charset - -short form: -A; type: string - -Default character set. If the value is utf8, sets Perl's binmode on -STDOUT to utf8, passes the mysql_enable_utf8 option to DBD::mysql, and -runs SET NAMES UTF8 after connecting to MySQL. Any other value sets -binmode on STDOUT without the utf8 layer, and runs SET NAMES after -connecting to MySQL. - -=item --config - -type: Array - -Read this comma-separated list of config files; if specified, this must be the -first option on the command line. - -=item --[no]continue-on-error - -default: yes - -Continue working even if there is an error. - -=item --daemonize - -Fork to the background and detach from the shell. POSIX -operating systems only. - -=item --database - -short form: -D; type: string - -Connect to this database. This is also used as the default database -for L<"--[no]show-create-table"> if a query does not use database-qualified -tables. - -=item --defaults-file - -short form: -F; type: string - -Only read mysql options from the given file. You must give an absolute -pathname. - -=item --group-by - -type: string; default: rule_id - -Group items in the report by this attribute. Possible attributes are: - - ATTRIBUTE GROUPS - ========= ======================================================== - rule_id Items matching the same rule ID - query_id Queries with the same ID (the same fingerprint) - none No grouping, report each query and its advice separately - -=item --help - -Show help and exit. - -=item --host - -short form: -h; type: string - -Connect to host. - -=item --ignore-rules - -type: hash - -Ignore these rule IDs. - -Specify a comma-separated list of rule IDs (e.g. LIT.001,RES.002,etc.) -to ignore. Currently, the rule IDs are case-sensitive and must be uppercase. - -=item --password - -short form: -p; type: string - -Password to use when connecting. - -=item --pid - -type: string - -Create the given PID file. The tool won't start if the PID file already -exists and the PID it contains is different than the current PID. However, -if the PID file exists and the PID it contains is no longer running, the -tool will overwrite the PID file with the current PID. The PID file is -removed automatically when the tool exits. - -=item --port - -short form: -P; type: int - -Port number to use for connection. - -=item --print-all - -Print all queries, even those that do not match any rules. With -L<"--group-by"> C, non-matching queries are printed in the main report -and profile. For other L<"--group-by"> values, non-matching queries are only -printed in the profile. Non-matching queries have zeros for C, C -and C in the profile. - -=item --query - -type: string - -Analyze this single query and ignore files and STDIN. This option -allows you to supply a single query on the command line. Any files -also specified on the command line are ignored. - -=item --report-format - -type: string; default: compact - -Type of report format: full or compact. In full mode, every query's -report contains the description of the rules it matched, even if this -information was previously displayed. In compact mode, the repeated -information is suppressed, and only the rule ID is displayed. - -=item --report-type - -type: Hash - -Alternative formats to output the report. Currently, only "json" is -recognized -- anything else is ignored and the default behavior used. - -=item --review - -type: DSN - -Analyze queries from this pt-query-digest query review table. - -=item --sample - -type: int; default: 1 - -How many samples of the query to show. - -=item --set-vars - -type: Array - -Set the MySQL variables in this comma-separated list of C pairs. - -By default, the tool sets: - -=for comment ignore-pt-internal-value -MAGIC_set_vars - - wait_timeout=10000 - -Variables specified on the command line override these defaults. For -example, specifying C<--set-vars wait_timeout=500> overrides the defaultvalue of C<10000>. - -The tool prints a warning and continues if a variable cannot be set. - -=item --[no]show-create-table - -default: yes - -Get C for each query's table. - -If host connection options are given (like L<"--host">, L<"--port">, etc.) -then the tool will also get C for each query. This -information is needed for some rules like JOI.004. If this option is -disabled by specifying C<--no-show-create-table> then some rules may not -be checked. - -=item --socket - -short form: -S; type: string - -Socket file to use for connection. - -=item --type - -type: Array - -The type of input to parse (default slowlog). The permitted types are -slowlog and genlog. - -=item --user - -short form: -u; type: string - -User for login if not current user. - -=item --verbose - -short form: -v; cumulative: yes; default: 1 - -Increase verbosity of output. At the default level of verbosity, the -program prints only the first sentence of each rule's description. At -higher levels, the program prints more of the description. See also -L<"--report-format">. - -=item --version - -Show version and exit. - -=item --[no]version-check - -default: yes - -Check for the latest version of Percona Toolkit, MySQL, and other programs. - -This is a standard "check for updates automatically" feature, with two -additional features. First, the tool checks the version of other programs -on the local system in addition to its own version. For example, it checks -the version of every MySQL server it connects to, Perl, and the Perl module -DBD::mysql. Second, it checks for and warns about versions with known -problems. For example, MySQL 5.5.25 had a critical bug and was re-released -as 5.5.25a. - -Any updates or known problems are printed to STDOUT before the tool's normal -output. This feature should never interfere with the normal operation of the -tool. - -For more information, visit L. - -=item --where - -type: string - -Apply this WHERE clause to the SELECT query on the L<"--review"> table. - -=back - -=head1 DSN OPTIONS - -These DSN options are used to create a DSN. Each option is given like -C. The options are case-sensitive, so P and p are not the -same option. There cannot be whitespace before or after the C<=> and -if the value contains whitespace it must be quoted. DSN options are -comma-separated. See the L manpage for full details. - -=over - -=item * A - -dsn: charset; copy: yes - -Default character set. - -=item * D - -dsn: database; copy: yes - -Database that contains the query review table. - -=item * F - -dsn: mysql_read_default_file; copy: yes - -Only read default options from the given file - -=item * h - -dsn: host; copy: yes - -Connect to host. - -=item * p - -dsn: password; copy: yes - -Password to use when connecting. - -=item * P - -dsn: port; copy: yes - -Port number to use for connection. - -=item * S - -dsn: mysql_socket; copy: yes - -Socket file to use for connection. - -=item * t - -Table to use as the query review table. - -=item * u - -dsn: user; copy: yes - -User for login if not current user. - -=back - -=head1 ENVIRONMENT - -The environment variable C enables verbose debugging output to STDERR. -To enable debugging and capture all output to a file, run the tool like: - - PTDEBUG=1 pt-query-advisor ... > FILE 2>&1 - -Be careful: debugging output is voluminous and can generate several megabytes -of output. - -=head1 SYSTEM REQUIREMENTS - -You need Perl, DBI, DBD::mysql, and some core packages that ought to be -installed in any reasonably new version of Perl. - -=head1 BUGS - -For a list of known bugs, see L. - -Please report bugs at L. -Include the following information in your bug report: - -=over - -=item * Complete command-line used to run the tool - -=item * Tool L<"--version"> - -=item * MySQL version of all servers involved - -=item * Output from the tool including STDERR - -=item * Input files (log/dump/config files, etc.) - -=back - -If possible, include debugging output by running the tool with C; -see L<"ENVIRONMENT">. - -=head1 DOWNLOADING - -Visit L to download the -latest release of Percona Toolkit. Or, get the latest release from the -command line: - - wget percona.com/get/percona-toolkit.tar.gz - - wget percona.com/get/percona-toolkit.rpm - - wget percona.com/get/percona-toolkit.deb - -You can also get individual tools from the latest release: - - wget percona.com/get/TOOL - -Replace C with the name of any tool. - -=head1 AUTHORS - -Baron Schwartz and Daniel Nichter - -=head1 ABOUT PERCONA TOOLKIT - -This tool is part of Percona Toolkit, a collection of advanced command-line -tools for MySQL developed by Percona. Percona Toolkit was forked from two -projects in June, 2011: Maatkit and Aspersa. Those projects were created by -Baron Schwartz and primarily developed by him and Daniel Nichter. Visit -L to learn about other free, open-source -software from Percona. - -=head1 COPYRIGHT, LICENSE, AND WARRANTY - -This program is copyright 2010-2013 Percona Ireland Ltd. - -THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED -WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF -MERCHANTABILITY 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. - -=head1 VERSION - -pt-query-advisor 2.1.8 - -=cut diff --git a/lib/QueryAdvisorRules.pm b/lib/QueryAdvisorRules.pm deleted file mode 100644 index ad315ef2..00000000 --- a/lib/QueryAdvisorRules.pm +++ /dev/null @@ -1,687 +0,0 @@ -# This program is copyright 2010-2011 Percona Ireland Ltd. -# 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. -# ########################################################################### -# QueryAdvisorRules package -# ########################################################################### -{ -# Package: QueryAdvisorRules -# QueryAdvisorRules encapsulates rules for checking queries. -package QueryAdvisorRules; -use base 'AdvisorRules'; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use constant PTDEBUG => $ENV{PTDEBUG} || 0; - -sub new { - my ( $class, %args ) = @_; - my $self = $class->SUPER::new(%args); - @{$self->{rules}} = $self->get_rules(); - PTDEBUG && _d(scalar @{$self->{rules}}, "rules"); - return $self; -} - -# Each rules is a hashref with two keys: -# * id Unique PREFIX.NUMBER for the rule. The prefix is three chars -# which hints to the nature of the rule. See example below. -# * code Coderef to check rule, returns undef if rule does not match, -# else returns the string pos near where the rule matches or 0 -# to indicate it doesn't know the pos. The code is passed a\ -# single arg: a hashref event. -sub get_rules { - return - { - id => 'ALI.001', # Implicit alias - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - foreach my $tbl ( @$tbls ) { - return 0 if $tbl->{alias} && !$tbl->{explicit_alias}; - } - my $cols = $struct->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{alias} && !$col->{explicit_alias}; - } - return; - }, - }, - { - id => 'ALI.002', # tbl.* alias - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $cols = $event->{query_struct}->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{tbl} && $col->{col} eq '*' && $col->{alias}; - } - return; - }, - }, - { - id => 'ALI.003', # tbl AS tbl - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - foreach my $tbl ( @$tbls ) { - return 0 if $tbl->{alias} && $tbl->{alias} eq $tbl->{tbl}; - } - my $cols = $struct->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{alias} && $col->{alias} eq $col->{col}; - } - return; - }, - }, - { - id => 'ARG.001', # col = '%foo' - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $where = $event->{query_struct}->{where}; - return unless $where && @$where; - foreach my $arg ( @$where ) { - return 0 - if ($arg->{operator} || '') eq 'like' - && $arg->{right_arg} =~ m/[\'\"][\%\_]./; - } - return; - }, - }, - { - id => 'ARG.002', # LIKE w/o wildcard - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $where = $event->{query_struct}->{where}; - return unless $where && @$where; - foreach my $arg ( @$where ) { - return 0 - if ($arg->{operator} || '') eq 'like' - && $arg->{right_arg} !~ m/[%_]/; - } - return; - }, - }, - { - id => 'CLA.001', # SELECT w/o WHERE - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless ($event->{query_struct}->{type} || '') eq 'select'; - return unless $event->{query_struct}->{from}; - return 0 unless $event->{query_struct}->{where}; - return; - }, - }, - { - id => 'CLA.002', # ORDER BY RAND() - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $orderby = $event->{query_struct}->{order_by}; - return unless $orderby; - foreach my $ident ( @$orderby ) { - # SQLParser will have uppercased the function name. - return 0 if $ident->{function} && $ident->{function} eq 'RAND'; - } - return; - }, - }, - { - id => 'CLA.003', # LIMIT w/ OFFSET - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless $event->{query_struct}->{limit}; - return unless defined $event->{query_struct}->{limit}->{offset}; - return 0; - }, - }, - { - id => 'CLA.004', # GROUP BY - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $groupby = $event->{query_struct}->{group_by}; - return unless $groupby; - foreach my $ident ( @$groupby ) { - return 0 if exists $ident->{position}; - } - return; - }, - }, - { - id => 'CLA.005', # ORDER BY col where col= - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $orderby = $event->{query_struct}->{order_by}; - return unless $orderby; - my $where = $event->{query_struct}->{where}; - return unless $where; - my %orderby_col = map { lc $_->{column} => 1 } - grep { $_->{column} } - @$orderby; - foreach my $pred ( @$where ) { - my $val = $pred->{right_arg}; - next unless $val; - return 0 if $val =~ m/^\d+$/ && $orderby_col{lc($pred->{left_arg} || '')}; - } - return; - }, - }, - { - id => 'CLA.006', # GROUP BY or ORDER BY different tables - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $groupby = $event->{query_struct}->{group_by}; - my $orderby = $event->{query_struct}->{order_by}; - return unless $groupby || $orderby; - - my %groupby_tbls = map { $_->{table} => 1 } - grep { $_->{table} } - @$groupby; - return 0 if scalar keys %groupby_tbls > 1; - - my %orderby_tbls = map { $_->{table} => 1 } - grep { $_->{table} } - @$orderby; - return 0 if scalar keys %orderby_tbls > 1; - - # Remove ORDER BY tables from GROUP BY tables. Any tables - # remain in GROUP BY are unique to GROUP BY, i.e. not in - # ORDER BY, so we have a case like: group by tbl1.id order by tbl2.id - map { delete $groupby_tbls{$_} } keys %orderby_tbls; - return 0 if scalar keys %groupby_tbls; - - return; - }, - }, - { - id => 'CLA.007', # ORDER BY ASC/DESC mix can't use index - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $order_by = $event->{query_struct}->{order_by}; - return unless $order_by; - my ($asc, $desc) = (0, 0); - foreach my $col ( @$order_by ) { - if ( ($col->{sort} || 'ASC') eq 'ASC' ) { - $asc++; - } - else { - $desc++; - } - return 0 if $asc && $desc; - } - return; - }, - }, - { - id => 'COL.001', # SELECT * - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless ($event->{query_struct}->{type} || '') eq 'select'; - my $cols = $event->{query_struct}->{columns}; - return unless $cols; - foreach my $col ( @$cols ) { - return 0 if $col->{col} eq '*' && !$col->{func}; - } - return; - }, - }, - { - id => 'COL.002', # INSERT w/o (cols) def - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $type = $event->{query_struct}->{type} || ''; - return unless $type eq 'insert' || $type eq 'replace'; - return 0 unless $event->{query_struct}->{columns}; - return; - }, - }, - { - id => 'LIT.001', # IP as string - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - if ( $event->{arg} =~ m/['"]\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/gc ) { - return (pos $event->{arg}) || 0; - } - return; - }, - }, - { - id => 'LIT.002', # Date not quoted - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - # YYYY-MM-DD - if ( $event->{arg} =~ m/(?{arg}) || 0; - } - # YY-MM-DD - if ( $event->{arg} =~ m/(?{arg}) || 0; - } - return; - }, - }, - { - id => 'KWR.001', # SQL_CALC_FOUND_ROWS - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return 0 if $event->{query_struct}->{keywords}->{sql_calc_found_rows}; - return; - }, - }, - { - id => 'JOI.001', # comma and ansi joins - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my $comma_join = 0; - my $ansi_join = 0; - foreach my $tbl ( @$tbls ) { - if ( $tbl->{join} ) { - if ( $tbl->{join}->{ansi} ) { - $ansi_join = 1; - } - else { - $comma_join = 1; - } - } - return 0 if $comma_join && $ansi_join; - } - return; - }, - }, - { - id => 'RES.001', # non-deterministic GROUP BY - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless ($event->{query_struct}->{type} || '') eq 'select'; - my $groupby = $event->{query_struct}->{group_by}; - return unless $groupby; - # Only check GROUP BY column names, not numbers. GROUP BY number - # is handled in CLA.004. - my %groupby_col = map { $_->{column} => 1 } - grep { $_->{column} } - @$groupby; - return unless scalar %groupby_col; - # Skip non-columns -- NULL, digits, functions, variables - my $cols = [ - grep { _looks_like_column($_->{col}) } - grep { ! exists $_->{func} } - @{$event->{query_struct}->{columns}} - ]; - # All SELECT cols must be in GROUP BY cols clause. - # E.g. select a, b, c from tbl group by a; -- non-deterministic - foreach my $col ( @$cols ) { - return 0 unless $groupby_col{ $col->{col} } - || ($col->{alias} && $groupby_col{ $col->{alias} }); - } - return; - }, - }, - { - id => 'RES.002', # non-deterministic LIMIT w/o ORDER BY - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return unless $event->{query_struct}->{limit}; - # If query doesn't use tables then this check isn't applicable. - return unless $event->{query_struct}->{from} - || $event->{query_struct}->{into} - || $event->{query_struct}->{tables}; - return 0 unless $event->{query_struct}->{order_by}; - return; - }, - }, - { - id => 'STA.001', # != instead of <> - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - return 0 if $event->{arg} =~ m/!=/; - return; - }, - }, - { - id => 'SUB.001', # IN() - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - if ( $event->{arg} =~ m/\bIN\s*\(\s*SELECT\b/gi ) { - return pos $event->{arg}; - } - return; - }, - }, - { - id => 'JOI.002', # table joined more than once, but not self-join - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - return unless $struct; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my %tbl_cnt; - my $n_tbls = scalar @$tbls; - - # To detect this rule we look for tables joined more than once - # (if cnt > 1) and via both an ansi and comma join. This captures - # "t AS a JOIN t AS b a.foo=b.bar, t" but not the simple self-join - # "t AS a JOIN t AS b a.foo=b.bar" or cases where a table is joined - # to many other tables all via ansi joins or the implicit self-join - # (which we really can't detect) "t AS a, t AS b WHERE a.foo=b.bar". - # When a table shows up multiple times in ansi joins and then again - # in a comma join, the comma join is usually culprit of this rule. - for my $i ( 0..($n_tbls-1) ) { - my $tbl = $tbls->[$i]; - my $tbl_name = lc $tbl->{tbl}; - - $tbl_cnt{$tbl_name}->{cnt}++; - $tbl_cnt{$tbl_name}->{ansi_join}++ - if $tbl->{join} && $tbl->{join}->{ansi}; - $tbl_cnt{$tbl_name}->{comma_join}++ - if $tbl->{join} && !$tbl->{join}->{ansi}; - - if ( $tbl_cnt{$tbl_name}->{cnt} > 1 ) { - return 0 - if $tbl_cnt{$tbl_name}->{ansi_join} - && $tbl_cnt{$tbl_name}->{comma_join}; - } - } - return; - }, - }, - { - id => 'JOI.003', # OUTER JOIN converted to INNER JOIN - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - return unless $struct; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my $where = $struct->{where}; - return unless $where; - - # Good LEFT OUTER JOIN: - # select * from L left join R using(c) where L.a=5; - # Converts to INNER JOIN when: - # select * from L left join R using(c) where L.a=5 and R.b=10; - # To detect this condition we need to see if there's an OUTER - # join then see if there's a column from the outer table in the - # WHERE clause that is anything but "IS NULL". So in the example - # above, R.b=10 is this culprit. - # http://code.google.com/p/maatkit/issues/detail?id=950 - my %outer_tbls = map { $_->{tbl} => 1 } get_outer_tables($tbls); - PTDEBUG && _d("Outer tables:", keys %outer_tbls); - return unless %outer_tbls; - - foreach my $pred ( @$where ) { - next unless $pred->{left_arg}; # skip constants like 1 in "WHERE 1" - my ($tbl, $col) = split /\./, $pred->{left_arg}; - if ( $tbl && $col && $outer_tbls{$tbl} ) { - # Only outer_tbl.col IS NULL is permissible. - if ($pred->{operator} ne 'is' || $pred->{right_arg} !~ m/null/i) - { - PTDEBUG && _d("Predicate prevents OUTER JOIN:", - map { $pred->{$_} } qw(left_arg operator right_arg)); - return 0; - } - } - } - - return; - } - }, - { - id => 'JOI.004', # broken exclusion join - code => sub { - my ( %args ) = @_; - my $event = $args{event}; - my $struct = $event->{query_struct}; - return unless $struct; - my $tbls = $struct->{from} || $struct->{into} || $struct->{tables}; - return unless $tbls; - my $where = $struct->{where}; - return unless $where; - - my %outer_tbls; - my %outer_tbl_join_cols; - my @unknown_join_cols; - foreach my $outer_tbl ( get_outer_tables($tbls) ) { - $outer_tbls{$outer_tbl->{tbl}} = 1; - - # For "L LEFT JOIN R" R is the outer table and since it follows - # L its table struct will have the join struct with the join - # condition. But for "L RIGHT JOIN R" L is the outer table and - # will not have the join struct because it precedes R. This - # is due to how parse_from() works. So if the outer table doesn't - # have the join struct, we need to get it from the inner table. - my $join = $outer_tbl->{join}; - if ( !$join ) { - my ($inner_tbl) = grep { - exists $_->{join} - && $_->{join}->{to} eq $outer_tbl->{tbl} - } @$tbls; - $join = $inner_tbl->{join}; - die "Cannot find join structure for $outer_tbl->{tbl}" - unless $join; - } - - # Get the outer table columns used in the jon condition. - if ( $join->{condition} eq 'using' ) { - %outer_tbl_join_cols = map { $_ => 1 } @{$join->{columns}}; - } - else { - my $where = $join->{where}; - die "Join structure for ON condition has no where structure" - unless $where; - my @join_cols; - foreach my $pred ( @$where ) { - next unless $pred->{operator} eq '='; - # Assume all equality comparisons are like tbl1.col=tbl2.col. - # Thus join conditions like tbl1.col{left_arg}, $pred->{right_arg}; - } - PTDEBUG && _d("Join columns:", @join_cols); - foreach my $join_col ( @join_cols ) { - my ($tbl, $col) = split /\./, $join_col; - if ( !$col ) { - $col = $tbl; - $tbl = determine_table_for_column( - column => $col, - tbl_structs => $event->{tbl_structs}, - ); - } - if ( !$tbl ) { - PTDEBUG && _d("Cannot determine the table for join column", - $col); - push @unknown_join_cols, $col; - } - else { - $outer_tbl_join_cols{$col} = 1 - if $tbl eq $outer_tbl->{tbl}; - } - } - } - } - PTDEBUG && _d("Outer table join columns:", keys %outer_tbl_join_cols); - PTDEBUG && _d("Unknown join columns:", @unknown_join_cols); - - # Here's a problem query: - # select c from L left join R on L.a=R.b where L.a=5 and R.c is null - # The problem is "R.c is null" will not allow one to determine if - # a null row from the outer table is null due to not matching the - # inner table or due to R.c actually having a null value. So we - # need to check every outer table column in the WHERE clause for - # ones that are 1) not in the JOIN expression and 2) "IS NULL'. - # http://code.google.com/p/maatkit/issues/detail?id=950 - foreach my $pred ( @$where ) { - next unless $pred->{left_arg}; # skip constants like 1 in "WHERE 1" - next unless $pred->{operator} eq 'is' - && $pred->{right_arg} =~ m/NULL/i; - - my ($tbl, $col) = split /\./, $pred->{left_arg}; - if ( !$col ) { - # A col in the WHERE clause isn't table-qualified. Try to - # determine its table. If we can, great, if not "return 0 if" - # below will immediately fail because $tbl will be undef still. - # That's ok; it just means this test tries as best it can and - # gets skipped silently when we can't tbl-qualify cols. - $col = $tbl; - $tbl = determine_table_for_column( - column => $col, - tbl_structs => $event->{tbl_structs}, - ); - } - next unless $tbl; # can't check tbl if tbl is unknown - next unless $outer_tbls{$tbl}; # only want outer tbl cols - - # At this point we know col is from outer table and "IS NULL". - # "outer_tbl.join_col IS NULL" is ok, but... - next if $outer_tbl_join_cols{$col}; - - # ...this rule could match here for two reasons. First, if - # we know the outer tbl join cols and this col isn't one of them - # (hence the statement above passed and we got here), then - # @unknown_join_cols will be empty and we'll match. This is like - # "outer_tbl.NON_join_col IS NULL". Or second, we don't know - # the outer tbl join cols and @unknown_join_cols will have cols - # and we'll match if this col isn't one of the unknown join cols. - # This is for cases like: - # select c from L left join R on a=b where L.a=5 and R.c is null - # We don't know if a or b belong to L or R but we know c is from - # the outer table and is neither a nor b. - return 0 unless grep { $col eq $_ } @unknown_join_cols; - } - - return; # rule does not match, as best as we can determine - } - }, -}; - - -# Sub: get_outer_tables -# Get the outer tables in joins. -# -# Parameters: -# $tbls - Arrayref of hashrefs with table info -# -# Returns: -# Array of hashref to the outer tables -sub get_outer_tables { - my ( $tbls ) = @_; - return unless $tbls; - my @outer_tbls; - my $n_tbls = scalar @$tbls; - for my $i( 0..($n_tbls-1) ) { - my $tbl = $tbls->[$i]; - next unless $tbl->{join} && $tbl->{join}->{type} =~ m/left|right/i; - push @outer_tbls, - $tbl->{join}->{type} =~ m/left/i ? $tbl - : $tbls->[$i - 1]; - } - return @outer_tbls; -} - - -# Sub: determine_table_for_column -# Determine which table a column belongs to. No extensive, online effort -# is made to determine the column's table. The caller is responsible for -# using the parsed SQL structure to get its db/tables and their tbl structs -# and providing a list of them. -# -# Parameters: -# %args - Arguments -# -# Required Arguments: -# column - column name, not quoted -# -# Optional Arguments: -# tbl_structs - arrayref hashrefs returned by -# -# Returns: -# Table name, not quoted -sub determine_table_for_column { - my ( %args ) = @_; - my @required_args = qw(column); - foreach my $arg ( @required_args ) { - die "I need a $arg argument" unless $args{$arg}; - } - my ($col) = @args{@required_args}; - - my $tbl_structs = $args{tbl_structs}; - return unless $tbl_structs; - - foreach my $db ( keys %$tbl_structs ) { - foreach my $tbl ( keys %{$tbl_structs->{$db}} ) { - if ( $tbl_structs->{$db}->{$tbl}->{is_col}->{$col} ) { - PTDEBUG && _d($col, "column belongs to", $db, $tbl); - return $tbl; - } - } - } - - PTDEBUG && _d("Cannot determine table for column", $col); - return; -} - -sub _looks_like_column { - my $col = shift; - # NULL, numbers, variables and functions are definitely not columns - return if $col eq '*' || uc($col) eq 'NULL'; - return if $col =~ /\A(?:\b[0-9]+\b|\@{1,2}.+)/; - return $col; -} - -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 QueryAdvisorRules package -# ########################################################################### diff --git a/t/lib/samples/bug_823431.log b/t/lib/samples/bug_823431.log deleted file mode 100644 index 11cd9f8f..00000000 --- a/t/lib/samples/bug_823431.log +++ /dev/null @@ -1,88 +0,0 @@ -# User@Host: myuser[mydb] @ [40.0.0.5] -# Thread_id: 404054555 Schema: mydb -# Query_time: 40.545555 Lock_time: 0.000550 Rows_sent: 0 Rows_examined: 0 Rows_affected: 4 Rows_read: 4 -# QC_Hit: No Full_scan: No Full_join: No Tmp_table: No Tmp_table_on_disk: No -# Filesort: No Filesort_on_disk: No Merge_passes: 0 -# InnoDB_IO_r_ops: 4 InnoDB_IO_r_bytes: 45455 InnoDB_IO_r_wait: 0.000045 -# InnoDB_rec_lock_wait: 0.000000 InnoDB_queue_wait: 0.000000 -# InnoDB_pages_distinct: 45 -use mydb; -SET insert_id=45054; -INSERT INTO -friends -(jid, amisnonjoueurs, amisjoueurs, jour) -VALUES -(4444555450,'545544|rznnzrzr Crzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_545544_4554_q.jpg,540544445|Nzcky Pzrry|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55504_540544445_5555545_q.jpg,540545055|Lzndz Wzlkzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_540545055_5555_q.jpg,540555054|znnzssz zZszl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54544_540555054_5545505_q.jpg,545054545|Zzrzzl zssznrzzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54540_545054545_5544_q.jpg,545405444|Dzprnz rlzZssrznd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_545405444_4544555_q.jpg,545450545|rznzgzn zkzszs rlznkz rzrzwzzc-Szczzpznskz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_545450545_5504_q.jpg,544445545|Dzvz CrzpZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55454_544445545_5054_q.jpg,544455445|Zzgzn Przpps|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54540_544455445_4550_q.jpg,54445 -5455|Czrl R Grzrrzsrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55445_544455455_5455_q.jpg,545545555|znnSzrzz Wzrnrzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55040_545545555_4455445_q.jpg,545555555|Lznn Skĺnrzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55550_545555555_5555_q.jpg,555055550|Lzz Pzsszrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455450_555055550_5555004_q.jpg,555405445|Srzzn Wzlls|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_555405445_5550545_q.jpg,554455555|Zzkz Lz rzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54554_554455555_5554405_q.jpg,555545054|Lznn rznsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/50555_555545054_5054555_q.jpg,550555055|rznz rzrZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55544_550555055_4444454_q.jpg,554555555|rrzndzn Czllzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs405.zsr4/44405_554555555_5555_q.jpg,554544505|Przlzppz Vzllz|http://przrzlz.zk -.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_554544505_5555_q.jpg,555540054|Lzzrz rrzwn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/50454_555540054_5554555_q.jpg,555555455|Srzznz z\'Nzzll Clzrk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_555555455_5554_q.jpg,555545455|Dzwn Zzrsznzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_555545455_4504555_q.jpg,555555454|rzzrdzsk zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455455_555555454_5554555_q.jpg,555454545|rzrnzndz rzrgzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54540_555454545_5554_q.jpg,555455050|rz Wrzsrzzld|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55404_555455050_5545550_q.jpg,555554440|KzZrzrlzy Pznnzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_555554440_4545_q.jpg,500555455|Lzzrzns Kzsszl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/50555_500555455_4545455_q.jpg,504555555|Kzrzn Rzwlzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs45 -5.snc4/44454_504555555_5445_q.jpg,544455455|rzrrzd Wrzsrzzld|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54554_544455455_5554_q.jpg,545450555|Zzrszn zpplzszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_545450555_445_q.jpg,545545054|Gzzl rzZzlszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55554_545545054_5555454_q.jpg,545504445|Rzrzrs Wzrnrzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_545504445_5000_q.jpg,554554555|Nzczlz Dzrrzzld|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55005_554554555_5445555_q.jpg,554555555|Kzrzlzznz Zäkznzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_554555555_5500_q.jpg,555005455|szzlz rzkzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_555005455_4455_q.jpg,554455555|Nzczlás Gzrcíz zrzndz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54540_554455555_4555_q.jpg,555555504|Czczlzz CzrZzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs404.zsr4/44055_555555504_554_q. -rpg,555545445|zllzn Zzrsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54554_555545445_4455405_q.jpg,555544505|Zzrzz-Céczlz Lzrzyz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54554_555544505_4544_q.jpg,555450555|Crrzssznz ScrZzds|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50545_555450555_550455_q.jpg,555454405|Czrzl rzvzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55550_555454405_4554455_q.jpg,505454545|zlzvzzr Pésré|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_505454545_5555400_q.jpg,540550444|Lzrrzznz zSzllzvzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54545_540550444_45455_q.jpg,545554555|zZélzz zzrzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_545554555_5554_q.jpg,545555455|Kyzdzz zkzszs Kyzdzz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45505_545555455_5545_q.jpg,545554554|Rzcrzzl Czrr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_545554554_5440555_q.jpg,545455455|DzZ -znzqzz RzZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_545455455_4555_q.jpg,545455504|Zzsszz Gzzzzssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54504_545455504_455_q.jpg,545544445|Dznz zzrzrg zpplzng|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs550.snc5/55555_545544445_5454_q.jpg,550455540|Crrzs ZcLzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55550_550455540_5555_q.jpg,554055445|szrz Ssrzdzr -rzdz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55440_554055445_5545555_q.jpg,555554055|Dznny Zzzlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45450_555554055_5555_q.jpg,555554455|Nzsz Dzzssrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_555554455_5545_q.jpg,554555555|rzlzn Dzxzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_554555555_4555555_q.jpg,555555454|Crrzsszl Clzzsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45450_555555454_4555_q.jpg,554504555|rznzsrzn Zzkz Nzpzzrzr|http://przrzlz.z -k.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_554504555_5554544_q.jpg,505040555|Szndzzp Kzlzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55545_505040555_4455444_q.jpg,545054455|zlzvzzr Zzzckzlrzrgrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_545054455_455_q.jpg,544555554|Zzrsznz vzn Dzrkzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_544555554_5554555_q.jpg,554055444|sznyz Ssrzzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_554055444_5545_q.jpg,4005554555|zlzxzndzr Vzrsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4005554555_4445_q.jpg,4005554555|Cznssznsznz Zzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4005554555_5405450_q.jpg,4044504505|Srzlly rzckwzsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_4044504505_4445_q.jpg,4045444555|Kzylznz zsrzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4045444555_5045_q.jpg,4040454555|rzvzzr rzrrz|http://przrzlz.zk.hidden.com/rprzrzl -z-zk-snc5/rs455.snc5/54505_4040454555_4445554_q.jpg,4045455544|Zzrzznz rzrrzrz Kyzdzz rzddz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50545_4045455544_4554445_q.jpg,4054444540|zZZz ZcCzrsnzy Szgzrlznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55450_4054444540_5554504_q.jpg,4055555555|Szsznz Dzrrzzzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4055555555_4444544_q.jpg,4055055555|Kzsry Z Sszrlzccz-ScrZzzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54504_4055055555_5554_q.jpg,4054504555|Crznzr zkzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55504_4054504555_5540_q.jpg,4054444555|Crrzssy Dzlgzdz-Skylznz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55554_4054444555_5554555_q.jpg,4055450554|rzzn-clzzdz RzZy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54545_4055450554_4555_q.jpg,4055404555|Vzrznzqzz Czzszrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54544_4055404555_5555544_q.jpg,4054545055|Dzvzd Klz -ngrzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45455_4054545055_550_q.jpg,4055545455|rlzzvznz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4055545455_5555545_q.jpg,4054545554|Gzzvznnz Dzsszrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4054545554_4545_q.jpg,4055555555|Kznnzsr Grzrrzsrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4055555555_5554_q.jpg,4405455545|Dzrrzn srzrlzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55445_4405455545_5050_q.jpg,4405044555|Dznzzl Dzgnzzzx|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55054_4405044555_4455_q.jpg,4405555445|Zzrzz srzrzsz Gzzdzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55404_4405555445_4540555_q.jpg,4405454454|rzrvé rénzzérz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54545_4405454454_5055555_q.jpg,4440055455|Czrlzs Rzdrzgzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55555_4440055455_5455554_q.jpg,4444044554|Kzylzzn r -zndzrszn\' zsrzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54500_4444044554_5505540_q.jpg,4444545545|rzlznz Šzrzsszvá|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_4444545545_5544_q.jpg,4444504554|Szndrz Wzssyn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4444504554_4555_q.jpg,4444550555|Zzz rzrnzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55544_4444550555_5554440_q.jpg,4445544555|rrznçzzsz Zzrqzzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45454_4445544555_545_q.jpg,4445454445|Czrzl rrzzdZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455455_4445454445_4554455_q.jpg,4445544555|Kzrzzdz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4445544555_445555_q.jpg,4445555555|zrznz rz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_4445555555_4455_q.jpg,4445555554|Crzzg S LzZzx|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54544_4445555554_4555_q.jpg,4455555544|Zzzd Kzppzns|http:// -przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4455555544_5555_q.jpg,4455445555|rzz z\'Nzzll|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_4455445555_4454_q.jpg,4454440554|Crrzszn SZzsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4454440554_5440545_q.jpg,4454540555|rznnzrzr Szzgné|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_4454540555_5555_q.jpg,4454455445|zndzrs rzrznszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_4454455445_5544555_q.jpg,4454545540|Crrzssy rzndy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55404_4454545540_4540555_q.jpg,4450555555|Zzlzsz rzšnrzk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55540_4450555555_4554_q.jpg,4455055545|Sszvz Pzrrzsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/50455_4455055545_5005544_q.jpg,4455545455|Dzvzd Vzn dz Vzldz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_4455545455_4555_q.jpg,4400554545|Yvzs zrnzzld|http://przrzlz.zk.hidden.com -/rprzrzlz-zk-snc5/rs445.zsr4/55554_4400554545_4405_q.jpg,4445044544|Lzrédznz zlrzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54454_4445044544_5544_q.jpg,4445445445|SzZzn Gzsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4445445445_5055_q.jpg,4444405054|Gzzvznnz zlzxzs VzzlZz Zzrsznzllz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45545_4444405054_4454_q.jpg,4444455445|zkzszs zZzrzcznzs Dz Crzlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4444455445_455555_q.jpg,4445550445|Lzrry Kzplzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4445550445_555_q.jpg,4445045504|Pzzlz zrzlznd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4445045504_505545_q.jpg,4445555555|zxzl Pzrczk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_4445555555_4404_q.jpg,4454455545|rz Grzzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4454455545_504_q.jpg,4455555554|Szlvzszrz Rzgzszsz|http://przrzlz.zk.hidden.com/rprzr -zlz-zk-snc5/rs455.snc4/44455_4455555554_4555_q.jpg,4450555544|Vzlérzz Rzgzwskz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50545_4450555544_4555054_q.jpg,4454555555|Zzcrzël Wzzrss|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4454555555_5455054_q.jpg,4455454555|Crrzsszprz Dzllz Vzccrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4455454555_5540_q.jpg,4455550454|szssz zrzrräzszr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4455550454_5055_q.jpg,4454455445|zszrzllz Pzszsrzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55405_4454455445_44_q.jpg,4454445555|Nzcky Vznrzlszzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55405_4454445555_4545055_q.jpg,4455555545|Crlzé rrzdzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4455555545_5455555_q.jpg,4455045545|szZzsrz r. Dzvznpzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55055_4455045545_5455545_q.jpg,4450550404|zpzcsszd zkzszs|http://przrzlz.zk.rrcdn. -nzs/rprzrzlz-zk-snc5/rs555.snc5/55454_4450550404_5545550_q.jpg,4454454554|Spzszczllz Kznnzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4454454554_5550540_q.jpg,4455554504|zllzn Pzdzrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4455554504_5455_q.jpg,4455550554|rzzn-Pzzrrz Dzlszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54540_4455550554_4004555_q.jpg,4455455545|Zzrzz Vzcqzzrzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4455455545_5555_q.jpg,4455540455|rzsz Zzrzd rzdzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55504_4455540455_4555_q.jpg,4404554505|rzzl rlzckrzyszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4404554505_455_q.jpg,4404545055|Srzrzz rrzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54554_4404545055_4455544_q.jpg,4440555544|Rzrzn rzrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_4440555544_5550455_q.jpg,4444444544|Sszczy rzrrZznn|http://przrzlz.zk.hidden.com/rprzrz -lz-zk-snc5/rs544.snc4/45445_4444444544_5405_q.jpg,4444545454|Kzssy Lzly|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55554_4444545454_5545_q.jpg,4445540504|Zzkz rznnzss|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55554_4445540504_4404_q.jpg,4445545404|Kzsry zZrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50055_4445545404_5540_q.jpg,4445540545|Pzsrznz vzn dzn rzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4445540545_5550_q.jpg,4445555554|Lzndz zngzZz-zxczl Srz-Kz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4445555554_4545444_q.jpg,4445555054|rznzssz Pzgz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4445555054_5550454_q.jpg,4445000504|Lzrz Rzckzrd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55445_4445000504_445_q.jpg,4444550500|Kzszz zslzng|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4444550500_5045_q.jpg,4444545055|Zzdwzsszkzsz RzsczzSzczzsy|http://przrzlz.zk.hidden.com/rprzrzlz-zk- -snc5/rs555.snc5/55555_4444545055_4455405_q.jpg,4445544545|Sszrznz Cznzvz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4445544545_4544455_q.jpg,4445545555|Kzng-zkz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55505_4445545555_5544_q.jpg,4445505445|rzlznz Pylvänäznzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55545_4445505445_4555555_q.jpg,4455504545|Nzszz Nzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50055_4455504545_5440555_q.jpg,4450404554|Dzdzzr Czrpznszzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_4450404554_5445_q.jpg,4450545055|Crrzsszllz rzngzrd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44055_4450545055_5505_q.jpg,4450555550|zdrzzn Pzrkz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50544_4450555550_5455544_q.jpg,4454440550|zlzsz Zzszssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55045_4454440550_4545545_q.jpg,4454544555|zlzvzzr szrwzgnz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs -445.zsr4/55555_4454544555_5455555_q.jpg,4454505544|VzlzZzr zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54450_4454505544_5545_q.jpg,4455454555|rzzn-Zzrc dz szrwzngnz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54544_4455454555_5444_q.jpg,4455454544|Sszprznz Pzsrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55505_4455454544_5445_q.jpg,4455454555|Lzndz srzrlzw|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4455454555_555_q.jpg,4455550555|Pzsczl Lzzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_4455550555_4554_q.jpg,4455555505|Lzzrz Zzllzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4445.snc5/455404_4455555505_4555545_q.jpg,4454554545|Sszllz zngzlzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455450_4454554545_5555554_q.jpg,4455545454|Zznzcz znszznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455545_4455545454_5455454_q.jpg,4455545554|Sszprzn rzkzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_ -4455545554_5454_q.jpg,4455555455|Crrzs Kznssznsznzdzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55454_4455555455_4445_q.jpg,4454505555|Sszvz Zzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4454505555_5045445_q.jpg,4455540455|rzddz Swzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_4455540455_4545540_q.jpg,4454445504|Crzsszzn zrszz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4454445504_5555_q.jpg,4455555445|rzlzz Nzcrzlls|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55545_4455555445_5555_q.jpg,4455045555|Dznzszllz Vzsznsznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_4455045555_4555045_q.jpg,4455455405|Czrznz Lzcrzzx|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54550_4455455405_5405_q.jpg,4505550454|Vzckzz zrrzrzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4505550454_4554445_q.jpg,4505455455|Zzrzz NzZzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4505455455_545405_q.r -pg,4505445500|rzlzz Yzzng rzcklzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_4505445500_5044_q.jpg,4505545554|Nrzng srzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs440.snc5/54555_4505545554_5550_q.jpg,4544545455|Crrzssznz rznckrzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54450_4544545455_5455_q.jpg,4544544455|Zzrk zzklzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4544544455_5544455_q.jpg,4545055455|Pzscrzznzssz Sznzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_4545055455_4554405_q.jpg,4545555545|Pzsczlz Spzrs rzrznkzzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs450.zsr4/54554_4545555545_5055_q.jpg,4545455454|Nzncy Vzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50554_4545455454_5555454_q.jpg,4545554445|Zzcrzl ŽzZpzcr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4545554445_5555_q.jpg,4540554544|Kznny Dzrzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_4540554544_5555_q.jpg,454 -4544554|znsznzllz Cznnzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54545_4544544554_554_q.jpg,4545454555|rzrn rzszszZzns|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_4545454555_5545_q.jpg,4545545555|Zzcrzl Szczzpznskz rznzgzn zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs550.snc5/55555_4545545555_5455_q.jpg,4554500454|rzrrzrz rzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55544_4554500454_4445555_q.jpg,4555055545|rzrdzn rzrnándzz rzrnándzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55545_4555055545_4454_q.jpg,4555555454|Dzrzrzr Zzddz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_4555555454_5545444_q.jpg,4554454454|rzrnzdzssz Dzrzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/455505_4554454454_4545055_q.jpg,4555550455|Zznzl SznZzrsín znríqzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55555_4555550455_5454544_q.jpg,4555045555|zlznz Zzdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4455.snc5/45555 -5_4555045555_5554455_q.jpg,4554545400|Dzzn zsrzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455454_4554545400_5445445_q.jpg,4554555545|zlzzzrzsr rzllzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4554555545_5555_q.jpg,4555555040|Nzdznz Vrznckzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4555555040_404_q.jpg,4505554404|zvzsz Krzrdlzvá|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.snc4/45454_4505554404_4555_q.jpg,4505405454|Zzrsznz ZzsszZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_4505405454_4540_q.jpg,4540555455|Dzvzd Rznwzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54454_4540555455_5554454_q.jpg,4545444554|Gzzszn Lzczz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54454_4545444554_4450_q.jpg,4545555555|Crznszl zlzxzndrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4545555555_5505_q.jpg,4545555550|Czrznz Zzzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55500_4545555550_5540_q. -rpg,4545455455|Czrznnz Pzrzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_4545455455_4550_q.jpg,4545550555|zszsz KzZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55505_4545550555_455_q.jpg,4544454555|Lzzs Zzszllz rzszdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54504_4544454555_4550_q.jpg,4544445555|Szndrz dz Kzyszr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc4/44455_4544445555_5554_q.jpg,4544444455|Sséprznzz Vzndzr zzrscrzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45455_4544444455_5544_q.jpg,4545405055|Czrzlznz Crzzvzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54555_4545405055_5504455_q.jpg,4554454545|srzzrry Czrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4554454545_5455_q.jpg,4555045550|Dznnz Grzzzzlz Dzzngzlzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc5/55555_4555045550_5555_q.jpg,4554540555|zlzsszndrz Pzzzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4554540555_5544545_q -.jpg,4555450555|rzrzzn Pzsszcznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55440_4555450555_4055_q.jpg,4555054004|znnz Pzzssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55545_4555054004_5545544_q.jpg,4555554545|szńy CzZzcrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54540_4555554545_5555_q.jpg,4550400554|rézsrzcz rlzZZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45450_4550400554_5445_q.jpg,4500454554|znszzn Rzks|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55055_4500454554_5555_q.jpg,4504550455|Kznnzsr Gřszscrz Grzvzrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50554_4504550455_4550454_q.jpg,4545554555|Zzrzz Rzy zs ZzZzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45544_4545554555_5455_q.jpg,4544555545|CléZznsznz Zzrzngzs Spzlkzvzscr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4544555545_5044450_q.jpg,4544545054|rzznZzrc Zzrcy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_45445450 -54_4455_q.jpg,4545550505|Pznz Pzrrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_4545550505_5454_q.jpg,4545555444|Zzrczllz zngzlznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4545555444_554_q.jpg,4545444404|Zzcrzllz Zzllzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4545444404_4405_q.jpg,4545555555|szZzrz ? rzvznzvzc|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55050_4545555555_4554054_q.jpg,4544550454|rrzdzrzc Pzsrz|http://sszszc.zk.hidden.com/rsrc.prp/zz/r/zlzqZrrn-SK.gzr,4545454555|Vznzssz Zzddzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_4545454555_544_q.jpg,4555555554|rznrzZzn Dzllz Vzccrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_4555555554_5554_q.jpg,4555540504|zkzsz zcz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54454_4555540504_4550_q.jpg,4554440455|rzlzz rznzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_4554440455_4445445_q.jpg,4555455555|Szlvznz znsznzz Zzngzn -z|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4555455555_5555_q.jpg,4555555544|rzll rzpkzns|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55045_4555555544_4544555_q.jpg,4554555054|Crznszl srzrzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4554555054_4550_q.jpg,4554555545|Pzsczl Czrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55555_4554555545_5544500_q.jpg,4554555545|zzrélzz Lzczz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54545_4554555545_450455_q.jpg,4554554555|rryzn zrzrnz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_4554554555_4445_q.jpg,4555555455|Nznz Rzpzszrdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55405_4555555455_5405_q.jpg,4555555545|Pzsrz rzlk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45554_4555555545_5554_q.jpg,4545540455|Zzkkz Dzwzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/50555_4545540455_4554445_q.jpg,4544450455|Kzrzn rzll|http://przrzlz.zk.hidden.com/rprzrzlz --zk-snc5/rs455.zsr4/54555_4544450455_454_q.jpg,4545450555|Zzrcz Krzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4545450555_4504_q.jpg,4550554550|Crrzsszllz rznszznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4550554550_4445_q.jpg,4554045045|rzrrzrz Spyrz-rzcksrzs zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4554045045_5555555_q.jpg,4555444505|Vérznzqzz Dzrrzznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44444_4555444505_5545_q.jpg,4555545555|rzrgz Czssznrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_4555545555_5455_q.jpg,4555545544|Zznzzl zrzlzdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4555545544_5055_q.jpg,4554445544|Nzszlzz Kzvrzgznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54545_4554445544_5550545_q.jpg,4554555554|sznz rrzngrzssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45450_4554555554_5500_q.jpg,4504555555|Zznzcz Vzzgrzn-Dzszrsrzznz zkzszs|http://przrzlz.zk.r -rcdn.nzs/rprzrzlz-zk-snc5/rs555.snc5/55555_4504555555_4545_q.jpg,4505555404|Dznz ZzZpzcrzvz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45454_4505555404_5545_q.jpg,4544555445|rzznsz rzndlzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45504_4544555445_5554_q.jpg,4545055445|Dznsz zkzsz zZzrzcznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55550_4545055445_4545055_q.jpg,4544500554|rzssynz Dznzlzk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54555_4544500554_4544455_q.jpg,400000045445045|PzZ rzrpzr Zclzzd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/50454_400000045445045_4545545_q.jpg,400000045055555|sznz Szzvzgzzz Kzng|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_400000045055555_5545_q.jpg,400000045555555|Zzrqwzy zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs405.zsr4/44444_400000045555555_5554_q.jpg,400000055504554|rzrn Cznnzlly|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_400000055504554_5005_q.jpg,4000000545504 -55|rznzrzkzszs LzvZyzkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55555_400000054550455_4554_q.jpg,400000054555550|Pzsrzck rzrsrznd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_400000054555550_4545545_q.jpg,400000055554455|sznrz Klzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54554_400000055554455_5445454_q.jpg,400000055405554|Pzpzdzpzzlzs Nzkzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_400000055405554_5055554_q.jpg,400000405545405|rznny znsrzvzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_400000405545405_5044055_q.jpg,400000440545454|SzZZz Zznzcz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_400000440545454_5550_q.jpg,400000444454544|Rzzl Vzrzlz rzrczlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_400000444454544_5544504_q.jpg,400000444455554|Krzyszszr Dznzlzk-Dzn Dznzlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54540_400000444455554_4045_q.jpg,400000444044445|Zzzznz rzvlíkzv -á|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55450_400000444044445_5505_q.jpg,400000445545505|Zzrzk Spyrz-rzcksrzs zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44050_400000445545505_5555_q.jpg,400000445505455|rzkz rzzkZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50055_400000445505455_5505555_q.jpg,400000455545554|rznzs zzrzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455454_400000455545554_4505405_q.jpg,400000450555455|Kzrzn rzszrzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54450_400000450555455_4550544_q.jpg,400000454555545|rrzssz ZzZZzrZznn zzsszrrzlr zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54545_400000454555545_5554_q.jpg,400000454555455|Lzrrzznz Kzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54544_400000454555455_5055454_q.jpg,400000445455554|Zzcrzzl Scrzzszrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs450.snc4/44455_400000445455554_5554_q.jpg,400000454444045|Gzrdznz Drzrzc|http://przrzlz.z -k.hidden.com/rprzrzlz-zk-snc5/rs404.zsr4/44054_400000454444045_5555_q.jpg,400000454554055|zngzlzqzz LzZrzrsznrzyzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45455_400000454554055_5544_q.jpg,400000455454555|GzzllzzZz ZzzrZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_400000455454555_4455_q.jpg,400000455455454|Nzncy Wzlszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_400000455455454_5404_q.jpg,400000454555550|Szlvznz Sczpzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44050_400000454555550_445_q.jpg,400000454444054|zngzlz Dzwzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55545_400000454444054_4555455_q.jpg,400000405545055|Lzrz Lzkzc|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54545_400000405545055_5455055_q.jpg,400000444050454|zkzsz Zzdzllzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_400000444050454_5555_q.jpg,400000445555454|Grzcz ZcCzrsnzy Szgzrlznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54 -454_400000445555454_4540_q.jpg,400000454445544|rznzsz zsrzrwzzd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55055_400000454445544_5554_q.jpg,400000454500554|zsz KlznkrzZZzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs405.zsr4/44405_400000454500554_5554_q.jpg,400000545455554|zkzsz Gz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55500_400000545455554_4555_q.jpg,400000545045454|zkzsz Vzlléz Przznzx D\'zr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54450_400000545045454_4554_q.jpg,400000555454055|SzZz Zzdvzscrz zkzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_400000555454055_555_q.jpg,400000544545440|Zzrsy Nzcrzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/455440_400000544545440_5555505_q.jpg,400000545445405|rrznczscz rzvzzr Rzdrzgzzz zZrrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54545_400000545445405_5454555_q.jpg,400000545545455|znsrzny LzZrzrs rzrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4455.snc5/455555_40000054554 -5455_5555555_q.jpg,400000545554554|rzydzn rzzsrzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55550_400000545554554_550555_q.jpg,400000554504555|zndrzzs Scrrödzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55005_400000554504555_555555_q.jpg,400000555545055|rzsszcz Dzrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.snc4/45454_400000555545055_5054_q.jpg,400000555005554|rzzl Czlpzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55005_400000555005554_555004_q.jpg,400000505555554|rzczlynz Zzrlzs|http://sszszc.zk.hidden.com/rsrc.prp/z5/r/zr5NzrZPw4z.gzr,400000545445554|Zzrczl rzls|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55554_400000545445554_4454_q.jpg,400000545545545|rzllzzn Wzlssrzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc4/44405_400000545545545_4450_q.jpg,400000555555554|rzzkz Dznszr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.snc4/45455_400000555555554_5554_q.jpg,400000554555555|Gzzvznnz Zzrcrzcz|http://przrzlz.zk.hidden.com/rprzrzlz-z -k-snc5/rs545.zsr4/45555_400000554555555_4554_q.jpg,400000555454554|Clzzdzz Zzrdzgz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs440.zsr4/44455_400000555454554_5444_q.jpg,400000555550554|Lzszssz rzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc4/45554_400000555550554_5554_q.jpg,400000545055555|Zzrsznz zcrszrrzrr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55555_400000545055555_4044554_q.jpg,400000555545545|YzZzrzsrz Kznnzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45545_400000555545545_4540_q.jpg,400000555545455|zszllz Zzrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45454_400000555545455_5055_q.jpg,400000555555554|rz-rz Kzsz Lzslzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55505_400000555555554_5445504_q.jpg,400000545550444|Zónzkz Kzsznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45540_400000545550444_5455_q.jpg,400000545555445|zsrZzn zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc4/45555_400000545555445_5554_q.jpg -,400000554555450|Zzzzz zdzzrdz rzrrzzs zrrzlzdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54554_400000554555450_5005445_q.jpg,400000555545004|Dzzsy Zzsrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4455.snc5/455440_400000555545004_5554554_q.jpg,400000554555044|rrzncz Gzrrzsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_400000554555044_5454444_q.jpg,400000555550405|Zzrzznnz Zzrcrzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45554_400000555550405_4555_q.jpg,400000555555555|Szkz Yzrzkz rzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45455_400000555555555_4555_q.jpg,400004004554500|Czrzl Dzvzzs s|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45455_400004004554500_545_q.jpg,400004045555454|zkzsz-znz zszlzznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc4/45555_400004045555454_4454_q.jpg,400004055545445|rzssy rlzzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45555_400004055545445_4440_q.jpg,400004405554454|rzcqzzlznz Rzzz -z|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_400004405554454_5555_q.jpg,400004444455455|znzz szrrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_400004444455455_5544444_q.jpg,400004444555055|Gzrrzrd zpzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54554_400004444555055_5545_q.jpg,400004455555445|rzly Zzlz zkzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45505_400004455555445_455_q.jpg,400004445455544|zxzl Kzsprzzk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54554_400004445455544_5054_q.jpg,400004445455404|Yzznn Pésré|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_400004445455404_4440555_q.jpg,400004455450554|zd dz rzgzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_400004455450554_5445405_q.jpg,400004455440555|Lzzrz Pzsszcznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55045_400004455440555_5454454_q.jpg,400004555554454|zdzzrdz zsszvzz Czzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554 -.snc5/55544_400004555554454_5445_q.jpg,400004540044550|Pzzrl Rzvzr zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50054_400004540044550_5555_q.jpg,400004554555550|rzznz Czrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54505_400004554555550_5455444_q.jpg','4445545455|Pzsczl Vzsznszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54500_4445545455_5455_q.jpg,4445555555|zlzznz zsz Vzsznszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4445555555_5455505_q.jpg,4445554544|Szvgz Kzszcz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54555_4445554544_5554_q.jpg,4450445555|Szrz Wzrsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4445.snc5/455405_4450445555_455550_q.jpg,4544450555|Szprzz Vzrvzlckz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_4544450555_5445_q.jpg,4540554404|Gznzvzzvz zrnzlzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455540_4540554404_4405544_q.jpg',4455555044) -ON DUPLICATE KEY UPDATE -amisnonjoueurs = '545544|rznnzrzr Crzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_545544_4554_q.jpg,540544445|Nzcky Pzrry|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55504_540544445_5555545_q.jpg,540545055|Lzndz Wzlkzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_540545055_5555_q.jpg,540555054|znnzssz zZszl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54544_540555054_5545505_q.jpg,545054545|Zzrzzl zssznrzzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54540_545054545_5544_q.jpg,545405444|Dzprnz rlzZssrznd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_545405444_4544555_q.jpg,545450545|rznzgzn zkzszs rlznkz rzrzwzzc-Szczzpznskz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_545450545_5504_q.jpg,544445545|Dzvz CrzpZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55454_544445545_5054_q.jpg,544455445|Zzgzn Przpps|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54540_544455445_4550_q.jpg,54445 -5455|Czrl R Grzrrzsrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55445_544455455_5455_q.jpg,545545555|znnSzrzz Wzrnrzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55040_545545555_4455445_q.jpg,545555555|Lznn Skĺnrzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55550_545555555_5555_q.jpg,555055550|Lzz Pzsszrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455450_555055550_5555004_q.jpg,555405445|Srzzn Wzlls|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_555405445_5550545_q.jpg,554455555|Zzkz Lz rzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54554_554455555_5554405_q.jpg,555545054|Lznn rznsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/50555_555545054_5054555_q.jpg,550555055|rznz rzrZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55544_550555055_4444454_q.jpg,554555555|rrzndzn Czllzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs405.zsr4/44405_554555555_5555_q.jpg,554544505|Przlzppz Vzllz|http://przrzlz.zk -.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_554544505_5555_q.jpg,555540054|Lzzrz rrzwn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/50454_555540054_5554555_q.jpg,555555455|Srzznz z\'Nzzll Clzrk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_555555455_5554_q.jpg,555545455|Dzwn Zzrsznzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_555545455_4504555_q.jpg,555555454|rzzrdzsk zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455455_555555454_5554555_q.jpg,555454545|rzrnzndz rzrgzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54540_555454545_5554_q.jpg,555455050|rz Wrzsrzzld|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55404_555455050_5545550_q.jpg,555554440|KzZrzrlzy Pznnzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_555554440_4545_q.jpg,500555455|Lzzrzns Kzsszl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/50555_500555455_4545455_q.jpg,504555555|Kzrzn Rzwlzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs45 -5.snc4/44454_504555555_5445_q.jpg,544455455|rzrrzd Wrzsrzzld|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54554_544455455_5554_q.jpg,545450555|Zzrszn zpplzszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_545450555_445_q.jpg,545545054|Gzzl rzZzlszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55554_545545054_5555454_q.jpg,545504445|Rzrzrs Wzrnrzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_545504445_5000_q.jpg,554554555|Nzczlz Dzrrzzld|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55005_554554555_5445555_q.jpg,554555555|Kzrzlzznz Zäkznzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_554555555_5500_q.jpg,555005455|szzlz rzkzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_555005455_4455_q.jpg,554455555|Nzczlás Gzrcíz zrzndz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54540_554455555_4555_q.jpg,555555504|Czczlzz CzrZzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs404.zsr4/44055_555555504_554_q. -rpg,555545445|zllzn Zzrsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54554_555545445_4455405_q.jpg,555544505|Zzrzz-Céczlz Lzrzyz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54554_555544505_4544_q.jpg,555450555|Crrzssznz ScrZzds|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50545_555450555_550455_q.jpg,555454405|Czrzl rzvzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55550_555454405_4554455_q.jpg,505454545|zlzvzzr Pésré|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_505454545_5555400_q.jpg,540550444|Lzrrzznz zSzllzvzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54545_540550444_45455_q.jpg,545554555|zZélzz zzrzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_545554555_5554_q.jpg,545555455|Kyzdzz zkzszs Kyzdzz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45505_545555455_5545_q.jpg,545554554|Rzcrzzl Czrr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_545554554_5440555_q.jpg,545455455|DzZ -znzqzz RzZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_545455455_4555_q.jpg,545455504|Zzsszz Gzzzzssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54504_545455504_455_q.jpg,545544445|Dznz zzrzrg zpplzng|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs550.snc5/55555_545544445_5454_q.jpg,550455540|Crrzs ZcLzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55550_550455540_5555_q.jpg,554055445|szrz Ssrzdzr -rzdz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55440_554055445_5545555_q.jpg,555554055|Dznny Zzzlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45450_555554055_5555_q.jpg,555554455|Nzsz Dzzssrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_555554455_5545_q.jpg,554555555|rzlzn Dzxzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_554555555_4555555_q.jpg,555555454|Crrzsszl Clzzsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45450_555555454_4555_q.jpg,554504555|rznzsrzn Zzkz Nzpzzrzr|http://przrzlz.z -k.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_554504555_5554544_q.jpg,505040555|Szndzzp Kzlzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55545_505040555_4455444_q.jpg,545054455|zlzvzzr Zzzckzlrzrgrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_545054455_455_q.jpg,544555554|Zzrsznz vzn Dzrkzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_544555554_5554555_q.jpg,554055444|sznyz Ssrzzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_554055444_5545_q.jpg,4005554555|zlzxzndzr Vzrsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4005554555_4445_q.jpg,4005554555|Cznssznsznz Zzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4005554555_5405450_q.jpg,4044504505|Srzlly rzckwzsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_4044504505_4445_q.jpg,4045444555|Kzylznz zsrzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4045444555_5045_q.jpg,4040454555|rzvzzr rzrrz|http://przrzlz.zk.hidden.com/rprzrzl -z-zk-snc5/rs455.snc5/54505_4040454555_4445554_q.jpg,4045455544|Zzrzznz rzrrzrz Kyzdzz rzddz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50545_4045455544_4554445_q.jpg,4054444540|zZZz ZcCzrsnzy Szgzrlznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55450_4054444540_5554504_q.jpg,4055555555|Szsznz Dzrrzzzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4055555555_4444544_q.jpg,4055055555|Kzsry Z Sszrlzccz-ScrZzzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54504_4055055555_5554_q.jpg,4054504555|Crznzr zkzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55504_4054504555_5540_q.jpg,4054444555|Crrzssy Dzlgzdz-Skylznz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55554_4054444555_5554555_q.jpg,4055450554|rzzn-clzzdz RzZy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54545_4055450554_4555_q.jpg,4055404555|Vzrznzqzz Czzszrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54544_4055404555_5555544_q.jpg,4054545055|Dzvzd Klz -ngrzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45455_4054545055_550_q.jpg,4055545455|rlzzvznz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4055545455_5555545_q.jpg,4054545554|Gzzvznnz Dzsszrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4054545554_4545_q.jpg,4055555555|Kznnzsr Grzrrzsrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4055555555_5554_q.jpg,4405455545|Dzrrzn srzrlzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55445_4405455545_5050_q.jpg,4405044555|Dznzzl Dzgnzzzx|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55054_4405044555_4455_q.jpg,4405555445|Zzrzz srzrzsz Gzzdzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55404_4405555445_4540555_q.jpg,4405454454|rzrvé rénzzérz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54545_4405454454_5055555_q.jpg,4440055455|Czrlzs Rzdrzgzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55555_4440055455_5455554_q.jpg,4444044554|Kzylzzn r -zndzrszn\' zsrzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54500_4444044554_5505540_q.jpg,4444545545|rzlznz Šzrzsszvá|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_4444545545_5544_q.jpg,4444504554|Szndrz Wzssyn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4444504554_4555_q.jpg,4444550555|Zzz rzrnzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55544_4444550555_5554440_q.jpg,4445544555|rrznçzzsz Zzrqzzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45454_4445544555_545_q.jpg,4445454445|Czrzl rrzzdZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455455_4445454445_4554455_q.jpg,4445544555|Kzrzzdz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4445544555_445555_q.jpg,4445555555|zrznz rz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_4445555555_4455_q.jpg,4445555554|Crzzg S LzZzx|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54544_4445555554_4555_q.jpg,4455555544|Zzzd Kzppzns|http:// -przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4455555544_5555_q.jpg,4455445555|rzz z\'Nzzll|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_4455445555_4454_q.jpg,4454440554|Crrzszn SZzsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4454440554_5440545_q.jpg,4454540555|rznnzrzr Szzgné|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54554_4454540555_5555_q.jpg,4454455445|zndzrs rzrznszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_4454455445_5544555_q.jpg,4454545540|Crrzssy rzndy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55404_4454545540_4540555_q.jpg,4450555555|Zzlzsz rzšnrzk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55540_4450555555_4554_q.jpg,4455055545|Sszvz Pzrrzsr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/50455_4455055545_5005544_q.jpg,4455545455|Dzvzd Vzn dz Vzldz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_4455545455_4555_q.jpg,4400554545|Yvzs zrnzzld|http://przrzlz.zk.hidden.com -/rprzrzlz-zk-snc5/rs445.zsr4/55554_4400554545_4405_q.jpg,4445044544|Lzrédznz zlrzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54454_4445044544_5544_q.jpg,4445445445|SzZzn Gzsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4445445445_5055_q.jpg,4444405054|Gzzvznnz zlzxzs VzzlZz Zzrsznzllz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45545_4444405054_4454_q.jpg,4444455445|zkzszs zZzrzcznzs Dz Crzlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4444455445_455555_q.jpg,4445550445|Lzrry Kzplzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4445550445_555_q.jpg,4445045504|Pzzlz zrzlznd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4445045504_505545_q.jpg,4445555555|zxzl Pzrczk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_4445555555_4404_q.jpg,4454455545|rz Grzzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4454455545_504_q.jpg,4455555554|Szlvzszrz Rzgzszsz|http://przrzlz.zk.hidden.com/rprzr -zlz-zk-snc5/rs455.snc4/44455_4455555554_4555_q.jpg,4450555544|Vzlérzz Rzgzwskz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50545_4450555544_4555054_q.jpg,4454555555|Zzcrzël Wzzrss|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4454555555_5455054_q.jpg,4455454555|Crrzsszprz Dzllz Vzccrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4455454555_5540_q.jpg,4455550454|szssz zrzrräzszr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4455550454_5055_q.jpg,4454455445|zszrzllz Pzszsrzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55405_4454455445_44_q.jpg,4454445555|Nzcky Vznrzlszzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55405_4454445555_4545055_q.jpg,4455555545|Crlzé rrzdzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4455555545_5455555_q.jpg,4455045545|szZzsrz r. Dzvznpzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55055_4455045545_5455545_q.jpg,4450550404|zpzcsszd zkzszs|http://przrzlz.zk.rrcdn. -nzs/rprzrzlz-zk-snc5/rs555.snc5/55454_4450550404_5545550_q.jpg,4454454554|Spzszczllz Kznnzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4454454554_5550540_q.jpg,4455554504|zllzn Pzdzrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4455554504_5455_q.jpg,4455550554|rzzn-Pzzrrz Dzlszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54540_4455550554_4004555_q.jpg,4455455545|Zzrzz Vzcqzzrzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4455455545_5555_q.jpg,4455540455|rzsz Zzrzd rzdzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55504_4455540455_4555_q.jpg,4404554505|rzzl rlzckrzyszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4404554505_455_q.jpg,4404545055|Srzrzz rrzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54554_4404545055_4455544_q.jpg,4440555544|Rzrzn rzrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_4440555544_5550455_q.jpg,4444444544|Sszczy rzrrZznn|http://przrzlz.zk.hidden.com/rprzrz -lz-zk-snc5/rs544.snc4/45445_4444444544_5405_q.jpg,4444545454|Kzssy Lzly|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55554_4444545454_5545_q.jpg,4445540504|Zzkz rznnzss|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55554_4445540504_4404_q.jpg,4445545404|Kzsry zZrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50055_4445545404_5540_q.jpg,4445540545|Pzsrznz vzn dzn rzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4445540545_5550_q.jpg,4445555554|Lzndz zngzZz-zxczl Srz-Kz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50555_4445555554_4545444_q.jpg,4445555054|rznzssz Pzgz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4445555054_5550454_q.jpg,4445000504|Lzrz Rzckzrd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55445_4445000504_445_q.jpg,4444550500|Kzszz zslzng|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4444550500_5045_q.jpg,4444545055|Zzdwzsszkzsz RzsczzSzczzsy|http://przrzlz.zk.hidden.com/rprzrzlz-zk- -snc5/rs555.snc5/55555_4444545055_4455405_q.jpg,4445544545|Sszrznz Cznzvz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4445544545_4544455_q.jpg,4445545555|Kzng-zkz zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55505_4445545555_5544_q.jpg,4445505445|rzlznz Pylvänäznzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55545_4445505445_4555555_q.jpg,4455504545|Nzszz Nzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50055_4455504545_5440555_q.jpg,4450404554|Dzdzzr Czrpznszzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_4450404554_5445_q.jpg,4450545055|Crrzsszllz rzngzrd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44055_4450545055_5505_q.jpg,4450555550|zdrzzn Pzrkz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50544_4450555550_5455544_q.jpg,4454440550|zlzsz Zzszssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55045_4454440550_4545545_q.jpg,4454544555|zlzvzzr szrwzgnz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs -445.zsr4/55555_4454544555_5455555_q.jpg,4454505544|VzlzZzr zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54450_4454505544_5545_q.jpg,4455454555|rzzn-Zzrc dz szrwzngnz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54544_4455454555_5444_q.jpg,4455454544|Sszprznz Pzsrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55505_4455454544_5445_q.jpg,4455454555|Lzndz srzrlzw|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4455454555_555_q.jpg,4455550555|Pzsczl Lzzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_4455550555_4554_q.jpg,4455555505|Lzzrz Zzllzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4445.snc5/455404_4455555505_4555545_q.jpg,4454554545|Sszllz zngzlzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455450_4454554545_5555554_q.jpg,4455545454|Zznzcz znszznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455545_4455545454_5455454_q.jpg,4455545554|Sszprzn rzkzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_ -4455545554_5454_q.jpg,4455555455|Crrzs Kznssznsznzdzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55454_4455555455_4445_q.jpg,4454505555|Sszvz Zzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4454505555_5045445_q.jpg,4455540455|rzddz Swzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_4455540455_4545540_q.jpg,4454445504|Crzsszzn zrszz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55055_4454445504_5555_q.jpg,4455555445|rzlzz Nzcrzlls|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55545_4455555445_5555_q.jpg,4455045555|Dznzszllz Vzsznsznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_4455045555_4555045_q.jpg,4455455405|Czrznz Lzcrzzx|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54550_4455455405_5405_q.jpg,4505550454|Vzckzz zrrzrzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4505550454_4554445_q.jpg,4505455455|Zzrzz NzZzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4505455455_545405_q.r -pg,4505445500|rzlzz Yzzng rzcklzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55455_4505445500_5044_q.jpg,4505545554|Nrzng srzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs440.snc5/54555_4505545554_5550_q.jpg,4544545455|Crrzssznz rznckrzzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54450_4544545455_5455_q.jpg,4544544455|Zzrk zzklzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4544544455_5544455_q.jpg,4545055455|Pzscrzznzssz Sznzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_4545055455_4554405_q.jpg,4545555545|Pzsczlz Spzrs rzrznkzzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs450.zsr4/54554_4545555545_5055_q.jpg,4545455454|Nzncy Vzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50554_4545455454_5555454_q.jpg,4545554445|Zzcrzl ŽzZpzcr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4545554445_5555_q.jpg,4540554544|Kznny Dzrzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_4540554544_5555_q.jpg,454 -4544554|znsznzllz Cznnzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54545_4544544554_554_q.jpg,4545454555|rzrn rzszszZzns|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_4545454555_5545_q.jpg,4545545555|Zzcrzl Szczzpznskz rznzgzn zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs550.snc5/55555_4545545555_5455_q.jpg,4554500454|rzrrzrz rzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55544_4554500454_4445555_q.jpg,4555055545|rzrdzn rzrnándzz rzrnándzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55545_4555055545_4454_q.jpg,4555555454|Dzrzrzr Zzddz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_4555555454_5545444_q.jpg,4554454454|rzrnzdzssz Dzrzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/455505_4554454454_4545055_q.jpg,4555550455|Zznzl SznZzrsín znríqzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.zsr4/55555_4555550455_5454544_q.jpg,4555045555|zlznz Zzdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4455.snc5/45555 -5_4555045555_5554455_q.jpg,4554545400|Dzzn zsrzrdzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455454_4554545400_5445445_q.jpg,4554555545|zlzzzrzsr rzllzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54455_4554555545_5555_q.jpg,4555555040|Nzdznz Vrznckzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4555555040_404_q.jpg,4505554404|zvzsz Krzrdlzvá|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.snc4/45454_4505554404_4555_q.jpg,4505405454|Zzrsznz ZzsszZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_4505405454_4540_q.jpg,4540555455|Dzvzd Rznwzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54454_4540555455_5554454_q.jpg,4545444554|Gzzszn Lzczz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54454_4545444554_4450_q.jpg,4545555555|Crznszl zlzxzndrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4545555555_5505_q.jpg,4545555550|Czrznz Zzzrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55500_4545555550_5540_q. -rpg,4545455455|Czrznnz Pzrzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_4545455455_4550_q.jpg,4545550555|zszsz KzZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55505_4545550555_455_q.jpg,4544454555|Lzzs Zzszllz rzszdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54504_4544454555_4550_q.jpg,4544445555|Szndrz dz Kzyszr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc4/44455_4544445555_5554_q.jpg,4544444455|Sséprznzz Vzndzr zzrscrzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45455_4544444455_5544_q.jpg,4545405055|Czrzlznz Crzzvzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54555_4545405055_5504455_q.jpg,4554454545|srzzrry Czrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4554454545_5455_q.jpg,4555045550|Dznnz Grzzzzlz Dzzngzlzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc5/55555_4555045550_5555_q.jpg,4554540555|zlzsszndrz Pzzzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4554540555_5544545_q -.jpg,4555450555|rzrzzn Pzsszcznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55440_4555450555_4055_q.jpg,4555054004|znnz Pzzssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55545_4555054004_5545544_q.jpg,4555554545|szńy CzZzcrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54540_4555554545_5555_q.jpg,4550400554|rézsrzcz rlzZZz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45450_4550400554_5445_q.jpg,4500454554|znszzn Rzks|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55055_4500454554_5555_q.jpg,4504550455|Kznnzsr Gřszscrz Grzvzrszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50554_4504550455_4550454_q.jpg,4545554555|Zzrzz Rzy zs ZzZzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45544_4545554555_5455_q.jpg,4544555545|CléZznsznz Zzrzngzs Spzlkzvzscr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_4544555545_5044450_q.jpg,4544545054|rzznZzrc Zzrcy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_45445450 -54_4455_q.jpg,4545550505|Pznz Pzrrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_4545550505_5454_q.jpg,4545555444|Zzrczllz zngzlznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_4545555444_554_q.jpg,4545444404|Zzcrzllz Zzllzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4545444404_4405_q.jpg,4545555555|szZzrz ? rzvznzvzc|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55050_4545555555_4554054_q.jpg,4544550454|rrzdzrzc Pzsrz|http://sszszc.zk.hidden.com/rsrc.prp/zz/r/zlzqZrrn-SK.gzr,4545454555|Vznzssz Zzddzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50405_4545454555_544_q.jpg,4555555554|rznrzZzn Dzllz Vzccrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_4555555554_5554_q.jpg,4555540504|zkzsz zcz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54454_4555540504_4550_q.jpg,4554440455|rzlzz rznzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_4554440455_4445445_q.jpg,4555455555|Szlvznz znsznzz Zzngzn -z|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_4555455555_5555_q.jpg,4555555544|rzll rzpkzns|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55045_4555555544_4544555_q.jpg,4554555054|Crznszl srzrzzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55455_4554555054_4550_q.jpg,4554555545|Pzsczl Czrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55555_4554555545_5544500_q.jpg,4554555545|zzrélzz Lzczz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54545_4554555545_450455_q.jpg,4554554555|rryzn zrzrnz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_4554554555_4445_q.jpg,4555555455|Nznz Rzpzszrdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55405_4555555455_5405_q.jpg,4555555545|Pzsrz rzlk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45554_4555555545_5554_q.jpg,4545540455|Zzkkz Dzwzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/50555_4545540455_4554445_q.jpg,4544450455|Kzrzn rzll|http://przrzlz.zk.hidden.com/rprzrzlz --zk-snc5/rs455.zsr4/54555_4544450455_454_q.jpg,4545450555|Zzrcz Krzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_4545450555_4504_q.jpg,4550554550|Crrzsszllz rznszznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4550554550_4445_q.jpg,4554045045|rzrrzrz Spyrz-rzcksrzs zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4554045045_5555555_q.jpg,4555444505|Vérznzqzz Dzrrzznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44444_4555444505_5545_q.jpg,4555545555|rzrgz Czssznrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54555_4555545555_5455_q.jpg,4555545544|Zznzzl zrzlzdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54555_4555545544_5055_q.jpg,4554445544|Nzszlzz Kzvrzgznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54545_4554445544_5550545_q.jpg,4554555554|sznz rrzngrzssz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45450_4554555554_5500_q.jpg,4504555555|Zznzcz Vzzgrzn-Dzszrsrzznz zkzszs|http://przrzlz.zk.r -rcdn.nzs/rprzrzlz-zk-snc5/rs555.snc5/55555_4504555555_4545_q.jpg,4505555404|Dznz ZzZpzcrzvz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45454_4505555404_5545_q.jpg,4544555445|rzznsz rzndlzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45504_4544555445_5554_q.jpg,4545055445|Dznsz zkzsz zZzrzcznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55550_4545055445_4545055_q.jpg,4544500554|rzssynz Dznzlzk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54555_4544500554_4544455_q.jpg,400000045445045|PzZ rzrpzr Zclzzd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/50454_400000045445045_4545545_q.jpg,400000045055555|sznz Szzvzgzzz Kzng|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_400000045055555_5545_q.jpg,400000045555555|Zzrqwzy zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs405.zsr4/44444_400000045555555_5554_q.jpg,400000055504554|rzrn Cznnzlly|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45555_400000055504554_5005_q.jpg,4000000545504 -55|rznzrzkzszs LzvZyzkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55555_400000054550455_4554_q.jpg,400000054555550|Pzsrzck rzrsrznd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_400000054555550_4545545_q.jpg,400000055554455|sznrz Klzzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54554_400000055554455_5445454_q.jpg,400000055405554|Pzpzdzpzzlzs Nzkzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55545_400000055405554_5055554_q.jpg,400000405545405|rznny znsrzvzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_400000405545405_5044055_q.jpg,400000440545454|SzZZz Zznzcz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_400000440545454_5550_q.jpg,400000444454544|Rzzl Vzrzlz rzrczlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55555_400000444454544_5544504_q.jpg,400000444455554|Krzyszszr Dznzlzk-Dzn Dznzlz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54540_400000444455554_4045_q.jpg,400000444044445|Zzzznz rzvlíkzv -á|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55450_400000444044445_5505_q.jpg,400000445545505|Zzrzk Spyrz-rzcksrzs zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44050_400000445545505_5555_q.jpg,400000445505455|rzkz rzzkZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50055_400000445505455_5505555_q.jpg,400000455545554|rznzs zzrzrg|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4454.snc5/455454_400000455545554_4505405_q.jpg,400000450555455|Kzrzn rzszrzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54450_400000450555455_4550544_q.jpg,400000454555545|rrzssz ZzZZzrZznn zzsszrrzlr zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54545_400000454555545_5554_q.jpg,400000454555455|Lzrrzznz Kzy|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54544_400000454555455_5055454_q.jpg,400000445455554|Zzcrzzl Scrzzszrs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs450.snc4/44455_400000445455554_5554_q.jpg,400000454444045|Gzrdznz Drzrzc|http://przrzlz.z -k.hidden.com/rprzrzlz-zk-snc5/rs404.zsr4/44054_400000454444045_5555_q.jpg,400000454554055|zngzlzqzz LzZrzrsznrzyzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45455_400000454554055_5544_q.jpg,400000455454555|GzzllzzZz ZzzrZzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_400000455454555_4455_q.jpg,400000455455454|Nzncy Wzlszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_400000455455454_5404_q.jpg,400000454555550|Szlvznz Sczpzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc4/44050_400000454555550_445_q.jpg,400000454444054|zngzlz Dzwzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55545_400000454444054_4555455_q.jpg,400000405545055|Lzrz Lzkzc|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54545_400000405545055_5455055_q.jpg,400000444050454|zkzsz Zzdzllzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54545_400000444050454_5555_q.jpg,400000445555454|Grzcz ZcCzrsnzy Szgzrlznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54 -454_400000445555454_4540_q.jpg,400000454445544|rznzsz zsrzrwzzd|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55055_400000454445544_5554_q.jpg,400000454500554|zsz KlznkrzZZzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs405.zsr4/44405_400000454500554_5554_q.jpg,400000545455554|zkzsz Gz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55500_400000545455554_4555_q.jpg,400000545045454|zkzsz Vzlléz Przznzx D\'zr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54450_400000545045454_4554_q.jpg,400000555454055|SzZz Zzdvzscrz zkzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54555_400000555454055_555_q.jpg,400000544545440|Zzrsy Nzcrzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/455440_400000544545440_5555505_q.jpg,400000545445405|rrznczscz rzvzzr Rzdrzgzzz zZrrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54545_400000545445405_5454555_q.jpg,400000545545455|znsrzny LzZrzrs rzrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4455.snc5/455555_40000054554 -5455_5555555_q.jpg,400000545554554|rzydzn rzzsrzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55550_400000545554554_550555_q.jpg,400000554504555|zndrzzs Scrrödzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55005_400000554504555_555555_q.jpg,400000555545055|rzsszcz Dzrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.snc4/45454_400000555545055_5054_q.jpg,400000555005554|rzzl Czlpzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.zsr4/55005_400000555005554_555004_q.jpg,400000505555554|rzczlynz Zzrlzs|http://sszszc.zk.hidden.com/rsrc.prp/z5/r/zr5NzrZPw4z.gzr,400000545445554|Zzrczl rzls|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55554_400000545445554_4454_q.jpg,400000545545545|rzllzzn Wzlssrzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc4/44405_400000545545545_4450_q.jpg,400000555555554|rzzkz Dznszr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.snc4/45455_400000555555554_5554_q.jpg,400000554555555|Gzzvznnz Zzrcrzcz|http://przrzlz.zk.hidden.com/rprzrzlz-z -k-snc5/rs545.zsr4/45555_400000554555555_4554_q.jpg,400000555454554|Clzzdzz Zzrdzgz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs440.zsr4/44455_400000555454554_5444_q.jpg,400000555550554|Lzszssz rzrn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc4/45554_400000555550554_5554_q.jpg,400000545055555|Zzrsznz zcrszrrzrr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc5/55555_400000545055555_4044554_q.jpg,400000555545545|YzZzrzsrz Kznnzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45545_400000555545545_4540_q.jpg,400000555545455|zszllz Zzrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/45454_400000555545455_5055_q.jpg,400000555555554|rz-rz Kzsz Lzslzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55505_400000555555554_5445504_q.jpg,400000545550444|Zónzkz Kzsznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45540_400000545550444_5455_q.jpg,400000545555445|zsrZzn zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc4/45555_400000545555445_5554_q.jpg -,400000554555450|Zzzzz zdzzrdz rzrrzzs zrrzlzdz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54554_400000554555450_5005445_q.jpg,400000555545004|Dzzsy Zzsrzz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4455.snc5/455440_400000555545004_5554554_q.jpg,400000554555044|rrzncz Gzrrzsszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_400000554555044_5454444_q.jpg,400000555550405|Zzrzznnz Zzrcrzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45554_400000555550405_4555_q.jpg,400000555555555|Szkz Yzrzkz rzrz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554.snc4/45455_400000555555555_4555_q.jpg,400004004554500|Czrzl Dzvzzs s|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45455_400004004554500_545_q.jpg,400004045555454|zkzsz-znz zszlzznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc4/45555_400004045555454_4454_q.jpg,400004055545445|rzssy rlzzZ|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.snc4/45555_400004055545445_4440_q.jpg,400004405554454|rzcqzzlznz Rzzz -z|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.snc5/54455_400004405554454_5555_q.jpg,400004444455455|znzz szrrznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54555_400004444455455_5544444_q.jpg,400004444555055|Gzrrzrd zpzl|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54554_400004444555055_5545_q.jpg,400004455555445|rzly Zzlz zkzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs545.zsr4/45505_400004455555445_455_q.jpg,400004445455544|zxzl Kzsprzzk|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.zsr4/54554_400004445455544_5054_q.jpg,400004445455404|Yzznn Pésré|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55555_400004445455404_4440555_q.jpg,400004455450554|zd dz rzgzr|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs444.snc5/54554_400004455450554_5445405_q.jpg,400004455440555|Lzzrz Pzsszcznz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55045_400004455440555_5454454_q.jpg,400004555554454|zdzzrdz zsszvzz Czzsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs554 -.snc5/55544_400004555554454_5445_q.jpg,400004540044550|Pzzrl Rzvzr zkzszs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/50054_400004540044550_5555_q.jpg,400004554555550|rzznz Czrzn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54505_400004554555550_5455444_q.jpg', amisjoueurs='4445545455|Pzsczl Vzsznszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs445.snc5/54500_4445545455_5455_q.jpg,4445555555|zlzznz zsz Vzsznszn|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs555.snc5/55554_4445555555_5455505_q.jpg,4445554544|Szvgz Kzszcz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs455.snc5/54555_4445554544_5554_q.jpg,4450445555|Szrz Wzrsz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs4445.snc5/455405_4450445555_455550_q.jpg,4544450555|Szprzz Vzrvzlckz|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs454.zsr4/54555_4544450555_5445_q.jpg,4540554404|Gznzvzzvz zrnzlzs|http://przrzlz.zk.hidden.com/rprzrzlz-zk-snc5/rs544.zsr4/455540_4540554404_4405544_q.jpg', -jour = 4455555044; diff --git a/t/pt-query-advisor/checks.t b/t/pt-query-advisor/checks.t deleted file mode 100644 index 1640ea09..00000000 --- a/t/pt-query-advisor/checks.t +++ /dev/null @@ -1,166 +0,0 @@ -#!/usr/bin/env perl - -BEGIN { - die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" - unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; - unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; -}; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use Test::More tests => 13; - -use PerconaTest; -require "$trunk/bin/pt-query-advisor"; - -my @args = qw(--print-all --report-format full --group-by none --query); -my $query; - -# ############################################################################# -# Literals. -# ############################################################################# - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'SELECT ip FROM tbl WHERE ip="127.0.0.1"') }, - 't/pt-query-advisor/samples/lit-001.txt', - ), - 'LIT.001 "IP"' -); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'SELECT c FROM tbl WHERE c < 2010-02-15') }, - 't/pt-query-advisor/samples/lit-002-01.txt', - ), - 'LIT.002 YYYY-MM-DD' -); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'SELECT c FROM tbl WHERE c=20100215') }, - 't/pt-query-advisor/samples/lit-002-02.txt', - ), - 'LIT.002 YYYYMMDD' -); - -# ############################################################################# -# Table list. -# ############################################################################# - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'SELECT * FROM tbl WHERE id=1') }, - 't/pt-query-advisor/samples/tbl-001-01.txt', - ), - 'TBL.001 *' -); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'SELECT tbl.* FROM tbl WHERE id=2') }, - 't/pt-query-advisor/samples/tbl-001-02.txt', - ), - 'TBL.001 tbl.*' -); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'SELECT tbl.* foo, bar FROM tbl WHERE id=1') }, - 't/pt-query-advisor/samples/tbl-002-01.txt', - ), - 'TBL.002 tbl.* foo' -); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'SELECT tbl.* AS foo, bar FROM tbl WHERE id=2') }, - 't/pt-query-advisor/samples/tbl-002-02.txt', - ), - 'TBL.002 tbl.* AS foo' -); - -# ############################################################################# -# Query. -# ############################################################################# - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'insert into foo values ("bar")') }, - 't/pt-query-advisor/samples/qry-001-01.txt', - ), - 'QRY.001 INSERT' -); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'replace into foo values ("bar")') }, - 't/pt-query-advisor/samples/qry-001-02.txt', - ), - 'QRY.001 REPLACE' -); - -# ############################################################################# -# Subqueries. -# ############################################################################# - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'select t from w where i=1 or i in (select * from j)') }, - 't/pt-query-advisor/samples/sub-001-01.txt', - ), - 'SUB.001' -); - - -# ############################################################################# -# JOIN stuff. -# ############################################################################# - -$query = "SELECT * FROM `wibble_chapter` - INNER JOIN `wibble_series` AS `wibble_chapter__series` - ON `wibble_chapter`.`series_id` = `wibble_chapter__series`.`id`, - `wibble_series`, - `auth_user` - WHERE ( `wibble_chapter`.`chapnum` = 63.0 - AND `wibble_chapter`.`status` = 1 - AND `wibble_chapter__series`.`title` = 'bibble' ) - AND `wibble_chapter`.`series_id` = `wibble_series`.`id` - AND `wibble_series`.`poster_id` = `auth_user`.`id` - ORDER BY `wibble_chapter`.`create_time` DESC - LIMIT 1"; - -ok( - no_diff(sub { pt_query_advisor::main(@args, $query) }, - 't/pt-query-advisor/samples/joi-001-002-01.txt', - ), - 'JOI.001 and JOI.002' -); - - - -# ############################################################################# -# CLA.* rules -# ############################################################################# - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'select id from tbl1 join tbl2 using (a) group by tbl1.id, tbl2.id') }, - 't/pt-query-advisor/samples/cla-006-01.txt', - ), - 'CLA.001 and CLA.006' -); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - 'select c1, c2 from t where i=1 order by c1 desc, c2 asc') }, - 't/pt-query-advisor/samples/cla-007-01.txt', - ), - 'CLA.007' -); - -# ############################################################################# -# Done. -# ############################################################################# -exit; diff --git a/t/pt-query-advisor/get_create_table.t b/t/pt-query-advisor/get_create_table.t deleted file mode 100644 index f9119009..00000000 --- a/t/pt-query-advisor/get_create_table.t +++ /dev/null @@ -1,76 +0,0 @@ -#!/usr/bin/env perl - -BEGIN { - die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" - unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; - unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; -}; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use Test::More; - -use PerconaTest; -use Sandbox; -require "$trunk/bin/pt-query-advisor"; - -my $dp = new DSNParser(opts=>$dsn_opts); -my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp); -my $dbh = $sb->get_dbh_for('master'); - -if ( !$dbh ) { - plan skip_all => 'Cannot connect to sandbox master'; -} -else { - plan tests => 4; -} - -my $output = ""; -my $cnf = "/tmp/12345/my.sandbox.cnf"; -my @args = ('-F', $cnf, '-D', 'test'); - -$sb->create_dbs($dbh, ['test']); -$sb->load_file('master', "t/pt-query-advisor/samples/issue-950.sql", "test"); - -my $query = "select c from L left join R on l_id = r_id where r_other is null"; -$output = output( - sub { pt_query_advisor::main(@args, '--query', $query) }, -); -like( - $output, - qr/JOI.004/, - "JOI.004" -); - -$output = output( - sub { pt_query_advisor::main(@args, '--query', $query, - '--no-show-create-table') }, -); -is( - $output, - "", - "JOI.004 doesn't work with --no-show-create-table" -); - -$output = output( - sub { pt_query_advisor::main(@args, '--query', $query, - '--no-show-create-table', '--print-all') }, -); -is( - $output, - " -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ========================================== -# 0xE697459A77FBF34F 0 0 0 select c from l left join r on l_id = r_id where r_other is ? -", - "--print-all shows 0/0/0 item" -); - -# ############################################################################# -# Done. -# ############################################################################# -$sb->wipe_clean($dbh); -ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox"); -exit; diff --git a/t/pt-query-advisor/group_by.t b/t/pt-query-advisor/group_by.t deleted file mode 100644 index d3152f9b..00000000 --- a/t/pt-query-advisor/group_by.t +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/env perl - -BEGIN { - die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" - unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; - unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; -}; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use Test::More tests => 3; - -use PerconaTest; -require "$trunk/bin/pt-query-advisor"; - -ok( - no_diff( - sub { pt_query_advisor::main( - qw(--group-by none), - "$trunk/t/pt-query-advisor/samples/slow001.txt",) }, - "t/pt-query-advisor/samples/group-by-none-001.txt", - ), - "group by none" -); - -ok( - no_diff( - sub { pt_query_advisor::main( - "$trunk/t/pt-query-advisor/samples/slow001.txt",) }, - "t/pt-query-advisor/samples/group-by-rule-id-001.txt", - ), - "group by rule id (default)" -); - -ok( - no_diff( - sub { pt_query_advisor::main( - qw(--group-by query_id), - "$trunk/t/pt-query-advisor/samples/slow001.txt",) }, - "t/pt-query-advisor/samples/group-by-query-id-001.txt", - ), - "group by query_id" -); - -# ############################################################################# -# Done. -# ############################################################################# -exit; diff --git a/t/pt-query-advisor/ignore_rules.t b/t/pt-query-advisor/ignore_rules.t deleted file mode 100644 index dbd05bac..00000000 --- a/t/pt-query-advisor/ignore_rules.t +++ /dev/null @@ -1,31 +0,0 @@ -#!/usr/bin/env perl - -BEGIN { - die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" - unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; - unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; -}; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use Test::More tests => 1; - -use PerconaTest; -require "$trunk/bin/pt-query-advisor"; - -my @args = qw(--print-all --report-format full --group-by none); - -ok( - no_diff(sub { pt_query_advisor::main(@args, - qw(--ignore-rules COL.001), - '--query', 'SELECT * FROM tbl WHERE id=1') }, - 't/pt-query-advisor/samples/tbl-001-01-ignored.txt', - ), - 'Ignore a rule' -); - -# ############################################################################# -# Done. -# ############################################################################# -exit; diff --git a/t/pt-query-advisor/parse_logs.t b/t/pt-query-advisor/parse_logs.t deleted file mode 100644 index 371a1cc1..00000000 --- a/t/pt-query-advisor/parse_logs.t +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/env perl - -BEGIN { - die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" - unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; - unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; -}; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use Test::More; - -use PerconaTest; -require "$trunk/bin/pt-query-advisor"; - -my $output; -my @args = (); -my $sample = "$trunk/t/lib/samples/"; - -$output = output( - sub { pt_query_advisor::main(@args, "$sample/slowlogs/slow018.txt") }, -); -like( - $output, - qr/COL.002/, - "Parse slowlog" -); - -$output = output( - sub { pt_query_advisor::main(@args, qw(--type genlog), - "$sample/genlogs/genlog001.txt") }, -); -like( - $output, - qr/CLA.005/, - "Parse genlog" -); - -# ############################################################################# -# pt-query-advisor hangs on big queries -# https://bugs.launchpad.net/percona-toolkit/+bug/823431 -# ############################################################################# - -my $exit_status; -$output = output( - sub { $exit_status = pt_query_advisor::main(@args, - "$sample/bug_823431.log") - }, - stderr => 1 -); - -ok( - !$exit_status, - "Bug 823431: ptqa doesn't hang on a big query" -); - -is( - $output, - '', - "Bug 823431: ptqa doesn't hang on a big query and doesn't find an incorrect rule" -); - -# ############################################################################# -# Done. -# ############################################################################# -done_testing; diff --git a/t/pt-query-advisor/review.t b/t/pt-query-advisor/review.t deleted file mode 100644 index 17f14391..00000000 --- a/t/pt-query-advisor/review.t +++ /dev/null @@ -1,99 +0,0 @@ -#!/usr/bin/env perl - -BEGIN { - die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n" - unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH}; - unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib"; -}; - -use strict; -use warnings FATAL => 'all'; -use English qw(-no_match_vars); -use Test::More; - -use PerconaTest; -use Sandbox; -require "$trunk/bin/pt-query-advisor"; - -my $dp = new DSNParser(opts=>$dsn_opts); -my $sb = new Sandbox(basedir => '/tmp', DSNParser => $dp); -my $dbh = $sb->get_dbh_for('master'); - -if ( !$dbh ) { - plan skip_all => 'Cannot connect to sandbox master'; -} -else { - plan tests => 5; -} - -my $output = ""; -my $cnf = "/tmp/12345/my.sandbox.cnf"; -my @args = (qw(--print-all --report-format full --group-by none --review), "F=$cnf,D=test,t=query_review"); - -my $review_tbl = "CREATE TABLE query_review ( - checksum BIGINT UNSIGNED NOT NULL PRIMARY KEY, - fingerprint TEXT NOT NULL, - sample TEXT NOT NULL, - first_seen DATETIME, - last_seen DATETIME, - reviewed_by VARCHAR(20), - reviewed_on DATETIME, - comments TEXT -)"; - -$dbh->do('drop database if exists `test`'); -$dbh->do('create database `test`'); -$dbh->do('use `test`'); -$dbh->do($review_tbl); - -# Make sure it handles an empty review table. -$output = output( - sub { pt_query_advisor::main(@args) }, -); -is( - $output, - "", - "Empty --review table" -); - -$dbh->do("insert into test.query_review values - (1, 'select * from tbl where id=? order by col', - 'select * from tbl where id=42 order by col', - NOW(), NOW(), NULL, NULL, NULL)"); - -ok( - no_diff( - sub { pt_query_advisor::main(@args) }, - "t/pt-query-advisor/samples/review001.txt", - ), - "--review with one bad query" -); - -$dbh->do("insert into test.query_review values - (2, 'select col from tbl2 where id=? order by col limit ?', - 'select col from tbl2 where id=52 order by col limit 10', - NOW(), NOW(), NULL, NULL, NULL)"); - -ok( - no_diff( - sub { pt_query_advisor::main(@args) }, - "t/pt-query-advisor/samples/review002.txt", - ), - "--review with 1 bad, 1 good query" -); - -# That that --where works. -ok( - no_diff( - sub { pt_query_advisor::main(@args, qw(--where checksum=1)) }, - "t/pt-query-advisor/samples/review001.txt", - ), - "--review with --where" -); - -# ############################################################################# -# Done. -# ############################################################################# -$sb->wipe_clean($dbh); -ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox"); -exit; diff --git a/t/pt-query-advisor/samples/cla-006-01.txt b/t/pt-query-advisor/samples/cla-006-01.txt deleted file mode 100644 index 4530006f..00000000 --- a/t/pt-query-advisor/samples/cla-006-01.txt +++ /dev/null @@ -1,10 +0,0 @@ - -# Query ID 0xAED2E885BDADA166 at byte 0 -# WARN CLA.001 SELECT without WHERE. -# WARN CLA.006 GROUP BY or ORDER BY on different tables. -select id from tbl1 join tbl2 using (a) group by tbl1.id, tbl2.id - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ========================================== -# 0xAED2E885BDADA166 0 2 0 select id from tbl? join tbl? using (a) group by tbl?id, tbl?id diff --git a/t/pt-query-advisor/samples/cla-007-01.txt b/t/pt-query-advisor/samples/cla-007-01.txt deleted file mode 100644 index 58f37a24..00000000 --- a/t/pt-query-advisor/samples/cla-007-01.txt +++ /dev/null @@ -1,9 +0,0 @@ - -# Query ID 0xBA2547D924C5140D at byte 0 -# WARN CLA.007 ORDER BY clauses that sort the results in different directions prevents indexes from being used. -select c1, c2 from t where i=1 order by c1 desc, c2 asc - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ========================================== -# 0xBA2547D924C5140D 0 1 0 select c?, c? from t where i=? order by c? desc, c? diff --git a/t/pt-query-advisor/samples/group-by-none-001.txt b/t/pt-query-advisor/samples/group-by-none-001.txt deleted file mode 100644 index 5c5918e0..00000000 --- a/t/pt-query-advisor/samples/group-by-none-001.txt +++ /dev/null @@ -1,35 +0,0 @@ - -# Query ID 0xADCE32553F5D5859 at byte 0 -# WARN CLA.001 SELECT without WHERE. -# NOTE COL.001 SELECT *. -select * from tbl - -# Query ID 0x63C84ABE631F3CD0 at byte 191 -# Also: CLA.001 COL.001 -select * from tbl order by a - -# Query ID 0xB79802214165F670 at byte 297 -# NOTE COL.002 Blind INSERT. -insert into tbl values (null, 1, 'foo') - -# Query ID 0xEEA4D551871CCDC4 at byte 414 -# Also: COL.002 -replace into tbl2 values (1, '2', 'bar') - -# Query ID 0x52BAD5F0BF97EA19 at byte 532 -# WARN RES.001 Non-deterministic GROUP BY. -select a, b, c from x where id<1000 group by a, b - -# Query ID 0x01BF72F436E936F1 at byte 659 -# Also: RES.001 -select x, y, z from foo where id>1000 group by x, y - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ========================================== -# 0x01BF72F436E936F1 0 1 0 select x, y, z from foo where id>? group by x, y -# 0x52BAD5F0BF97EA19 0 1 0 select a, b, c from x where id? group by x, y -# 0x52BAD5F0BF97EA19 0 1 0 select a, b, c from x where id? group by x, y -# 0x52BAD5F0BF97EA19 0 1 0 select a, b, c from x where id1000 group by x, y; diff --git a/t/pt-query-advisor/samples/sub-001-01.txt b/t/pt-query-advisor/samples/sub-001-01.txt deleted file mode 100644 index 9a4a322f..00000000 --- a/t/pt-query-advisor/samples/sub-001-01.txt +++ /dev/null @@ -1,10 +0,0 @@ - -# Query ID 0xD6E9D91F645455DB at byte 0 -# CRIT SUB.001 IN() and NOT IN() subqueries are poorly optimized. -# matches near: i in (select * from j) -select t from w where i=1 or i in (select * from j) - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ========================================== -# 0xD6E9D91F645455DB 0 0 1 select t from w where i=? or i in (select * from j) diff --git a/t/pt-query-advisor/samples/tbl-001-01-ignored.txt b/t/pt-query-advisor/samples/tbl-001-01-ignored.txt deleted file mode 100644 index d4a09a5d..00000000 --- a/t/pt-query-advisor/samples/tbl-001-01-ignored.txt +++ /dev/null @@ -1,8 +0,0 @@ - -# Query ID 0xE182E0865F5BEEBB at byte 0 -SELECT * FROM tbl WHERE id=1 - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ============================ -# 0xE182E0865F5BEEBB 0 0 0 select * from tbl where id=? diff --git a/t/pt-query-advisor/samples/tbl-001-01.txt b/t/pt-query-advisor/samples/tbl-001-01.txt deleted file mode 100644 index 87445dd9..00000000 --- a/t/pt-query-advisor/samples/tbl-001-01.txt +++ /dev/null @@ -1,9 +0,0 @@ - -# Query ID 0xE182E0865F5BEEBB at byte 0 -# NOTE COL.001 SELECT *. -SELECT * FROM tbl WHERE id=1 - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ============================ -# 0xE182E0865F5BEEBB 1 0 0 select * from tbl where id=? diff --git a/t/pt-query-advisor/samples/tbl-001-02.txt b/t/pt-query-advisor/samples/tbl-001-02.txt deleted file mode 100644 index efeedbf6..00000000 --- a/t/pt-query-advisor/samples/tbl-001-02.txt +++ /dev/null @@ -1,9 +0,0 @@ - -# Query ID 0x34C93ACCCD015F48 at byte 0 -# NOTE COL.001 SELECT *. -SELECT tbl.* FROM tbl WHERE id=2 - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ================================ -# 0x34C93ACCCD015F48 1 0 0 select tbl.* from tbl where id=? diff --git a/t/pt-query-advisor/samples/tbl-002-01.txt b/t/pt-query-advisor/samples/tbl-002-01.txt deleted file mode 100644 index 5cae1bd9..00000000 --- a/t/pt-query-advisor/samples/tbl-002-01.txt +++ /dev/null @@ -1,11 +0,0 @@ - -# Query ID 0x75364D6054FA40ED at byte 0 -# NOTE ALI.001 Aliasing without the AS keyword. -# WARN ALI.002 Aliasing the '*' wildcard. -# NOTE COL.001 SELECT *. -SELECT tbl.* foo, bar FROM tbl WHERE id=1 - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ========================================= -# 0x75364D6054FA40ED 2 1 0 select tbl.* foo, bar from tbl where id=? diff --git a/t/pt-query-advisor/samples/tbl-002-02.txt b/t/pt-query-advisor/samples/tbl-002-02.txt deleted file mode 100644 index 7e3e3ca4..00000000 --- a/t/pt-query-advisor/samples/tbl-002-02.txt +++ /dev/null @@ -1,10 +0,0 @@ - -# Query ID 0x31C7ABF526209286 at byte 0 -# WARN ALI.002 Aliasing the '*' wildcard. -# NOTE COL.001 SELECT *. -SELECT tbl.* AS foo, bar FROM tbl WHERE id=2 - -# Profile -# Query ID NOTE WARN CRIT Item -# ================== ==== ==== ==== ========================================== -# 0x31C7ABF526209286 1 1 0 select tbl.* as foo, bar from tbl where id=?