Merge lp:~percona-toolkit-dev/percona-toolkit/fix-pt-heartbeat-dupe-key-bug-1004567 into lp:percona-toolkit/2.0

Proposed by Daniel Nichter
Status: Merged
Merged at revision: 250
Proposed branch: lp:~percona-toolkit-dev/percona-toolkit/fix-pt-heartbeat-dupe-key-bug-1004567
Merge into: lp:percona-toolkit/2.0
Diff against target: 99953 lines (+70763/-13287) (has conflicts)
617 files modified
.bzrignore (+1/-0)
Changelog (+91/-0)
MANIFEST (+2/-0)
Makefile.PL (+6/-2)
bin/pt-align (+4/-0)
bin/pt-archiver (+811/-455)
bin/pt-config-diff (+67/-49)
bin/pt-deadlock-logger (+695/-76)
bin/pt-diskstats (+111/-6)
bin/pt-duplicate-key-checker (+301/-548)
bin/pt-fifo-split (+5/-1)
bin/pt-find (+203/-501)
bin/pt-fingerprint (+2143/-0)
bin/pt-fk-error-logger (+194/-46)
bin/pt-heartbeat (+308/-197)
bin/pt-index-usage (+426/-553)
bin/pt-ioprofile (+59/-22)
bin/pt-kill (+1655/-148)
bin/pt-log-player (+64/-47)
bin/pt-mext (+20/-4)
bin/pt-mysql-summary (+2092/-681)
bin/pt-online-schema-change (+5820/-1324)
bin/pt-pmp (+21/-9)
bin/pt-query-advisor (+486/-458)
bin/pt-query-digest (+341/-436)
bin/pt-show-grants (+62/-54)
bin/pt-sift (+37/-14)
bin/pt-slave-delay (+658/-178)
bin/pt-slave-find (+754/-85)
bin/pt-slave-restart (+702/-82)
bin/pt-stalk (+33/-11)
bin/pt-summary (+2046/-792)
bin/pt-table-checksum (+1454/-272)
bin/pt-table-sync (+957/-160)
bin/pt-table-usage (+7375/-0)
bin/pt-tcp-model (+106/-3)
bin/pt-trend (+106/-3)
bin/pt-upgrade (+291/-543)
bin/pt-variable-advisor (+656/-98)
bin/pt-visual-explain (+60/-46)
config/deb/changelog (+94/-0)
config/sphinx-build/conf.py (+5/-1)
docs/percona-toolkit.pod (+16/-4)
docs/release_notes.rst (+139/-0)
lib/CleanupTask.pm (+7/-2)
lib/CompareQueryTimes.pm (+13/-7)
lib/CompareResults.pm (+8/-4)
lib/CompareWarnings.pm (+14/-8)
lib/Cxn.pm (+20/-8)
lib/DSNParser.pm (+61/-51)
lib/DiskstatsGroupByAll.pm (+1/-1)
lib/DiskstatsGroupByDisk.pm (+1/-1)
lib/EventAggregator.pm (+1/-1)
lib/IndexLength.pm (+175/-0)
lib/IndexUsage.pm (+1/-0)
lib/MasterSlave.pm (+12/-10)
lib/Mo.pm (+519/-0)
lib/MySQLProtocolParser.pm (+1/-1)
lib/NibbleIterator.pm (+224/-50)
lib/OSCCaptureSync.pm (+0/-142)
lib/OobNibbleIterator.pm (+1/-1)
lib/PerconaTest.pm (+132/-5)
lib/Processlist.pm (+16/-3)
lib/ProtocolParser.pm (+1/-1)
lib/QueryAdvisorRules.pm (+1/-1)
lib/QueryReportFormatter.pm (+6/-8)
lib/QueryRewriter.pm (+24/-4)
lib/ReadKeyMini.pm (+23/-14)
lib/RowChecksum.pm (+1/-1)
lib/SQLParser.pm (+103/-8)
lib/Sandbox.pm (+240/-17)
lib/TableChecksum.pm (+3/-10)
lib/TableNibbler.pm (+7/-1)
lib/TableParser.pm (+34/-14)
lib/TableSyncChunk.pm (+1/-1)
lib/TableSyncNibble.pm (+1/-1)
lib/TableSyncer.pm (+3/-8)
lib/TableUsage.pm (+1080/-0)
lib/Transformers.pm (+94/-0)
lib/UpgradeReportFormatter.pm (+14/-5)
lib/VariableAdvisorRules.pm (+6/-22)
lib/VersionParser.pm (+146/-26)
lib/bash/alt_cmds.sh (+25/-1)
lib/bash/collect_mysql_info.sh (+264/-0)
lib/bash/collect_system_info.sh (+576/-0)
lib/bash/log_warn_die.sh (+6/-0)
lib/bash/parse_options.sh (+7/-7)
lib/bash/report_formatting.sh (+122/-0)
lib/bash/report_mysql_info.sh (+1391/-0)
lib/bash/report_system_info.sh (+1050/-0)
lib/bash/summary_common.sh (+155/-0)
lib/bash/tmpdir.sh (+14/-10)
sandbox/jenkins-test (+44/-17)
sandbox/servers/4.1/my.sandbox.cnf (+1/-0)
sandbox/servers/5.0/my.sandbox.cnf (+1/-0)
sandbox/servers/5.1/my.sandbox.cnf (+1/-0)
sandbox/servers/5.5/my.sandbox.cnf (+2/-0)
sandbox/start-sandbox (+31/-15)
sandbox/stop-sandbox (+8/-2)
sandbox/test-env (+63/-67)
t/lib/ChangeHandler.t (+18/-15)
t/lib/CleanupTask.t (+18/-1)
t/lib/CompareQueryTimes.t (+8/-7)
t/lib/CompareResults.t (+29/-32)
t/lib/CompareWarnings.t (+10/-9)
t/lib/CopyRowsInsertSelect.t (+3/-3)
t/lib/Cxn.t (+3/-2)
t/lib/DSNParser.t (+108/-17)
t/lib/Daemon.t (+50/-36)
t/lib/DuplicateKeyFinder.t (+2/-1)
t/lib/EventAggregator.t (+16/-1)
t/lib/ExplainAnalyzer.t (+2/-1)
t/lib/IndexLength.pm (+135/-0)
t/lib/IndexUsage.t (+3/-2)
t/lib/KeySize.t (+2/-1)
t/lib/MasterSlave.t (+114/-16)
t/lib/Mo/Bar.pm (+4/-0)
t/lib/Mo/Boo.pm (+6/-0)
t/lib/Mo/Foo.pm (+6/-0)
t/lib/Mo/build.t (+51/-0)
t/lib/Mo/buildargs.t (+62/-0)
t/lib/Mo/coerce.t (+27/-0)
t/lib/Mo/extends.t (+26/-0)
t/lib/Mo/handles.t (+482/-0)
t/lib/Mo/init_arg.t (+91/-0)
t/lib/Mo/is.t (+26/-0)
t/lib/Mo/isa.t (+185/-0)
t/lib/Mo/object.t (+20/-0)
t/lib/Mo/required.t (+39/-0)
t/lib/Mo/strict.t (+19/-0)
t/lib/Mo/test.t (+140/-0)
t/lib/MockSyncStream.t (+3/-2)
t/lib/MySQLConfig.t (+2/-1)
t/lib/NibbleIterator.t (+80/-35)
t/lib/OSCCaptureSync.t (+0/-131)
t/lib/OobNibbleIterator.t (+38/-3)
t/lib/Outfile.t (+2/-1)
t/lib/Processlist.t (+26/-20)
t/lib/QueryReportFormatter.t (+2/-2)
t/lib/QueryReview.t (+3/-2)
t/lib/QueryRewriter.t (+59/-1)
t/lib/Quoter.t (+14/-7)
t/lib/RowChecksum.t (+2/-1)
t/lib/RowDiff-custom.t (+2/-1)
t/lib/RowDiff.t (+2/-1)
t/lib/SQLParser.t (+1/-1)
t/lib/SchemaIterator.t (+35/-9)
t/lib/TableChecksum.t (+7/-15)
t/lib/TableChunker.t (+25/-15)
t/lib/TableNibbler.t (+62/-1)
t/lib/TableParser.t (+27/-11)
t/lib/TableSyncChunk.t (+3/-4)
t/lib/TableSyncNibble.t (+2/-5)
t/lib/TableSyncer.t (+2/-9)
t/lib/TableUsage.t (+817/-0)
t/lib/Transformers.t (+106/-2)
t/lib/UpgradeReportFormatter.t (+4/-2)
t/lib/VariableAdvisorRules.t (+7/-6)
t/lib/VersionParser.t (+114/-8)
t/lib/bash/alt_cmds.sh (+2/-2)
t/lib/bash/collect.sh (+15/-13)
t/lib/bash/collect_mysql_info.sh (+199/-0)
t/lib/bash/collect_system_info.sh (+314/-0)
t/lib/bash/daemon.sh (+9/-9)
t/lib/bash/log_warn_die.sh (+8/-8)
t/lib/bash/parse_options.sh (+2/-2)
t/lib/bash/report_formatting.sh (+113/-0)
t/lib/bash/report_mysql_info.sh (+723/-0)
t/lib/bash/report_system_info.sh (+1580/-0)
t/lib/bash/safeguards.sh (+12/-12)
t/lib/bash/summary_common.sh (+79/-0)
t/lib/bash/tmpdir.sh (+29/-7)
t/lib/samples/SchemaIterator.sql (+29/-10)
t/lib/samples/SchemaIterator/all-dbs-tbls-5.0.txt (+99/-41)
t/lib/samples/SchemaIterator/all-dbs-tbls-5.1.txt (+226/-60)
t/lib/samples/SchemaIterator/all-dbs-tbls.txt (+553/-0)
t/lib/samples/SchemaIterator/mysql-user-ddl-5.5.txt (+47/-0)
t/lib/samples/SchemaIterator/resume-from-ignored-sakila-payment-5.0.txt (+52/-0)
t/lib/samples/SchemaIterator/resume-from-sakila-payment-5.0.txt (+70/-0)
t/lib/samples/ansi.quoting.sql (+9/-0)
t/lib/samples/pod/mqa-rule-LIT.001.pod (+2/-2)
t/lib/samples/pod/pod_sample_01.txt (+3/-3)
t/lib/samples/pod/pod_sample_02.txt (+3/-3)
t/lib/samples/pod/pod_sample_03.txt (+3/-3)
t/lib/samples/pod/pod_sample_04.txt (+3/-3)
t/lib/samples/pod/pod_sample_issue_140.txt (+2/-2)
t/lib/samples/pod/pod_sample_mqa.txt (+2/-2)
t/lib/samples/podsample.txt (+4/-4)
t/lib/samples/ro-checksum-user.sql (+3/-0)
t/lib/samples/slowlogs/slow055.txt (+15/-0)
t/pt-archiver/basics.t (+5/-0)
t/pt-archiver/bulk_delete.t (+2/-1)
t/pt-archiver/bulk_insert.t (+2/-1)
t/pt-archiver/bulk_regular_insert.t (+2/-1)
t/pt-archiver/check_slave_lag.t (+2/-2)
t/pt-archiver/compact_col_vals.t (+2/-1)
t/pt-archiver/delete_more.t (+2/-4)
t/pt-archiver/dest.t (+2/-1)
t/pt-archiver/file.t (+5/-0)
t/pt-archiver/gt_n.t (+2/-2)
t/pt-archiver/indexes.t (+2/-1)
t/pt-archiver/issue_1152.t (+2/-1)
t/pt-archiver/issue_1166.t (+2/-1)
t/pt-archiver/issue_1225.t (+2/-4)
t/pt-archiver/issue_1229.t (+6/-2)
t/pt-archiver/issue_131.t (+2/-1)
t/pt-archiver/issue_524.t (+2/-1)
t/pt-archiver/issue_655.t (+2/-1)
t/pt-archiver/plugin.t (+2/-1)
t/pt-archiver/purge.t (+2/-1)
t/pt-archiver/res_fk.t (+2/-1)
t/pt-archiver/safe_auto_increment.t (+2/-1)
t/pt-archiver/samples/bulk_regular_insert.pm (+3/-3)
t/pt-archiver/samples/compact_col_vals.pm (+10/-10)
t/pt-archiver/samples/delete_more.pm (+8/-8)
t/pt-archiver/samples/gt_n.pm (+8/-8)
t/pt-archiver/samples/res_fk.pm (+11/-11)
t/pt-archiver/samples/table1.sql (+1/-1)
t/pt-archiver/samples/table5.sql (+4/-4)
t/pt-archiver/samples/tables1-4.sql (+4/-4)
t/pt-archiver/samples/tables7-9.sql (+2/-2)
t/pt-archiver/standard_options.t (+5/-5)
t/pt-config-diff/basics.t (+2/-1)
t/pt-config-diff/reports.t (+2/-1)
t/pt-deadlock-logger/basics.t (+10/-2)
t/pt-deadlock-logger/bugs.t (+73/-0)
t/pt-deadlock-logger/clear_deadlocks.t (+2/-1)
t/pt-deadlock-logger/create_dest_table.t (+4/-3)
t/pt-deadlock-logger/samples/bug_903443.txt (+53/-0)
t/pt-deadlock-logger/standard_options.t (+2/-1)
t/pt-diskstats/pt-diskstats.t (+6/-0)
t/pt-duplicate-key-checker/basics.t (+60/-11)
t/pt-duplicate-key-checker/clustered_keys.t (+2/-1)
t/pt-duplicate-key-checker/issue_1192.t (+2/-1)
t/pt-duplicate-key-checker/issue_298.t (+2/-1)
t/pt-duplicate-key-checker/issue_331.t (+2/-1)
t/pt-duplicate-key-checker/issue_663.t (+2/-1)
t/pt-duplicate-key-checker/samples/bug-894140.txt (+32/-0)
t/pt-duplicate-key-checker/samples/key-types-f.txt (+5/-0)
t/pt-duplicate-key-checker/samples/key-types-fk.txt (+5/-0)
t/pt-duplicate-key-checker/samples/key-types-k.txt (+5/-0)
t/pt-find/pt-find.t (+15/-6)
t/pt-fingerprint/basics.t (+101/-0)
t/pt-fingerprint/samples/query001 (+2/-0)
t/pt-fingerprint/samples/query001.fingerprint (+1/-0)
t/pt-fingerprint/samples/query002 (+2/-0)
t/pt-fingerprint/samples/query002.fingerprint (+1/-0)
t/pt-fk-error-logger/basics.t (+2/-1)
t/pt-heartbeat/basics.t (+78/-15)
t/pt-heartbeat/multi_update_mode.t (+2/-1)
t/pt-heartbeat/standard_options.t (+2/-1)
t/pt-index-usage/basics.t (+3/-2)
t/pt-index-usage/save_results.t (+3/-2)
t/pt-ioprofile/pt-ioprofile.t (+5/-5)
t/pt-ioprofile/summarize_strace.sh (+5/-5)
t/pt-ioprofile/tabulate_strace.sh (+5/-5)
t/pt-kill/basics.t (+31/-4)
t/pt-kill/execute_command.t (+6/-4)
t/pt-kill/kill.t (+158/-3)
t/pt-kill/match.t (+2/-1)
t/pt-kill/standard_options.t (+3/-2)
t/pt-log-player/issue_799.t (+2/-1)
t/pt-log-player/issue_903.t (+2/-1)
t/pt-log-player/play.t (+2/-1)
t/pt-mysql-summary/find_my_cnf_file.sh (+0/-20)
t/pt-mysql-summary/format_binlog_filters.sh (+0/-12)
t/pt-mysql-summary/format_innodb_status.sh (+0/-147)
t/pt-mysql-summary/format_overall_db_stats.sh (+0/-61)
t/pt-mysql-summary/format_status_variables.sh (+0/-97)
t/pt-mysql-summary/fuzz.sh (+0/-7)
t/pt-mysql-summary/get_mysql_info.sh (+0/-26)
t/pt-mysql-summary/parse_mysqld_instances.sh (+0/-47)
t/pt-mysql-summary/pretty_print_cnf_file.sh (+0/-40)
t/pt-mysql-summary/pt-mysql-summary.t (+54/-2)
t/pt-mysql-summary/samples/expected_output_temp002.txt (+276/-0)
t/pt-mysql-summary/samples/expected_output_temp003.txt (+219/-0)
t/pt-mysql-summary/samples/expected_output_temp004.txt (+218/-0)
t/pt-mysql-summary/samples/expected_output_temp005.txt (+291/-0)
t/pt-mysql-summary/samples/expected_result_report_summary.txt (+257/-0)
t/pt-mysql-summary/samples/mysql-variables-with-semisync.txt (+326/-0)
t/pt-mysql-summary/samples/temp001/mysql-status (+304/-0)
t/pt-mysql-summary/samples/temp001/mysql-variables (+356/-0)
t/pt-mysql-summary/samples/temp002/innodb-status (+118/-0)
t/pt-mysql-summary/samples/temp002/mysql-config-file (+26/-0)
t/pt-mysql-summary/samples/temp002/mysql-databases (+6/-0)
t/pt-mysql-summary/samples/temp002/mysql-plugins (+35/-0)
t/pt-mysql-summary/samples/temp002/mysql-processlist (+12/-0)
t/pt-mysql-summary/samples/temp002/mysql-status (+370/-0)
t/pt-mysql-summary/samples/temp002/mysql-status-defer (+370/-0)
t/pt-mysql-summary/samples/temp002/mysql-users (+1/-0)
t/pt-mysql-summary/samples/temp002/mysql-variables (+372/-0)
t/pt-mysql-summary/samples/temp002/mysqld-instances (+4/-0)
t/pt-mysql-summary/samples/temp002/mysqldump (+396/-0)
t/pt-mysql-summary/samples/temp003/innodb-status (+77/-0)
t/pt-mysql-summary/samples/temp003/mysql-config-file (+26/-0)
t/pt-mysql-summary/samples/temp003/mysql-databases (+2/-0)
t/pt-mysql-summary/samples/temp003/mysql-master-logs (+1/-0)
t/pt-mysql-summary/samples/temp003/mysql-master-status (+1/-0)
t/pt-mysql-summary/samples/temp003/mysql-plugins (+10/-0)
t/pt-mysql-summary/samples/temp003/mysql-processlist (+9/-0)
t/pt-mysql-summary/samples/temp003/mysql-status (+291/-0)
t/pt-mysql-summary/samples/temp003/mysql-status-defer (+291/-0)
t/pt-mysql-summary/samples/temp003/mysql-users (+1/-0)
t/pt-mysql-summary/samples/temp003/mysql-variables (+285/-0)
t/pt-mysql-summary/samples/temp003/mysqld-instances (+2/-0)
t/pt-mysql-summary/samples/temp004/innodb-status (+77/-0)
t/pt-mysql-summary/samples/temp004/mysql-config-file (+26/-0)
t/pt-mysql-summary/samples/temp004/mysql-databases (+3/-0)
t/pt-mysql-summary/samples/temp004/mysql-master-logs (+2/-0)
t/pt-mysql-summary/samples/temp004/mysql-master-status (+1/-0)
t/pt-mysql-summary/samples/temp004/mysql-plugins (+10/-0)
t/pt-mysql-summary/samples/temp004/mysql-processlist (+9/-0)
t/pt-mysql-summary/samples/temp004/mysql-status (+291/-0)
t/pt-mysql-summary/samples/temp004/mysql-status-defer (+291/-0)
t/pt-mysql-summary/samples/temp004/mysql-users (+1/-0)
t/pt-mysql-summary/samples/temp004/mysql-variables (+285/-0)
t/pt-mysql-summary/samples/temp004/mysqld-instances (+2/-0)
t/pt-mysql-summary/samples/temp005/innodb-status (+108/-0)
t/pt-mysql-summary/samples/temp005/mysql-config-file (+26/-0)
t/pt-mysql-summary/samples/temp005/mysql-databases (+3/-0)
t/pt-mysql-summary/samples/temp005/mysql-master-logs (+1/-0)
t/pt-mysql-summary/samples/temp005/mysql-master-status (+1/-0)
t/pt-mysql-summary/samples/temp005/mysql-plugins (+28/-0)
t/pt-mysql-summary/samples/temp005/mysql-processlist (+18/-0)
t/pt-mysql-summary/samples/temp005/mysql-status (+304/-0)
t/pt-mysql-summary/samples/temp005/mysql-status-defer (+304/-0)
t/pt-mysql-summary/samples/temp005/mysql-users (+1/-0)
t/pt-mysql-summary/samples/temp005/mysql-variables (+363/-0)
t/pt-mysql-summary/samples/temp005/mysqld-executables (+1/-0)
t/pt-mysql-summary/samples/temp005/mysqld-instances (+4/-0)
t/pt-mysql-summary/samples/temp005/mysqldump (+1084/-0)
t/pt-mysql-summary/samples/tempdir/innodb-status (+77/-0)
t/pt-mysql-summary/samples/tempdir/mysql-config-file (+26/-0)
t/pt-mysql-summary/samples/tempdir/mysql-databases (+3/-0)
t/pt-mysql-summary/samples/tempdir/mysql-master-logs (+3/-0)
t/pt-mysql-summary/samples/tempdir/mysql-master-status (+1/-0)
t/pt-mysql-summary/samples/tempdir/mysql-plugins (+10/-0)
t/pt-mysql-summary/samples/tempdir/mysql-processlist (+9/-0)
t/pt-mysql-summary/samples/tempdir/mysql-status (+291/-0)
t/pt-mysql-summary/samples/tempdir/mysql-status-defer (+291/-0)
t/pt-mysql-summary/samples/tempdir/mysql-users (+5/-0)
t/pt-mysql-summary/samples/tempdir/mysql-variables (+283/-0)
t/pt-mysql-summary/samples/tempdir/mysqld-instances (+4/-0)
t/pt-mysql-summary/samples/tempdir/mysqldump (+328/-0)
t/pt-mysql-summary/samples/tempdir/tempfile (+130/-0)
t/pt-mysql-summary/summarize_binlogs.sh (+0/-13)
t/pt-mysql-summary/summarize_processlist.sh (+0/-64)
t/pt-online-schema-change/alter_active_table.t (+73/-52)
t/pt-online-schema-change/basics.t (+566/-220)
t/pt-online-schema-change/bugs.t (+119/-0)
t/pt-online-schema-change/check_tables.t (+0/-126)
t/pt-online-schema-change/option_sanity.t (+34/-13)
t/pt-online-schema-change/privs.t (+96/-0)
t/pt-online-schema-change/samples/basic_no_fks.data (+500/-500)
t/pt-online-schema-change/samples/basic_no_fks.sql (+30/-0)
t/pt-online-schema-change/samples/basic_with_fks.sql (+56/-0)
t/pt-online-schema-change/samples/bug-1002448.sql (+14/-0)
t/pt-online-schema-change/samples/bug-1003315.sql (+23/-0)
t/pt-online-schema-change/samples/fk_tables_schema.sql (+0/-31)
t/pt-online-schema-change/samples/osc-user.sql (+3/-0)
t/pt-online-schema-change/samples/pk-bug-994002.sql (+29/-0)
t/pt-online-schema-change/samples/query_table.pl (+14/-6)
t/pt-online-schema-change/samples/small_table.sql (+0/-27)
t/pt-online-schema-change/sanity_checks.t (+112/-0)
t/pt-online-schema-change/skip_innodb.t (+58/-0)
t/pt-pmp/aggregate_stacktrace.sh (+19/-19)
t/pt-query-advisor/get_create_table.t (+2/-1)
t/pt-query-advisor/review.t (+10/-9)
t/pt-query-advisor/samples/cla-006-01.txt (+1/-1)
t/pt-query-advisor/samples/cla-007-01.txt (+1/-1)
t/pt-query-digest/collect_and_report_cycles.t (+2/-1)
t/pt-query-digest/daemon.t (+2/-1)
t/pt-query-digest/execute.t (+2/-3)
t/pt-query-digest/explain.t (+6/-6)
t/pt-query-digest/explain_partitions.t (+3/-3)
t/pt-query-digest/issue_1186.t (+2/-1)
t/pt-query-digest/issue_360.t (+30/-15)
t/pt-query-digest/mirror.t (+3/-2)
t/pt-query-digest/processlist.t (+2/-1)
t/pt-query-digest/read_timeout.t (+9/-2)
t/pt-query-digest/review.t (+97/-58)
t/pt-query-digest/run_time.t (+2/-1)
t/pt-query-digest/samples/filter-add-ymdh-attribs.txt (+2/-2)
t/pt-query-digest/samples/slow007_explain_1-55.txt (+46/-0)
t/pt-query-digest/samples/slow055.txt (+30/-0)
t/pt-query-digest/since_until.t (+2/-1)
t/pt-query-digest/slowlog_analyses.t (+13/-1)
t/pt-query-digest/standard_options.t (+2/-1)
t/pt-show-grants/all_grants.t (+2/-1)
t/pt-show-grants/basics.t (+2/-1)
t/pt-show-grants/issue_445.t (+2/-1)
t/pt-sift/pt-sift.t (+1/-4)
t/pt-slave-delay/auto_restart.t (+42/-5)
t/pt-slave-delay/basics.t (+9/-1)
t/pt-slave-delay/issue_1169.t (+1/-1)
t/pt-slave-delay/standard_options.t (+3/-2)
t/pt-slave-find/pt-slave-find.t (+42/-11)
t/pt-slave-restart/pt-slave-restart.t (+11/-5)
t/pt-stalk/pt-stalk.t (+17/-17)
t/pt-summary/format_vmstat.sh (+0/-37)
t/pt-summary/parse_arcconf.sh (+0/-176)
t/pt-summary/parse_dmidecode_mem_devices.sh (+0/-104)
t/pt-summary/parse_ethernet_controller_lspci.sh (+0/-11)
t/pt-summary/parse_fdisk.sh (+0/-16)
t/pt-summary/parse_filesystems.sh (+0/-52)
t/pt-summary/parse_free_minus_b.sh (+0/-67)
t/pt-summary/parse_fusionmpt_lsiutil.sh (+0/-50)
t/pt-summary/parse_hpacucli.sh (+0/-26)
t/pt-summary/parse_ip_s_link.sh (+0/-28)
t/pt-summary/parse_lsi_megaraid.sh (+0/-696)
t/pt-summary/parse_netstat.sh (+0/-49)
t/pt-summary/parse_proc_cpuinfo.sh (+0/-74)
t/pt-summary/parse_raid_controller_dmesg.sh (+0/-32)
t/pt-summary/parse_raid_controller_lspci.sh (+0/-39)
t/pt-summary/parse_virtualization_dmesg.sh (+0/-10)
t/pt-summary/pt-summary.t (+12/-2)
t/pt-summary/samples/BSD/freebsd_001/mounted_fs (+7/-0)
t/pt-summary/samples/BSD/freebsd_001/notable_procs (+2/-0)
t/pt-summary/samples/BSD/freebsd_001/processes (+10/-0)
t/pt-summary/samples/BSD/freebsd_001/summary (+10/-0)
t/pt-summary/samples/BSD/freebsd_001/sysctl (+1481/-0)
t/pt-summary/samples/BSD/freebsd_001/uptime (+1/-0)
t/pt-summary/samples/BSD/freebsd_001/vmstat (+7/-0)
t/pt-summary/samples/BSD/netbsd_001/mounted_fs (+5/-0)
t/pt-summary/samples/BSD/netbsd_001/notable_procs (+2/-0)
t/pt-summary/samples/BSD/netbsd_001/proc_cpuinfo_copy (+14/-0)
t/pt-summary/samples/BSD/netbsd_001/processes (+10/-0)
t/pt-summary/samples/BSD/netbsd_001/summary (+10/-0)
t/pt-summary/samples/BSD/netbsd_001/swapctl (+1/-0)
t/pt-summary/samples/BSD/netbsd_001/sysctl (+511/-0)
t/pt-summary/samples/BSD/netbsd_001/uptime (+1/-0)
t/pt-summary/samples/BSD/netbsd_001/vmstat (+7/-0)
t/pt-summary/samples/BSD/openbsd_001/mounted_fs (+4/-0)
t/pt-summary/samples/BSD/openbsd_001/notable_procs (+2/-0)
t/pt-summary/samples/BSD/openbsd_001/processes (+10/-0)
t/pt-summary/samples/BSD/openbsd_001/summary (+10/-0)
t/pt-summary/samples/BSD/openbsd_001/swapctl (+1/-0)
t/pt-summary/samples/BSD/openbsd_001/sysctl (+423/-0)
t/pt-summary/samples/BSD/openbsd_001/uptime (+1/-0)
t/pt-summary/samples/BSD/openbsd_001/vmstat (+7/-0)
t/pt-summary/samples/Linux/001/dmesg_file (+786/-0)
t/pt-summary/samples/Linux/001/dmidecode (+412/-0)
t/pt-summary/samples/Linux/001/ip (+24/-0)
t/pt-summary/samples/Linux/001/lspci_file (+17/-0)
t/pt-summary/samples/Linux/001/lvs (+1/-0)
t/pt-summary/samples/Linux/001/memory (+50/-0)
t/pt-summary/samples/Linux/001/mounted_fs (+12/-0)
t/pt-summary/samples/Linux/001/netstat (+6/-0)
t/pt-summary/samples/Linux/001/notable_procs (+5/-0)
t/pt-summary/samples/Linux/001/partitioning (+30/-0)
t/pt-summary/samples/Linux/001/proc_cpuinfo_copy (+58/-0)
t/pt-summary/samples/Linux/001/proc_cpuinfo_copy.unq (+1/-0)
t/pt-summary/samples/Linux/001/processes (+10/-0)
t/pt-summary/samples/Linux/001/summary (+23/-0)
t/pt-summary/samples/Linux/001/sysctl (+905/-0)
t/pt-summary/samples/Linux/001/uptime (+1/-0)
t/pt-summary/samples/Linux/001/vmstat (+7/-0)
t/pt-summary/samples/Linux/002/dmesg_file (+283/-0)
t/pt-summary/samples/Linux/002/memory (+34/-0)
t/pt-summary/samples/Linux/002/mounted_fs (+3/-0)
t/pt-summary/samples/Linux/002/netstat (+6/-0)
t/pt-summary/samples/Linux/002/notable_procs (+2/-0)
t/pt-summary/samples/Linux/002/partitioning (+9/-0)
t/pt-summary/samples/Linux/002/proc_cpuinfo_copy (+19/-0)
t/pt-summary/samples/Linux/002/processes (+10/-0)
t/pt-summary/samples/Linux/002/summary (+19/-0)
t/pt-summary/samples/Linux/002/uptime (+1/-0)
t/pt-summary/samples/Linux/002/vmstat (+7/-0)
t/pt-summary/samples/Linux/003/dmesg_file (+283/-0)
t/pt-summary/samples/Linux/003/memory (+34/-0)
t/pt-summary/samples/Linux/003/mounted_fs (+3/-0)
t/pt-summary/samples/Linux/003/netstat (+6/-0)
t/pt-summary/samples/Linux/003/notable_procs (+2/-0)
t/pt-summary/samples/Linux/003/partitioning (+1/-0)
t/pt-summary/samples/Linux/003/proc_cpuinfo_copy (+19/-0)
t/pt-summary/samples/Linux/003/processes (+10/-0)
t/pt-summary/samples/Linux/003/summary (+19/-0)
t/pt-summary/samples/Linux/003/uptime (+1/-0)
t/pt-summary/samples/Linux/003/vmstat (+7/-0)
t/pt-summary/samples/Linux/output_002.txt (+82/-0)
t/pt-summary/samples/Linux/output_003.txt (+79/-0)
t/pt-summary/samples/MegaCli64_AdpAllInfo_aALL001.txt (+227/-0)
t/pt-summary/samples/MegaCli64_LdPdInfo_aALL_886223 (+214/-0)
t/pt-summary/samples/arcconf-001.txt (+133/-0)
t/pt-summary/samples/arcconf-003_900285.txt (+228/-0)
t/pt-summary/samples/arcconf-004_917781.txt (+162/-0)
t/pt-summary/samples/dmesg-005.txt (+787/-0)
t/pt-summary/samples/dmesg-007.txt (+136/-0)
t/pt-summary/samples/hpaculi-001.txt (+11/-0)
t/pt-summary/samples/hpaculi-002.txt (+354/-0)
t/pt-summary/samples/hpaculi-003.txt (+11/-0)
t/pt-summary/samples/ip-s-link-003.txt (+24/-0)
t/pt-summary/samples/lspci-005.txt (+38/-0)
t/pt-summary/samples/netstat-002.txt (+1328/-0)
t/pt-summary/samples/proc_cpuinfo001.txt (+57/-0)
t/pt-summary/samples/proc_cpuinfo001.txt.unq (+1/-0)
t/pt-summary/samples/proc_cpuinfo002.txt (+57/-0)
t/pt-summary/samples/proc_cpuinfo002.txt.unq (+1/-0)
t/pt-table-checksum/basics.t (+47/-24)
t/pt-table-checksum/bugs.t (+142/-0)
t/pt-table-checksum/char_chunking.t (+2/-1)
t/pt-table-checksum/chunk_index.t (+106/-0)
t/pt-table-checksum/chunk_size.t (+5/-4)
t/pt-table-checksum/create_replicate_table.t (+2/-2)
t/pt-table-checksum/error_handling.t (+2/-1)
t/pt-table-checksum/filters.t (+2/-2)
t/pt-table-checksum/float_precision.t (+2/-1)
t/pt-table-checksum/fnv_64.t (+2/-1)
t/pt-table-checksum/ignore_columns.t (+2/-3)
t/pt-table-checksum/issue_388.t (+3/-2)
t/pt-table-checksum/issue_47.t (+2/-1)
t/pt-table-checksum/issue_602.t (+2/-1)
t/pt-table-checksum/privs.t (+106/-0)
t/pt-table-checksum/progress.t (+52/-16)
t/pt-table-checksum/replication_filters.t (+82/-49)
t/pt-table-checksum/resume.t (+9/-7)
t/pt-table-checksum/samples/bad-plan-bug-1010232.sql (+17/-0)
t/pt-table-checksum/samples/default-results-5.0.txt (+4/-2)
t/pt-table-checksum/samples/default-results-5.1.txt (+3/-1)
t/pt-table-checksum/samples/default-results-5.5.txt (+41/-0)
t/pt-table-checksum/samples/dsn-table.sql (+15/-0)
t/pt-table-checksum/samples/empty-table-bug-987393.sql (+18/-0)
t/pt-table-checksum/samples/issue_602.sql (+18/-18)
t/pt-table-checksum/samples/n-chunk-index-cols.txt (+19/-0)
t/pt-table-checksum/samples/not-using-pk-bug.out (+20/-0)
t/pt-table-checksum/samples/not-using-pk-bug.sql (+20/-0)
t/pt-table-checksum/samples/static-chunk-size-results-5.0.txt (+4/-2)
t/pt-table-checksum/samples/static-chunk-size-results-5.1.txt (+3/-1)
t/pt-table-checksum/samples/static-chunk-size-results-5.5.txt (+41/-0)
t/pt-table-checksum/samples/undef-arrayref-bug-995274.sql (+18/-0)
t/pt-table-checksum/skip_innodb.t (+77/-0)
t/pt-table-checksum/standard_options.t (+2/-1)
t/pt-table-checksum/throttle.t (+34/-27)
t/pt-table-sync/basics.t (+10/-9)
t/pt-table-sync/bidirectional.t (+4/-3)
t/pt-table-sync/binlog_format.t (+26/-27)
t/pt-table-sync/bugs.t (+156/-0)
t/pt-table-sync/char_chunking.t (+2/-1)
t/pt-table-sync/check_privs.t (+2/-2)
t/pt-table-sync/columns.t (+2/-2)
t/pt-table-sync/filters.t (+210/-71)
t/pt-table-sync/float_precision.t (+2/-2)
t/pt-table-sync/force_index.t (+2/-2)
t/pt-table-sync/hex_blob.t (+2/-1)
t/pt-table-sync/instrumentaiton.t (+2/-1)
t/pt-table-sync/issue_1052.t (+2/-1)
t/pt-table-sync/issue_1065.t (+15/-7)
t/pt-table-sync/issue_218.t (+2/-1)
t/pt-table-sync/issue_22.t (+2/-1)
t/pt-table-sync/issue_262.t (+2/-1)
t/pt-table-sync/issue_408.t (+3/-2)
t/pt-table-sync/issue_560.t (+3/-7)
t/pt-table-sync/issue_616.t (+13/-9)
t/pt-table-sync/issue_627.t (+2/-1)
t/pt-table-sync/issue_631.t (+2/-1)
t/pt-table-sync/issue_634.t (+19/-8)
t/pt-table-sync/issue_644.t (+2/-1)
t/pt-table-sync/issue_79.t (+0/-85)
t/pt-table-sync/issue_804.t (+2/-4)
t/pt-table-sync/issue_920.t (+2/-1)
t/pt-table-sync/issue_96.t (+2/-1)
t/pt-table-sync/issue_965.t (+2/-1)
t/pt-table-sync/issue_996.t (+2/-1)
t/pt-table-sync/lock_and_rename.t (+10/-11)
t/pt-table-sync/lock_level.t (+2/-2)
t/pt-table-sync/master_master.t (+60/-23)
t/pt-table-sync/replicate_do_db.t (+108/-98)
t/pt-table-sync/samples/filter_tables.sql (+0/-13)
t/pt-table-sync/samples/issue_22.sql (+1/-1)
t/pt-table-sync/samples/issue_533.sql (+12/-8)
t/pt-table-sync/samples/wrong-tbl-struct-bug-1003014.sql (+35/-0)
t/pt-table-sync/specify_column_or_index.t (+2/-2)
t/pt-table-sync/sync_to_differnt_db.t (+2/-2)
t/pt-table-sync/traces.t (+28/-18)
t/pt-table-sync/triggers.t (+5/-17)
t/pt-table-sync/wait.t (+2/-1)
t/pt-table-sync/zero_chunk.t (+2/-1)
t/pt-table-usage/basics.t (+186/-0)
t/pt-table-usage/create_table_definitions.t (+41/-0)
t/pt-table-usage/explain_extended.t (+80/-0)
t/pt-table-usage/samples/ee.out (+6/-0)
t/pt-table-usage/samples/ee.sql (+26/-0)
t/pt-table-usage/samples/in/slow001.txt (+24/-0)
t/pt-table-usage/samples/in/slow002.txt (+20/-0)
t/pt-table-usage/samples/in/slow003.txt (+3/-0)
t/pt-table-usage/samples/out/create-table-defs-001.txt (+4/-0)
t/pt-table-usage/samples/out/create001.txt (+5/-0)
t/pt-table-usage/samples/out/drop-table-if-exists.txt (+3/-0)
t/pt-table-usage/samples/out/query001.txt (+6/-0)
t/pt-table-usage/samples/out/query002.txt (+5/-0)
t/pt-table-usage/samples/out/slow001.txt (+31/-0)
t/pt-table-usage/samples/out/slow002.txt (+40/-0)
t/pt-table-usage/samples/out/slow003-001.txt (+6/-0)
t/pt-table-usage/samples/out/slow003-002.txt (+8/-0)
t/pt-table-usage/samples/out/slow003-003.txt (+6/-0)
t/pt-upgrade/basics.t (+4/-3)
t/pt-upgrade/daemon.t (+3/-1)
t/pt-upgrade/rewrite_non_select.t (+16/-9)
t/pt-upgrade/samples/001/non-selects-rewritten.txt (+63/-57)
t/pt-upgrade/samples/001/non-selects.txt (+21/-19)
t/pt-upgrade/samples/001/select-everyone-no-stats.txt (+21/-19)
t/pt-upgrade/samples/001/select-everyone-rows.txt (+21/-19)
t/pt-upgrade/samples/001/select-everyone.txt (+21/-19)
t/pt-upgrade/samples/001/select-one-rows.txt (+21/-19)
t/pt-upgrade/samples/001/select-one.txt (+21/-19)
t/pt-upgrade/samples/002/report-01.txt (+24/-22)
t/pt-upgrade/samples/003/report001.txt (+24/-22)
t/pt-upgrade/skip_non_select.t (+3/-2)
t/pt-upgrade/warnings.t (+6/-5)
t/pt-variable-advisor/show_variables_online.t (+2/-1)
util/build-snapshot (+171/-0)
util/checksum-test-dataset (+65/-0)
util/diff-and-restart-sandbox (+27/-0)
util/kill-mysql-process (+44/-0)
util/make-barebones (+47/-0)
util/test-bash-functions (+71/-9)
util/update-modules (+4/-4)
Text conflict in Changelog
Text conflict in Makefile.PL
Text conflict in bin/pt-align
Text conflict in bin/pt-archiver
Text conflict in bin/pt-config-diff
Text conflict in bin/pt-deadlock-logger
Text conflict in bin/pt-diskstats
Text conflict in bin/pt-duplicate-key-checker
Text conflict in bin/pt-fifo-split
Text conflict in bin/pt-find
Text conflict in bin/pt-fk-error-logger
Text conflict in bin/pt-heartbeat
Text conflict in bin/pt-index-usage
Text conflict in bin/pt-ioprofile
Text conflict in bin/pt-kill
Text conflict in bin/pt-log-player
Text conflict in bin/pt-mext
Text conflict in bin/pt-mysql-summary
Text conflict in bin/pt-online-schema-change
Text conflict in bin/pt-pmp
Text conflict in bin/pt-query-advisor
Text conflict in bin/pt-query-digest
Text conflict in bin/pt-show-grants
Text conflict in bin/pt-sift
Text conflict in bin/pt-slave-delay
Text conflict in bin/pt-slave-find
Text conflict in bin/pt-slave-restart
Text conflict in bin/pt-stalk
Text conflict in bin/pt-summary
Text conflict in bin/pt-table-checksum
Text conflict in bin/pt-table-sync
Text conflict in bin/pt-tcp-model
Text conflict in bin/pt-trend
Text conflict in bin/pt-upgrade
Text conflict in bin/pt-variable-advisor
Text conflict in bin/pt-visual-explain
Text conflict in config/deb/changelog
Text conflict in config/sphinx-build/conf.py
Text conflict in docs/percona-toolkit.pod
Text conflict in docs/release_notes.rst
Text conflict in lib/Cxn.pm
Text conflict in lib/NibbleIterator.pm
Text conflict in lib/bash/tmpdir.sh
Text conflict in sandbox/start-sandbox
Text conflict in t/lib/DSNParser.t
Text conflict in t/lib/NibbleIterator.t
Text conflict in t/lib/OobNibbleIterator.t
Text conflict in t/lib/Processlist.t
Text conflict in t/lib/SchemaIterator.t
Text conflict in t/lib/TableChunker.t
Text conflict in t/lib/samples/SchemaIterator/all-dbs-tbls-5.0.txt
Text conflict in t/lib/samples/SchemaIterator/all-dbs-tbls-5.1.txt
Conflict adding file t/lib/samples/SchemaIterator/resume-from-ignored-sakila-payment-5.0.txt.  Moved existing file to t/lib/samples/SchemaIterator/resume-from-ignored-sakila-payment-5.0.txt.moved.
Conflict adding file t/lib/samples/SchemaIterator/resume-from-sakila-payment-5.0.txt.  Moved existing file to t/lib/samples/SchemaIterator/resume-from-sakila-payment-5.0.txt.moved.
Text conflict in t/pt-archiver/basics.t
Text conflict in t/pt-archiver/file.t
Conflict adding file t/pt-deadlock-logger/bugs.t.  Moved existing file to t/pt-deadlock-logger/bugs.t.moved.
Conflict adding file t/pt-deadlock-logger/samples.  Moved existing file to t/pt-deadlock-logger/samples.moved.
Text conflict in t/pt-duplicate-key-checker/basics.t
Text conflict in t/pt-duplicate-key-checker/samples/bug-894140.txt
Text conflict in t/pt-query-digest/read_timeout.t
Text conflict in t/pt-stalk/pt-stalk.t
Conflict adding file t/pt-table-checksum/bugs.t.  Moved existing file to t/pt-table-checksum/bugs.t.moved.
Text conflict in t/pt-table-checksum/chunk_index.t
Conflict adding file t/pt-table-checksum/samples/empty-table-bug-987393.sql.  Moved existing file to t/pt-table-checksum/samples/empty-table-bug-987393.sql.moved.
Conflict adding file t/pt-table-checksum/samples/not-using-pk-bug.out.  Moved existing file to t/pt-table-checksum/samples/not-using-pk-bug.out.moved.
Conflict adding file t/pt-table-checksum/samples/not-using-pk-bug.sql.  Moved existing file to t/pt-table-checksum/samples/not-using-pk-bug.sql.moved.
Conflict adding file t/pt-table-checksum/samples/undef-arrayref-bug-995274.sql.  Moved existing file to t/pt-table-checksum/samples/undef-arrayref-bug-995274.sql.moved.
Text conflict in t/pt-table-checksum/skip_innodb.t
Conflict adding file t/pt-table-sync/bugs.t.  Moved existing file to t/pt-table-sync/bugs.t.moved.
Text conflict in t/pt-table-sync/filters.t
Conflict adding file t/pt-table-sync/samples/wrong-tbl-struct-bug-1003014.sql.  Moved existing file to t/pt-table-sync/samples/wrong-tbl-struct-bug-1003014.sql.moved.
To merge this branch: bzr merge lp:~percona-toolkit-dev/percona-toolkit/fix-pt-heartbeat-dupe-key-bug-1004567
Reviewer Review Type Date Requested Status
Daniel Nichter Approve
Review via email: mp+116084@code.launchpad.net
To post a comment you must log in.
Revision history for this message
Daniel Nichter (daniel-nichter) :
review: Approve

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
=== modified file '.bzrignore'
--- .bzrignore 2011-12-30 00:39:26 +0000
+++ .bzrignore 2012-07-20 22:10:28 +0000
@@ -4,5 +4,6 @@
4docs/test-coverage/db4docs/test-coverage/db
5docs/test-coverage/html5docs/test-coverage/html
6release6release
7snapshot
7.DS_Store8.DS_Store
8build9build
910
=== modified file 'Changelog'
--- Changelog 2012-06-09 21:53:04 +0000
+++ Changelog 2012-07-20 22:10:28 +0000
@@ -1,5 +1,6 @@
1Changelog for Percona Toolkit1Changelog for Percona Toolkit
22
3<<<<<<< TREE
3v2.0.5 released 2012-06-094v2.0.5 released 2012-06-09
45
5 * Fixed bug 1002365: pt-table-sync --ignore-* options don't work with --replicate6 * Fixed bug 1002365: pt-table-sync --ignore-* options don't work with --replicate
@@ -30,6 +31,96 @@
30 * Fixed bug 953461: pt-upgrade manual broken 'output' section31 * Fixed bug 953461: pt-upgrade manual broken 'output' section
31 * Fixed bug 949653: pt-table-checksum docs don't mention risks posed by inconsistent schemas32 * Fixed bug 949653: pt-table-checksum docs don't mention risks posed by inconsistent schemas
3233
34=======
35v2.1.2 released 2012-06-12
36
37 * pt-heartbeat: Implemented --recursion-method=none
38 * pt-index-usage: MySQL 5.5 compatibility fixes
39 * pt-log-player: MySQL 5.5 compatibility fixes
40 * pt-online-schema-change: Added --chunk-index-columns
41 * pt-online-schema-change: Added --[no]check-plan
42 * pt-online-schema-change: Added --[no]drop-new-table
43 * pt-online-schema-change: Implemented --recursion-method=none
44 * pt-query-advisor: Added --report-type for JSON output
45 * pt-query-digest: Removed --[no]zero-bool
46 * pt-slave-delay: Added --database
47 * pt-slave-find: Implemented --recursion-method=none
48 * pt-slave-restart: Implemented --recursion-method=none
49 * pt-table-checksum: Added --chunk-index-columns
50 * pt-table-checksum: Added --[no]check-plan
51 * pt-table-checksum: Implemented --recursion-method=none
52 * pt-table-sync: Disabled --lock-and-rename except for MySQL 5.5 and newer
53 * pt-table-sync: Implemented --recursion-method=none
54 * Fixed bug 945079: Shell tools TMPDIR may break
55 * Fixed bug 912902: Some shell tools still use basename
56 * Fixed bug 987694: There is no --recursion-method=none option
57 * Fixed bug 886077: Passwords with commas don't work, expose part of password
58 * Fixed bug 856024: Lintian warnings when building percona-toolkit Debian package
59 * Fixed bug 903379: pt-archiver --file doesn't create a file
60 * Fixed bug 979092: pt-archiver --sleep conflicts with bulk operations
61 * Fixed bug 903443: pt-deadlock-logger crashes on MySQL 5.5
62 * Fixed bug 941064: pt-deadlock-logger can't clear deadlocks on 5.5
63 * Fixed bug 952727: pt-diskstats shows incorrect wr_mb_s
64 * Fixed bug 994176: pt-diskstats --group-by=all --headers=scroll prints a header for every sample
65 * Fixed bug 894140: pt-duplicate-key-checker sometimes recreates a key it shouldn't
66 * Fixed bug 923896: pt-kill: uninitialized value causes script to exit
67 * Fixed bug 1003003: pt-online-schema-change uses different keys for chunking and triggers
68 * Fixed bug 1003315: pt-online-schema-change --dry-run always fails on table with foreign keys
69 * Fixed bug 1004551: pt-online-schema-change --no-swap-tables causes error
70 * Fixed bug 976108: pt-online-schema-change doesn't allow to disable foreign key checks
71 * Fixed bug 976109: pt-online-schema-change doesn't handle column renames
72 * Fixed bug 988036: pt-online-schema-change causes deadlocks under heavy write load
73 * Fixed bug 989227: pt-online-schema-change crashes with PTDEBUG
74 * Fixed bug 994002: pt-online-schema-change 2.1.1 doesn't choose the PRIMARY KEY
75 * Fixed bug 994010: pt-online-schema-change 2.1.1 crashes without InnoDB
76 * Fixed bug 996915: pt-online-schema-change crashes with invalid --max-load and --critical-load
77 * Fixed bug 998831: pt-online-schema-change -- Should have an option to NOT drop tables on failure
78 * Fixed bug 1002448: pt-online-schema-change: typo for finding usable indexes
79 * Fixed bug 885382: pt-query-digest --embedded-attributes doesn't check cardinality
80 * Fixed bug 888114: pt-query-digest report crashes with infinite loop
81 * Fixed bug 949630: pt-query-digest mentions a Subversion repository
82 * Fixed bug 844034: pt-show-grants --separate fails with proxy user
83 * Fixed bug 946707: pt-sift loses STDIN after pt-diskstats
84 * Fixed bug 994947: pt-stalk doesn't reset cycles_true after collection
85 * Fixed bug 986151: pt-stalk-has mktemp error
86 * Fixed bug 993436: pt-summary Memory: Total reports M instead of G
87 * Fixed bug 1008778: pt-table-checksum doesn't wait for checksum table to replicate
88 * Fixed bug 1010232: pt-table-checksum doesn't check the size of checksum chunks
89 * Fixed bug 1011738: pt-table-checksum SKIPPED is zero but chunks were skipped
90 * Fixed bug 919499: pt-table-checksum fails with binary log error in mysql >= 5.5.18
91 * Fixed bug 972399: pt-table-checksum docs are not rendered right
92 * Fixed bug 978432: pt-table-checksum ignoring primary key
93 * Fixed bug 995274: pt-table-checksum can't use an undefined value as an ARRAY reference at line 2206
94 * Fixed bug 996110: pt-table-checksum crashes if InnoDB is disabled
95 * Fixed bug 987393: pt-table-checksum: Empy tables cause "undefined value as an ARRAY" errors
96 * Fixed bug 997155: pt-table-sync sets binlog_format needlessly
97 * Fixed bug 1002365: pt-table-sync --ignore-* options don't work with --replicate
98 * Fixed bug 1003014: pt-table-sync --replicate and --sync-to-master error "index does not exist"
99 * Fixed bug 823403: pt-table-sync --lock-and-rename doesn't work on 5.1
100 * Fixed bug 898138: pt-variable-advisor doesn't recognize 5.5.3+ concurrent_insert values
101
102v2.1.1 released 2012-04-03
103
104 * Completely redesigned pt-online-schema-change
105 * Completely redesigned pt-mysql-summary
106 * Completely redesigned pt-summary
107 * Added new tool: pt-table-usage
108 * Added new tool: pt-fingerprint
109 * Fixed bug 955860: pt-stalk doesn't run vmstat, iostat, and mpstat for --run-time
110 * Fixed bug 960513: SHOW TABLE STATUS is used needlessly
111 * Fixed bug 969726: pt-online-schema-change loses foreign keys
112 * Fixed bug 846028: pt-online-schema-change does not show progress until completed
113 * Fixed bug 898695: pt-online-schema-change add useless ORDER BY
114 * Fixed bug 952727: pt-diskstats shows incorrect wr_mb_s
115 * Fixed bug 963225: pt-query-digest fails to set history columns for disk tmp tables and disk filesort
116 * Fixed bug 967451: Char chunking doesn't quote column name
117 * Fixed bug 972399: pt-table-checksum docs are not rendered right
118 * Fixed bug 896553: Various documentation spelling fixes
119 * Fixed bug 949154: pt-variable-advisor advice for relay-log-space-limit
120 * Fixed bug 953461: pt-upgrade manual broken 'output' section
121 * Fixed bug 949653: pt-table-checksum docs don't mention risks posed by inconsistent schemas
122
123>>>>>>> MERGE-SOURCE
33v2.0.4 released 2012-03-07124v2.0.4 released 2012-03-07
34125
35 * Added --filter to pt-kill to allow arbitrary --group-by126 * Added --filter to pt-kill to allow arbitrary --group-by
36127
=== modified file 'MANIFEST'
--- MANIFEST 2012-02-03 23:25:29 +0000
+++ MANIFEST 2012-07-20 22:10:28 +0000
@@ -12,6 +12,7 @@
12bin/pt-duplicate-key-checker12bin/pt-duplicate-key-checker
13bin/pt-fifo-split13bin/pt-fifo-split
14bin/pt-find14bin/pt-find
15bin/pt-fingerprint
15bin/pt-fk-error-logger16bin/pt-fk-error-logger
16bin/pt-heartbeat17bin/pt-heartbeat
17bin/pt-index-usage18bin/pt-index-usage
@@ -33,6 +34,7 @@
33bin/pt-summary34bin/pt-summary
34bin/pt-table-checksum35bin/pt-table-checksum
35bin/pt-table-sync36bin/pt-table-sync
37bin/pt-table-usage
36bin/pt-tcp-model38bin/pt-tcp-model
37bin/pt-trend39bin/pt-trend
38bin/pt-upgrade40bin/pt-upgrade
3941
=== modified file 'Makefile.PL'
--- Makefile.PL 2012-06-09 21:53:04 +0000
+++ Makefile.PL 2012-07-20 22:10:28 +0000
@@ -2,13 +2,17 @@
22
3WriteMakefile(3WriteMakefile(
4 NAME => 'percona-toolkit',4 NAME => 'percona-toolkit',
5<<<<<<< TREE
5 VERSION => '2.0.5',6 VERSION => '2.0.5',
7=======
8 VERSION => '2.1.2',
9>>>>>>> MERGE-SOURCE
6 EXE_FILES => [ <bin/*> ],10 EXE_FILES => [ <bin/*> ],
7 MAN1PODS => {11 MAN1PODS => {
8 'docs/percona-toolkit.pod' => 'blib/man1/percona-toolkit.1',12 'docs/percona-toolkit.pod' => 'blib/man1/percona-toolkit.1p',
9 map {13 map {
10 (my $name = $_) =~ s/^bin.//;14 (my $name = $_) =~ s/^bin.//;
11 $_ => "blib/man1/$name.1";15 $_ => "blib/man1/$name.1p";
12 } <bin/*>16 } <bin/*>
13 },17 },
14 MAN3PODS => {}, # man(3) pages are for C libs18 MAN3PODS => {}, # man(3) pages are for C libs
1519
=== modified file 'bin/pt-align'
--- bin/pt-align 2012-06-09 21:53:04 +0000
+++ bin/pt-align 2012-07-20 22:10:28 +0000
@@ -218,6 +218,10 @@
218218
219=head1 VERSION219=head1 VERSION
220220
221<<<<<<< TREE
221pt-align 2.0.5222pt-align 2.0.5
223=======
224pt-align 2.1.2
225>>>>>>> MERGE-SOURCE
222226
223=cut227=cut
224228
=== modified file 'bin/pt-archiver'
--- bin/pt-archiver 2012-06-09 21:53:04 +0000
+++ bin/pt-archiver 2012-07-20 22:10:28 +0000
@@ -959,7 +959,7 @@
959 $opt->{value} = ($pre || '') . $num;959 $opt->{value} = ($pre || '') . $num;
960 }960 }
961 else {961 else {
962 $self->save_error("Invalid size for --$opt->{long}");962 $self->save_error("Invalid size for --$opt->{long}: $val");
963 }963 }
964 return;964 return;
965}965}
@@ -1034,6 +1034,456 @@
1034# ###########################################################################1034# ###########################################################################
10351035
1036# ###########################################################################1036# ###########################################################################
1037# Mo package
1038# This package is a copy without comments from the original. The original
1039# with comments and its test file can be found in the Bazaar repository at,
1040# lib/Mo.pm
1041# t/lib/Mo.t
1042# See https://launchpad.net/percona-toolkit for more information.
1043# ###########################################################################
1044{
1045BEGIN {
1046$INC{"Mo.pm"} = __FILE__;
1047package Mo;
1048our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo.
1049
1050{
1051 no strict 'refs';
1052 sub _glob_for {
1053 return \*{shift()}
1054 }
1055
1056 sub _stash_for {
1057 return \%{ shift() . "::" };
1058 }
1059}
1060
1061use strict;
1062use warnings qw( FATAL all );
1063
1064use Carp ();
1065use Scalar::Util ();
1066
1067our %TYPES = (
1068 Bool => sub { !$_[0] || (defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == 1) },
1069 Num => sub { defined $_[0] && &Scalar::Util::looks_like_number },
1070 Int => sub { defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == int $_[0] },
1071 Str => sub { defined $_[0] },
1072 Object => sub { defined $_[0] && &Scalar::Util::blessed },
1073 FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened },
1074
1075 map {
1076 my $type = /R/ ? $_ : uc $_;
1077 $_ . "Ref" => sub { ref $_[0] eq $type }
1078 } qw(Array Code Hash Regexp Glob Scalar)
1079);
1080
1081our %metadata_for;
1082{
1083 package Mo::Object;
1084
1085 sub new {
1086 my $class = shift;
1087 my $args = $class->BUILDARGS(@_);
1088
1089 my @args_to_delete;
1090 while ( my ($attr, $meta) = each %{$metadata_for{$class}} ) {
1091 next unless exists $meta->{init_arg};
1092 my $init_arg = $meta->{init_arg};
1093
1094 if ( defined $init_arg ) {
1095 $args->{$attr} = delete $args->{$init_arg};
1096 }
1097 else {
1098 push @args_to_delete, $attr;
1099 }
1100 }
1101
1102 delete $args->{$_} for @args_to_delete;
1103
1104 for my $attribute ( keys %$args ) {
1105 if ( my $coerce = $metadata_for{$class}{$attribute}{coerce} ) {
1106 $args->{$attribute} = $coerce->($args->{$attribute});
1107 }
1108 if ( my $I = $metadata_for{$class}{$attribute}{isa} ) {
1109 ( (my $I_name), $I ) = @{$I};
1110 Mo::_check_type_constaints($attribute, $I, $I_name, $args->{$attribute});
1111 }
1112 }
1113
1114 while ( my ($attribute, $meta) = each %{$metadata_for{$class}} ) {
1115 next unless $meta->{required};
1116 Carp::confess("Attribute ($attribute) is required for $class")
1117 if ! exists $args->{$attribute}
1118 }
1119
1120 @_ = %$args;
1121 my $self = bless $args, $class;
1122
1123 my @build_subs;
1124 my $linearized_isa = mro::get_linear_isa($class);
1125
1126 for my $isa_class ( @$linearized_isa ) {
1127 unshift @build_subs, *{ Mo::_glob_for "${isa_class}::BUILD" }{CODE};
1128 }
1129 exists &$_ && $_->( $self, @_ ) for grep { defined } @build_subs;
1130 return $self;
1131 }
1132
1133 sub BUILDARGS {
1134 shift;
1135 my $ref;
1136 if ( @_ == 1 && ref($_[0]) ) {
1137 Carp::confess("Single parameters to new() must be a HASH ref")
1138 unless ref($_[0]) eq ref({});
1139 $ref = {%{$_[0]}} # We want a new reference, always
1140 }
1141 else {
1142 $ref = { @_ };
1143 }
1144 return $ref;
1145 }
1146}
1147
1148my %export_for;
1149sub Mo::import {
1150 warnings->import(qw(FATAL all));
1151 strict->import();
1152
1153 my $caller = scalar caller(); # Caller's package
1154 my $caller_pkg = $caller . "::"; # Caller's package with :: at the end
1155 my (%exports, %options);
1156
1157 my (undef, @features) = @_;
1158 my %ignore = ( map { $_ => 1 } qw( is isa init_arg builder buildargs clearer predicate build handles default required ) );
1159 for my $feature (grep { !$ignore{$_} } @features) {
1160 { local $@; require "Mo/$feature.pm"; }
1161 {
1162 no strict 'refs';
1163 &{"Mo::${feature}::e"}(
1164 $caller_pkg,
1165 \%exports,
1166 \%options,
1167 \@_
1168 );
1169 }
1170 }
1171
1172 return if $exports{M};
1173
1174 %exports = (
1175 extends => sub {
1176 for my $class ( map { "$_" } @_ ) {
1177 $class =~ s{::|'}{/}g;
1178 { local $@; eval { require "$class.pm" } } # or warn $@;
1179 }
1180 _set_package_isa($caller, @_);
1181 _set_inherited_metadata($caller);
1182 },
1183 has => sub {
1184 my $names = shift;
1185 for my $attribute ( ref $names ? @$names : $names ) {
1186 my %args = @_;
1187 my $method = ($args{is} || '') eq 'ro'
1188 ? sub {
1189 Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller_pkg}${attribute}")
1190 if $#_;
1191 return $_[0]{$attribute};
1192 }
1193 : sub {
1194 return $#_
1195 ? $_[0]{$attribute} = $_[1]
1196 : $_[0]{$attribute};
1197 };
1198
1199 $metadata_for{$caller}{$attribute} = ();
1200
1201 if ( my $I = $args{isa} ) {
1202 my $orig_I = $I;
1203 my $type;
1204 if ( $I =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
1205 $I = _nested_constraints($attribute, $1, $2);
1206 }
1207 $metadata_for{$caller}{$attribute}{isa} = [$orig_I, $I];
1208 my $orig_method = $method;
1209 $method = sub {
1210 if ( $#_ ) {
1211 Mo::_check_type_constaints($attribute, $I, $orig_I, $_[1]);
1212 }
1213 goto &$orig_method;
1214 };
1215 }
1216
1217 if ( my $builder = $args{builder} ) {
1218 my $original_method = $method;
1219 $method = sub {
1220 $#_
1221 ? goto &$original_method
1222 : ! exists $_[0]{$attribute}
1223 ? $_[0]{$attribute} = $_[0]->$builder
1224 : goto &$original_method
1225 };
1226 }
1227
1228 if ( my $code = $args{default} ) {
1229 Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef")
1230 unless ref($code) eq 'CODE';
1231 my $original_method = $method;
1232 $method = sub {
1233 $#_
1234 ? goto &$original_method
1235 : ! exists $_[0]{$attribute}
1236 ? $_[0]{$attribute} = $_[0]->$code
1237 : goto &$original_method
1238 };
1239 }
1240
1241 if ( my $role = $args{does} ) {
1242 my $original_method = $method;
1243 $method = sub {
1244 if ( $#_ ) {
1245 Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">)
1246 unless blessed($_[1]) && $_[1]->does($role)
1247 }
1248 goto &$original_method
1249 };
1250 }
1251
1252 if ( my $coercion = $args{coerce} ) {
1253 $metadata_for{$caller}{$attribute}{coerce} = $coercion;
1254 my $original_method = $method;
1255 $method = sub {
1256 if ( $#_ ) {
1257 return $original_method->($_[0], $coercion->($_[1]))
1258 }
1259 goto &$original_method;
1260 }
1261 }
1262
1263 $method = $options{$_}->($method, $attribute, @_)
1264 for sort keys %options;
1265
1266 *{ _glob_for "${caller}::$attribute" } = $method;
1267
1268 if ( $args{required} ) {
1269 $metadata_for{$caller}{$attribute}{required} = 1;
1270 }
1271
1272 if ($args{clearer}) {
1273 *{ _glob_for "${caller}::$args{clearer}" }
1274 = sub { delete shift->{$attribute} }
1275 }
1276
1277 if ($args{predicate}) {
1278 *{ _glob_for "${caller}::$args{predicate}" }
1279 = sub { exists shift->{$attribute} }
1280 }
1281
1282 if ($args{handles}) {
1283 _has_handles($caller, $attribute, \%args);
1284 }
1285
1286 if (exists $args{init_arg}) {
1287 $metadata_for{$caller}{$attribute}{init_arg} = $args{init_arg};
1288 }
1289 }
1290 },
1291 %exports,
1292 );
1293
1294 $export_for{$caller} = [ keys %exports ];
1295
1296 for my $keyword ( keys %exports ) {
1297 *{ _glob_for "${caller}::$keyword" } = $exports{$keyword}
1298 }
1299 *{ _glob_for "${caller}::extends" }{CODE}->( "Mo::Object" )
1300 unless @{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] };
1301};
1302
1303sub _check_type_constaints {
1304 my ($attribute, $I, $I_name, $val) = @_;
1305 ( ref($I) eq 'CODE'
1306 ? $I->($val)
1307 : (ref $val eq $I
1308 || ($val && $val eq $I)
1309 || (exists $TYPES{$I} && $TYPES{$I}->($val)))
1310 )
1311 || Carp::confess(
1312 qq<Attribute ($attribute) does not pass the type constraint because: >
1313 . qq<Validation failed for '$I_name' with value >
1314 . (defined $val ? Mo::Dumper($val) : 'undef') )
1315}
1316
1317sub _has_handles {
1318 my ($caller, $attribute, $args) = @_;
1319 my $handles = $args->{handles};
1320
1321 my $ref = ref $handles;
1322 my $kv;
1323 if ( $ref eq ref [] ) {
1324 $kv = { map { $_,$_ } @{$handles} };
1325 }
1326 elsif ( $ref eq ref {} ) {
1327 $kv = $handles;
1328 }
1329 elsif ( $ref eq ref qr// ) {
1330 Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)")
1331 unless $args->{isa};
1332 my $target_class = $args->{isa};
1333 $kv = {
1334 map { $_, $_ }
1335 grep { $_ =~ $handles }
1336 grep { !exists $Mo::Object::{$_} && $target_class->can($_) }
1337 grep { $_ ne 'has' && $_ ne 'extends' }
1338 keys %{ _stash_for $target_class }
1339 };
1340 }
1341 else {
1342 Carp::confess("handles for $ref not yet implemented");
1343 }
1344
1345 while ( my ($method, $target) = each %{$kv} ) {
1346 my $name = _glob_for "${caller}::$method";
1347 Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation")
1348 if defined &$name;
1349
1350 my ($target, @curried_args) = ref($target) ? @$target : $target;
1351 *$name = sub {
1352 my $self = shift;
1353 my $delegate_to = $self->$attribute();
1354 my $error = "Cannot delegate $method to $target because the value of $attribute";
1355 Carp::confess("$error is not defined") unless $delegate_to;
1356 Carp::confess("$error is not an object (got '$delegate_to')")
1357 unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target));
1358 return $delegate_to->$target(@curried_args, @_);
1359 }
1360 }
1361}
1362
1363sub _nested_constraints {
1364 my ($attribute, $aggregate_type, $type) = @_;
1365
1366 my $inner_types;
1367 if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
1368 $inner_types = _nested_constraints($1, $2);
1369 }
1370 else {
1371 $inner_types = $TYPES{$type};
1372 }
1373
1374 if ( $aggregate_type eq 'ArrayRef' ) {
1375 return sub {
1376 my ($val) = @_;
1377 return unless ref($val) eq ref([]);
1378
1379 if ($inner_types) {
1380 for my $value ( @{$val} ) {
1381 return unless $inner_types->($value)
1382 }
1383 }
1384 else {
1385 for my $value ( @{$val} ) {
1386 return unless $value && ($value eq $type
1387 || (Scalar::Util::blessed($value) && $value->isa($type)));
1388 }
1389 }
1390 return 1;
1391 };
1392 }
1393 elsif ( $aggregate_type eq 'Maybe' ) {
1394 return sub {
1395 my ($value) = @_;
1396 return 1 if ! defined($value);
1397 if ($inner_types) {
1398 return unless $inner_types->($value)
1399 }
1400 else {
1401 return unless $value eq $type
1402 || (Scalar::Util::blessed($value) && $value->isa($type));
1403 }
1404 return 1;
1405 }
1406 }
1407 else {
1408 Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe");
1409 }
1410}
1411
1412sub _set_package_isa {
1413 my ($package, @new_isa) = @_;
1414
1415 *{ _glob_for "${package}::ISA" } = [@new_isa];
1416}
1417
1418sub _set_inherited_metadata {
1419 my $class = shift;
1420 my $linearized_isa = mro::get_linear_isa($class);
1421 my %new_metadata;
1422
1423 for my $isa_class (reverse @$linearized_isa) {
1424 %new_metadata = (
1425 %new_metadata,
1426 %{ $metadata_for{$isa_class} || {} },
1427 );
1428 }
1429 $metadata_for{$class} = \%new_metadata;
1430}
1431
1432sub unimport {
1433 my $caller = scalar caller();
1434 my $stash = _stash_for( $caller );
1435
1436 delete $stash->{$_} for @{$export_for{$caller}};
1437}
1438
1439sub Dumper {
1440 require Data::Dumper;
1441 local $Data::Dumper::Indent = 0;
1442 local $Data::Dumper::Sortkeys = 0;
1443 local $Data::Dumper::Quotekeys = 0;
1444 local $Data::Dumper::Terse = 1;
1445
1446 Data::Dumper::Dumper(@_)
1447}
1448
1449BEGIN {
1450 if ($] >= 5.010) {
1451 { local $@; require mro; }
1452 }
1453 else {
1454 local $@;
1455 eval {
1456 require MRO::Compat;
1457 } or do {
1458 *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub {
1459 no strict 'refs';
1460
1461 my $classname = shift;
1462
1463 my @lin = ($classname);
1464 my %stored;
1465 foreach my $parent (@{"$classname\::ISA"}) {
1466 my $plin = mro::get_linear_isa_dfs($parent);
1467 foreach (@$plin) {
1468 next if exists $stored{$_};
1469 push(@lin, $_);
1470 $stored{$_} = 1;
1471 }
1472 }
1473 return \@lin;
1474 };
1475 }
1476 }
1477}
1478
1479}
14801;
1481}
1482# ###########################################################################
1483# End Mo package
1484# ###########################################################################
1485
1486# ###########################################################################
1037# TableParser package1487# TableParser package
1038# This package is a copy without comments from the original. The original1488# This package is a copy without comments from the original. The original
1039# with comments and its test file can be found in the Bazaar repository at,1489# with comments and its test file can be found in the Bazaar repository at,
@@ -1064,23 +1514,64 @@
1064 return bless $self, $class;1514 return bless $self, $class;
1065}1515}
10661516
1517sub get_create_table {
1518 my ( $self, $dbh, $db, $tbl ) = @_;
1519 die "I need a dbh parameter" unless $dbh;
1520 die "I need a db parameter" unless $db;
1521 die "I need a tbl parameter" unless $tbl;
1522 my $q = $self->{Quoter};
1523
1524 my $new_sql_mode
1525 = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
1526 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
1527 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
1528 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
1529
1530 my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
1531 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
1532
1533 PTDEBUG && _d($new_sql_mode);
1534 eval { $dbh->do($new_sql_mode); };
1535 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
1536
1537 my $use_sql = 'USE ' . $q->quote($db);
1538 PTDEBUG && _d($dbh, $use_sql);
1539 $dbh->do($use_sql);
1540
1541 my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl);
1542 PTDEBUG && _d($show_sql);
1543 my $href;
1544 eval { $href = $dbh->selectrow_hashref($show_sql); };
1545 if ( $EVAL_ERROR ) {
1546 PTDEBUG && _d($EVAL_ERROR);
1547
1548 PTDEBUG && _d($old_sql_mode);
1549 $dbh->do($old_sql_mode);
1550
1551 return;
1552 }
1553
1554 PTDEBUG && _d($old_sql_mode);
1555 $dbh->do($old_sql_mode);
1556
1557 my ($key) = grep { m/create (?:table|view)/i } keys %$href;
1558 if ( !$key ) {
1559 die "Error: no 'Create Table' or 'Create View' in result set from "
1560 . "$show_sql: " . Dumper($href);
1561 }
1562
1563 return $href->{$key};
1564}
1565
1067sub parse {1566sub parse {
1068 my ( $self, $ddl, $opts ) = @_;1567 my ( $self, $ddl, $opts ) = @_;
1069 return unless $ddl;1568 return unless $ddl;
1070 if ( ref $ddl eq 'ARRAY' ) {1569
1071 if ( lc $ddl->[0] eq 'table' ) {1570 if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) {
1072 $ddl = $ddl->[1];1571 $ddl = $self->ansi_to_legacy($ddl);
1073 }
1074 else {
1075 return {
1076 engine => 'VIEW',
1077 };
1078 }
1079 }1572 }
10801573 elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {
1081 if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {1574 die "TableParser doesn't handle CREATE TABLE without quoting.";
1082 die "Cannot parse table definition; is ANSI quoting "
1083 . "enabled or SQL_QUOTE_SHOW_CREATE disabled?";
1084 }1575 }
10851576
1086 my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;1577 my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;
@@ -1289,19 +1780,13 @@
1289 my $key_ddl = $key;1780 my $key_ddl = $key;
1290 PTDEBUG && _d('Parsed key:', $key_ddl);1781 PTDEBUG && _d('Parsed key:', $key_ddl);
12911782
1292 if ( $engine !~ m/MEMORY|HEAP/ ) {1783 if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) {
1293 $key =~ s/USING HASH/USING BTREE/;1784 $key =~ s/USING HASH/USING BTREE/;
1294 }1785 }
12951786
1296 my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;1787 my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;
1297 my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;1788 my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;
1298 $type = $type || $special || 'BTREE';1789 $type = $type || $special || 'BTREE';
1299 if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000'
1300 && $engine =~ m/HEAP|MEMORY/i )
1301 {
1302 $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP
1303 }
1304
1305 my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;1790 my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;
1306 my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;1791 my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;
1307 my @cols;1792 my @cols;
@@ -1327,7 +1812,7 @@
1327 ddl => $key_ddl,1812 ddl => $key_ddl,
1328 };1813 };
13291814
1330 if ( $engine =~ m/InnoDB/i && !$clustered_key ) {1815 if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) {
1331 my $this_key = $keys->{$name};1816 my $this_key = $keys->{$name};
1332 if ( $this_key->{name} eq 'PRIMARY' ) {1817 if ( $this_key->{name} eq 'PRIMARY' ) {
1333 $clustered_key = 'PRIMARY';1818 $clustered_key = 'PRIMARY';
@@ -1383,41 +1868,46 @@
1383 return $ddl;1868 return $ddl;
1384}1869}
13851870
1386sub remove_secondary_indexes {1871sub get_table_status {
1387 my ( $self, $ddl ) = @_;1872 my ( $self, $dbh, $db, $like ) = @_;
1388 my $sec_indexes_ddl;1873 my $q = $self->{Quoter};
1389 my $tbl_struct = $self->parse($ddl);1874 my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db);
13901875 my @params;
1391 if ( ($tbl_struct->{engine} || '') =~ m/InnoDB/i ) {1876 if ( $like ) {
1392 my $clustered_key = $tbl_struct->{clustered_key};1877 $sql .= ' LIKE ?';
1393 $clustered_key ||= '';1878 push @params, $like;
13941879 }
1395 my @sec_indexes = map {1880 PTDEBUG && _d($sql, @params);
1396 my $key_def = $_->{ddl};1881 my $sth = $dbh->prepare($sql);
1397 $key_def =~ s/([\(\)])/\\$1/g;1882 eval { $sth->execute(@params); };
1398 $ddl =~ s/\s+$key_def//i;1883 if ($EVAL_ERROR) {
13991884 PTDEBUG && _d($EVAL_ERROR);
1400 my $key_ddl = "ADD $_->{ddl}";1885 return;
1401 $key_ddl .= ',' unless $key_ddl =~ m/,$/;1886 }
1402 $key_ddl;1887 my @tables = @{$sth->fetchall_arrayref({})};
1403 }1888 @tables = map {
1404 grep { $_->{name} ne $clustered_key }1889 my %tbl; # Make a copy with lowercased keys
1405 values %{$tbl_struct->{keys}};1890 @tbl{ map { lc $_ } keys %$_ } = values %$_;
1406 PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes));1891 $tbl{engine} ||= $tbl{type} || $tbl{comment};
14071892 delete $tbl{type};
1408 if ( @sec_indexes ) {1893 \%tbl;
1409 $sec_indexes_ddl = join(' ', @sec_indexes);1894 } @tables;
1410 $sec_indexes_ddl =~ s/,$//;1895 return @tables;
1411 }1896}
14121897
1413 $ddl =~ s/,(\n\) )/$1/s;1898my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx;
1414 }1899sub ansi_to_legacy {
1415 else {1900 my ($self, $ddl) = @_;
1416 PTDEBUG && _d('Not removing secondary indexes from',1901 $ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge;
1417 $tbl_struct->{engine}, 'table');1902 return $ddl;
1418 }1903}
14191904
1420 return $ddl, $sec_indexes_ddl, $tbl_struct;1905sub ansi_quote_replace {
1906 my ($val) = @_;
1907 $val =~ s/^"|"$//g;
1908 $val =~ s/`/``/g;
1909 $val =~ s/""/"/g;
1910 return "`$val`";
1421}1911}
14221912
1423sub _d {1913sub _d {
@@ -1663,51 +2153,10 @@
1663 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 2153 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
1664 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));2154 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
16652155
1666 eval {2156 $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
1667 $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);2157
1668
1669 if ( $cxn_string =~ m/mysql/i ) {
1670 my $sql;
1671
1672 $sql = 'SELECT @@SQL_MODE';
1673 PTDEBUG && _d($dbh, $sql);
1674 my ($sql_mode) = $dbh->selectrow_array($sql);
1675
1676 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
1677 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
1678 . ($sql_mode ? ",$sql_mode" : '')
1679 . '\'*/';
1680 PTDEBUG && _d($dbh, $sql);
1681 $dbh->do($sql);
1682
1683 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
1684 $sql = "/*!40101 SET NAMES $charset*/";
1685 PTDEBUG && _d($dbh, ':', $sql);
1686 $dbh->do($sql);
1687 PTDEBUG && _d('Enabling charset for STDOUT');
1688 if ( $charset eq 'utf8' ) {
1689 binmode(STDOUT, ':utf8')
1690 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
1691 }
1692 else {
1693 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
1694 }
1695 }
1696
1697 if ( $self->prop('set-vars') ) {
1698 $sql = "SET " . $self->prop('set-vars');
1699 PTDEBUG && _d($dbh, ':', $sql);
1700 $dbh->do($sql);
1701 }
1702 }
1703 };
1704 if ( !$dbh && $EVAL_ERROR ) {2158 if ( !$dbh && $EVAL_ERROR ) {
1705 PTDEBUG && _d($EVAL_ERROR);2159 if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1706 if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
1707 PTDEBUG && _d('Going to try again without utf8 support');
1708 delete $defaults->{mysql_enable_utf8};
1709 }
1710 elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1711 die "Cannot connect to MySQL because the Perl DBD::mysql module is "2160 die "Cannot connect to MySQL because the Perl DBD::mysql module is "
1712 . "not installed or not found. Run 'perl -MDBD::mysql' to see "2161 . "not installed or not found. Run 'perl -MDBD::mysql' to see "
1713 . "the directories that Perl searches for DBD::mysql. If "2162 . "the directories that Perl searches for DBD::mysql. If "
@@ -1716,19 +2165,70 @@
1716 . " RHEL/CentOS yum install perl-DBD-MySQL\n"2165 . " RHEL/CentOS yum install perl-DBD-MySQL\n"
1717 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";2166 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
1718 }2167 }
2168 elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
2169 PTDEBUG && _d('Going to try again without utf8 support');
2170 delete $defaults->{mysql_enable_utf8};
2171 }
1719 if ( !$tries ) {2172 if ( !$tries ) {
1720 die $EVAL_ERROR;2173 die $EVAL_ERROR;
1721 }2174 }
1722 }2175 }
1723 }2176 }
17242177
2178 if ( $cxn_string =~ m/mysql/i ) {
2179 my $sql;
2180
2181 $sql = 'SELECT @@SQL_MODE';
2182 PTDEBUG && _d($dbh, $sql);
2183 my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
2184 if ( $EVAL_ERROR ) {
2185 die $EVAL_ERROR;
2186 }
2187
2188 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
2189 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
2190 . ($sql_mode ? ",$sql_mode" : '')
2191 . '\'*/';
2192 PTDEBUG && _d($dbh, $sql);
2193 eval { $dbh->do($sql) };
2194 if ( $EVAL_ERROR ) {
2195 die $EVAL_ERROR;
2196 }
2197
2198 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
2199 $sql = "/*!40101 SET NAMES $charset*/";
2200 PTDEBUG && _d($dbh, ':', $sql);
2201 eval { $dbh->do($sql) };
2202 if ( $EVAL_ERROR ) {
2203 die $EVAL_ERROR;
2204 }
2205 PTDEBUG && _d('Enabling charset for STDOUT');
2206 if ( $charset eq 'utf8' ) {
2207 binmode(STDOUT, ':utf8')
2208 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
2209 }
2210 else {
2211 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
2212 }
2213 }
2214
2215 if ( $self->prop('set-vars') ) {
2216 $sql = "SET " . $self->prop('set-vars');
2217 PTDEBUG && _d($dbh, ':', $sql);
2218 eval { $dbh->do($sql) };
2219 if ( $EVAL_ERROR ) {
2220 die $EVAL_ERROR;
2221 }
2222 }
2223 }
2224
1725 PTDEBUG && _d('DBH info: ',2225 PTDEBUG && _d('DBH info: ',
1726 $dbh,2226 $dbh,
1727 Dumper($dbh->selectrow_hashref(2227 Dumper($dbh->selectrow_hashref(
1728 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),2228 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
1729 'Connection info:', $dbh->{mysql_hostinfo},2229 'Connection info:', $dbh->{mysql_hostinfo},
1730 'Character set info:', Dumper($dbh->selectall_arrayref(2230 'Character set info:', Dumper($dbh->selectall_arrayref(
1731 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})),2231 "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})),
1732 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,2232 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,
1733 '$DBI::VERSION:', $DBI::VERSION,2233 '$DBI::VERSION:', $DBI::VERSION,
1734 );2234 );
@@ -1806,35 +2306,145 @@
1806{2306{
1807package VersionParser;2307package VersionParser;
18082308
1809use strict;2309use Mo;
1810use warnings FATAL => 'all';2310use Scalar::Util qw(blessed);
1811use English qw(-no_match_vars);2311use English qw(-no_match_vars);
1812use constant PTDEBUG => $ENV{PTDEBUG} || 0;2312use constant PTDEBUG => $ENV{PTDEBUG} || 0;
18132313
1814sub new {2314use overload (
1815 my ( $class ) = @_;2315 '""' => "version",
1816 bless {}, $class;2316 '<=>' => "cmp",
1817}2317 'cmp' => "cmp",
18182318 fallback => 1,
1819sub parse {2319);
1820 my ( $self, $str ) = @_;2320
1821 my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g);2321use Carp ();
1822 PTDEBUG && _d($str, 'parses to', $result);2322
1823 return $result;2323our $VERSION = 0.01;
1824}2324
18252325has major => (
1826sub version_ge {2326 is => 'ro',
1827 my ( $self, $dbh, $target ) = @_;2327 isa => 'Int',
1828 if ( !$self->{$dbh} ) {2328 required => 1,
1829 $self->{$dbh} = $self->parse(2329);
1830 $dbh->selectrow_array('SELECT VERSION()'));2330
1831 }2331has [qw( minor revision )] => (
1832 my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;2332 is => 'ro',
1833 PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);2333 isa => 'Num',
1834 return $result;2334);
1835}2335
18362336has flavor => (
1837sub innodb_version {2337 is => 'ro',
2338 isa => 'Str',
2339 default => sub { 'Unknown' },
2340);
2341
2342has innodb_version => (
2343 is => 'ro',
2344 isa => 'Str',
2345 default => sub { 'NO' },
2346);
2347
2348sub series {
2349 my $self = shift;
2350 return $self->_join_version($self->major, $self->minor);
2351}
2352
2353sub version {
2354 my $self = shift;
2355 return $self->_join_version($self->major, $self->minor, $self->revision);
2356}
2357
2358sub is_in {
2359 my ($self, $target) = @_;
2360
2361 return $self eq $target;
2362}
2363
2364sub _join_version {
2365 my ($self, @parts) = @_;
2366
2367 return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts;
2368}
2369sub _split_version {
2370 my ($self, $str) = @_;
2371 my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g;
2372 return @version_parts[0..2];
2373}
2374
2375sub normalized_version {
2376 my ( $self ) = @_;
2377 my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major,
2378 $self->minor,
2379 $self->revision);
2380 PTDEBUG && _d($self->version, 'normalizes to', $result);
2381 return $result;
2382}
2383
2384sub comment {
2385 my ( $self, $cmd ) = @_;
2386 my $v = $self->normalized_version();
2387
2388 return "/*!$v $cmd */"
2389}
2390
2391my @methods = qw(major minor revision);
2392sub cmp {
2393 my ($left, $right) = @_;
2394 my $right_obj = (blessed($right) && $right->isa(ref($left)))
2395 ? $right
2396 : ref($left)->new($right);
2397
2398 my $retval = 0;
2399 for my $m ( @methods ) {
2400 last unless defined($left->$m) && defined($right_obj->$m);
2401 $retval = $left->$m <=> $right_obj->$m;
2402 last if $retval;
2403 }
2404 return $retval;
2405}
2406
2407sub BUILDARGS {
2408 my $self = shift;
2409
2410 if ( @_ == 1 ) {
2411 my %args;
2412 if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) {
2413 PTDEBUG && _d("VersionParser got a dbh, trying to get the version");
2414 my $dbh = $_[0];
2415 local $dbh->{FetchHashKeyName} = 'NAME_lc';
2416 my $query = eval {
2417 $dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} })
2418 };
2419 if ( $query ) {
2420 $query = { map { $_->{variable_name} => $_->{value} } @$query };
2421 @args{@methods} = $self->_split_version($query->{version});
2422 $args{flavor} = delete $query->{version_comment}
2423 if $query->{version_comment};
2424 }
2425 elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) {
2426 @args{@methods} = $self->_split_version($query);
2427 }
2428 else {
2429 Carp::confess("Couldn't get the version from the dbh while "
2430 . "creating a VersionParser object: $@");
2431 }
2432 $args{innodb_version} = eval { $self->_innodb_version($dbh) };
2433 }
2434 elsif ( !ref($_[0]) ) {
2435 @args{@methods} = $self->_split_version($_[0]);
2436 }
2437
2438 for my $method (@methods) {
2439 delete $args{$method} unless defined $args{$method};
2440 }
2441 @_ = %args if %args;
2442 }
2443
2444 return $self->SUPER::BUILDARGS(@_);
2445}
2446
2447sub _innodb_version {
1838 my ( $self, $dbh ) = @_;2448 my ( $self, $dbh ) = @_;
1839 return unless $dbh;2449 return unless $dbh;
1840 my $innodb_version = "NO";2450 my $innodb_version = "NO";
@@ -1872,6 +2482,7 @@
1872 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";2482 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
1873}2483}
18742484
2485no Mo;
18751;24861;
1876}2487}
1877# ###########################################################################2488# ###########################################################################
@@ -1949,6 +2560,48 @@
1949 return $db ? "$db.$tbl" : $tbl;2560 return $db ? "$db.$tbl" : $tbl;
1950}2561}
19512562
2563sub serialize_list {
2564 my ( $self, @args ) = @_;
2565 return unless @args;
2566
2567 return $args[0] if @args == 1 && !defined $args[0];
2568
2569 die "Cannot serialize multiple values with undef/NULL"
2570 if grep { !defined $_ } @args;
2571
2572 return join ',', map { quotemeta } @args;
2573}
2574
2575sub deserialize_list {
2576 my ( $self, $string ) = @_;
2577 return $string unless defined $string;
2578 my @escaped_parts = $string =~ /
2579 \G # Start of string, or end of previous match.
2580 ( # Each of these is an element in the original list.
2581 [^\\,]* # Anything not a backslash or a comma
2582 (?: # When we get here, we found one of the above.
2583 \\. # A backslash followed by something so we can continue
2584 [^\\,]* # Same as above.
2585 )* # Repeat zero of more times.
2586 )
2587 , # Comma dividing elements
2588 /sxgc;
2589
2590 push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
2591
2592 my @unescaped_parts = map {
2593 my $part = $_;
2594
2595 my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
2596 ? qr/(?=\p{ASCII})\W/ # We only care about non-word
2597 : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
2598 $part =~ s/\\($char_class)/$1/g;
2599 $part;
2600 } @escaped_parts;
2601
2602 return @unescaped_parts;
2603}
2604
19521;26051;
1953}2606}
1954# ###########################################################################2607# ###########################################################################
@@ -1988,23 +2641,26 @@
1988 die "I need a $arg argument" unless defined $args{$arg};2641 die "I need a $arg argument" unless defined $args{$arg};
1989 }2642 }
1990 my ($tbl_struct, $index) = @args{@required_args};2643 my ($tbl_struct, $index) = @args{@required_args};
1991 my @cols = $args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}};2644 my @cols = $args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}};
1992 my $q = $self->{Quoter};2645 my $q = $self->{Quoter};
19932646
1994 die "Index '$index' does not exist in table"2647 die "Index '$index' does not exist in table"
1995 unless exists $tbl_struct->{keys}->{$index};2648 unless exists $tbl_struct->{keys}->{$index};
2649 PTDEBUG && _d('Will ascend index', $index);
19962650
1997 my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}};2651 my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}};
1998 my @asc_slice;
1999
2000 @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}};
2001 PTDEBUG && _d('Will ascend index', $index);
2002 PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols));
2003 if ( $args{asc_first} ) {2652 if ( $args{asc_first} ) {
2653 PTDEBUG && _d('Ascending only first column');
2004 @asc_cols = $asc_cols[0];2654 @asc_cols = $asc_cols[0];
2005 PTDEBUG && _d('Ascending only first column');2655 }
2006 }2656 elsif ( my $n = $args{n_index_cols} ) {
2657 $n = scalar @asc_cols if $n > @asc_cols;
2658 PTDEBUG && _d('Ascending only first', $n, 'columns');
2659 @asc_cols = @asc_cols[0..($n-1)];
2660 }
2661 PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols));
20072662
2663 my @asc_slice;
2008 my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols };2664 my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols };
2009 foreach my $col ( @asc_cols ) {2665 foreach my $col ( @asc_cols ) {
2010 if ( !exists $col_posn{$col} ) {2666 if ( !exists $col_posn{$col} ) {
@@ -2215,311 +2871,6 @@
2215# ###########################################################################2871# ###########################################################################
22162872
2217# ###########################################################################2873# ###########################################################################
2218# MySQLDump package
2219# This package is a copy without comments from the original. The original
2220# with comments and its test file can be found in the Bazaar repository at,
2221# lib/MySQLDump.pm
2222# t/lib/MySQLDump.t
2223# See https://launchpad.net/percona-toolkit for more information.
2224# ###########################################################################
2225{
2226package MySQLDump;
2227
2228use strict;
2229use warnings FATAL => 'all';
2230use English qw(-no_match_vars);
2231use constant PTDEBUG => $ENV{PTDEBUG} || 0;
2232
2233( our $before = <<'EOF') =~ s/^ //gm;
2234 /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
2235 /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
2236 /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
2237 /*!40101 SET NAMES utf8 */;
2238 /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
2239 /*!40103 SET TIME_ZONE='+00:00' */;
2240 /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
2241 /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
2242 /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
2243 /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;
2244EOF
2245
2246( our $after = <<'EOF') =~ s/^ //gm;
2247 /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
2248 /*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
2249 /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
2250 /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
2251 /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
2252 /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
2253 /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
2254 /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;
2255EOF
2256
2257sub new {
2258 my ( $class, %args ) = @_;
2259 my $self = {
2260 cache => 0, # Afaik no script uses this cache any longer because
2261 };
2262 return bless $self, $class;
2263}
2264
2265sub dump {
2266 my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_;
2267
2268 if ( $what eq 'table' ) {
2269 my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
2270 return unless $ddl;
2271 if ( $ddl->[0] eq 'table' ) {
2272 return $before
2273 . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
2274 . $ddl->[1] . ";\n";
2275 }
2276 else {
2277 return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
2278 . '/*!50001 DROP VIEW IF EXISTS '
2279 . $quoter->quote($tbl) . "*/;\n/*!50001 "
2280 . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n";
2281 }
2282 }
2283 elsif ( $what eq 'triggers' ) {
2284 my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl);
2285 if ( $trgs && @$trgs ) {
2286 my $result = $before . "\nDELIMITER ;;\n";
2287 foreach my $trg ( @$trgs ) {
2288 if ( $trg->{sql_mode} ) {
2289 $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n};
2290 }
2291 $result .= "/*!50003 CREATE */ ";
2292 if ( $trg->{definer} ) {
2293 my ( $user, $host )
2294 = map { s/'/''/g; "'$_'"; }
2295 split('@', $trg->{definer}, 2);
2296 $result .= "/*!50017 DEFINER=$user\@$host */ ";
2297 }
2298 $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n",
2299 $quoter->quote($trg->{trigger}),
2300 @{$trg}{qw(timing event)},
2301 $quoter->quote($trg->{table}),
2302 $trg->{statement});
2303 }
2304 $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n";
2305 return $result;
2306 }
2307 else {
2308 return undef;
2309 }
2310 }
2311 elsif ( $what eq 'view' ) {
2312 my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
2313 return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
2314 . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
2315 . '/*!50001 ' . $ddl->[1] . "*/;\n";
2316 }
2317 else {
2318 die "You didn't say what to dump.";
2319 }
2320}
2321
2322sub _use_db {
2323 my ( $self, $dbh, $quoter, $new ) = @_;
2324 if ( !$new ) {
2325 PTDEBUG && _d('No new DB to use');
2326 return;
2327 }
2328 my $sql = 'USE ' . $quoter->quote($new);
2329 PTDEBUG && _d($dbh, $sql);
2330 $dbh->do($sql);
2331 return;
2332}
2333
2334sub get_create_table {
2335 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2336 if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) {
2337 my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
2338 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
2339 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
2340 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
2341 PTDEBUG && _d($sql);
2342 eval { $dbh->do($sql); };
2343 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
2344 $self->_use_db($dbh, $quoter, $db);
2345 $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl);
2346 PTDEBUG && _d($sql);
2347 my $href;
2348 eval { $href = $dbh->selectrow_hashref($sql); };
2349 if ( $EVAL_ERROR ) {
2350 warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR";
2351 return;
2352 }
2353
2354 $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
2355 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
2356 PTDEBUG && _d($sql);
2357 $dbh->do($sql);
2358 my ($key) = grep { m/create table/i } keys %$href;
2359 if ( $key ) {
2360 PTDEBUG && _d('This table is a base table');
2361 $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ];
2362 }
2363 else {
2364 PTDEBUG && _d('This table is a view');
2365 ($key) = grep { m/create view/i } keys %$href;
2366 $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ];
2367 }
2368 }
2369 return $self->{tables}->{$db}->{$tbl};
2370}
2371
2372sub get_columns {
2373 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2374 PTDEBUG && _d('Get columns for', $db, $tbl);
2375 if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) {
2376 $self->_use_db($dbh, $quoter, $db);
2377 my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl);
2378 PTDEBUG && _d($sql);
2379 my $cols = $dbh->selectall_arrayref($sql, { Slice => {} });
2380
2381 $self->{columns}->{$db}->{$tbl} = [
2382 map {
2383 my %row;
2384 @row{ map { lc $_ } keys %$_ } = values %$_;
2385 \%row;
2386 } @$cols
2387 ];
2388 }
2389 return $self->{columns}->{$db}->{$tbl};
2390}
2391
2392sub get_tmp_table {
2393 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2394 my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n";
2395 $result .= join(",\n",
2396 map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} }
2397 @{$self->get_columns($dbh, $quoter, $db, $tbl)});
2398 $result .= "\n)";
2399 PTDEBUG && _d($result);
2400 return $result;
2401}
2402
2403sub get_triggers {
2404 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2405 if ( !$self->{cache} || !$self->{triggers}->{$db} ) {
2406 $self->{triggers}->{$db} = {};
2407 my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
2408 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
2409 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
2410 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
2411 PTDEBUG && _d($sql);
2412 eval { $dbh->do($sql); };
2413 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
2414 $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db);
2415 PTDEBUG && _d($sql);
2416 my $sth = $dbh->prepare($sql);
2417 $sth->execute();
2418 if ( $sth->rows ) {
2419 my $trgs = $sth->fetchall_arrayref({});
2420 foreach my $trg (@$trgs) {
2421 my %trg;
2422 @trg{ map { lc $_ } keys %$trg } = values %$trg;
2423 push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg;
2424 }
2425 }
2426 $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
2427 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
2428 PTDEBUG && _d($sql);
2429 $dbh->do($sql);
2430 }
2431 if ( $tbl ) {
2432 return $self->{triggers}->{$db}->{$tbl};
2433 }
2434 return values %{$self->{triggers}->{$db}};
2435}
2436
2437sub get_databases {
2438 my ( $self, $dbh, $quoter, $like ) = @_;
2439 if ( !$self->{cache} || !$self->{databases} || $like ) {
2440 my $sql = 'SHOW DATABASES';
2441 my @params;
2442 if ( $like ) {
2443 $sql .= ' LIKE ?';
2444 push @params, $like;
2445 }
2446 my $sth = $dbh->prepare($sql);
2447 PTDEBUG && _d($sql, @params);
2448 $sth->execute( @params );
2449 my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()};
2450 $self->{databases} = \@dbs unless $like;
2451 return @dbs;
2452 }
2453 return @{$self->{databases}};
2454}
2455
2456sub get_table_status {
2457 my ( $self, $dbh, $quoter, $db, $like ) = @_;
2458 if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) {
2459 my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db);
2460 my @params;
2461 if ( $like ) {
2462 $sql .= ' LIKE ?';
2463 push @params, $like;
2464 }
2465 PTDEBUG && _d($sql, @params);
2466 my $sth = $dbh->prepare($sql);
2467 $sth->execute(@params);
2468 my @tables = @{$sth->fetchall_arrayref({})};
2469 @tables = map {
2470 my %tbl; # Make a copy with lowercased keys
2471 @tbl{ map { lc $_ } keys %$_ } = values %$_;
2472 $tbl{engine} ||= $tbl{type} || $tbl{comment};
2473 delete $tbl{type};
2474 \%tbl;
2475 } @tables;
2476 $self->{table_status}->{$db} = \@tables unless $like;
2477 return @tables;
2478 }
2479 return @{$self->{table_status}->{$db}};
2480}
2481
2482sub get_table_list {
2483 my ( $self, $dbh, $quoter, $db, $like ) = @_;
2484 if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) {
2485 my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db);
2486 my @params;
2487 if ( $like ) {
2488 $sql .= ' LIKE ?';
2489 push @params, $like;
2490 }
2491 PTDEBUG && _d($sql, @params);
2492 my $sth = $dbh->prepare($sql);
2493 $sth->execute(@params);
2494 my @tables = @{$sth->fetchall_arrayref()};
2495 @tables = map {
2496 my %tbl = (
2497 name => $_->[0],
2498 engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '',
2499 );
2500 \%tbl;
2501 } @tables;
2502 $self->{table_list}->{$db} = \@tables unless $like;
2503 return @tables;
2504 }
2505 return @{$self->{table_list}->{$db}};
2506}
2507
2508sub _d {
2509 my ($package, undef, $line) = caller 0;
2510 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
2511 map { defined $_ ? $_ : 'undef' }
2512 @_;
2513 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
2514}
2515
25161;
2517}
2518# ###########################################################################
2519# End MySQLDump package
2520# ###########################################################################
2521
2522# ###########################################################################
2523# Daemon package2874# Daemon package
2524# This package is a copy without comments from the original. The original2875# This package is a copy without comments from the original. The original
2525# with comments and its test file can be found in the Bazaar repository at,2876# with comments and its test file can be found in the Bazaar repository at,
@@ -2774,6 +3125,9 @@
2774 dsn_table_dsn => $dsn_table_dsn,3125 dsn_table_dsn => $dsn_table_dsn,
2775 );3126 );
2776 }3127 }
3128 elsif ( $method =~ m/none/i ) {
3129 PTDEBUG && _d('Not getting to slaves');
3130 }
2777 else {3131 else {
2778 die "Invalid --recursion-method: $method. Valid values are: "3132 die "Invalid --recursion-method: $method. Valid values are: "
2779 . "dsn=DSN, hosts, or processlist.\n";3133 . "dsn=DSN, hosts, or processlist.\n";
@@ -2788,6 +3142,11 @@
2788 my $dp = $args->{dsn_parser};3142 my $dp = $args->{dsn_parser};
2789 my $dsn = $args->{dsn};3143 my $dsn = $args->{dsn};
27903144
3145 if ( lc($args->{method} || '') eq 'none' ) {
3146 PTDEBUG && _d('Not recursing to slaves');
3147 return;
3148 }
3149
2791 my $dbh;3150 my $dbh;
2792 eval {3151 eval {
2793 $dbh = $args->{dbh} || $dp->get_dbh(3152 $dbh = $args->{dbh} || $dp->get_dbh(
@@ -2915,11 +3274,6 @@
29153274
2916 my $show = "SHOW GRANTS FOR ";3275 my $show = "SHOW GRANTS FOR ";
2917 my $user = 'CURRENT_USER()';3276 my $user = 'CURRENT_USER()';
2918 my $vp = $self->{VersionParser};
2919 if ( $vp && !$vp->version_ge($dbh, '4.1.2') ) {
2920 $user = $dbh->selectrow_arrayref('SELECT USER()')->[0];
2921 $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/;
2922 }
2923 my $sql = $show . $user;3277 my $sql = $show . $user;
2924 PTDEBUG && _d($dbh, $sql);3278 PTDEBUG && _d($dbh, $sql);
29253279
@@ -2969,7 +3323,7 @@
2969 or die "The server specified as a slave is not a slave";3323 or die "The server specified as a slave is not a slave";
2970 my @connected = $self->get_connected_slaves($master)3324 my @connected = $self->get_connected_slaves($master)
2971 or die "The server specified as a master has no connected slaves";3325 or die "The server specified as a master has no connected slaves";
2972 my (undef, $port) = $master->selectrow_array('SHOW VARIABLES LIKE "port"');3326 my (undef, $port) = $master->selectrow_array("SHOW VARIABLES LIKE 'port'");
29733327
2974 if ( $port != $slave_status->{master_port} ) {3328 if ( $port != $slave_status->{master_port} ) {
2975 die "The slave is connected to $slave_status->{master_port} "3329 die "The slave is connected to $slave_status->{master_port} "
@@ -3443,7 +3797,6 @@
3443# Holds the arguments for the $sth's bind variables, so it can be re-tried3797# Holds the arguments for the $sth's bind variables, so it can be re-tried
3444# easily.3798# easily.
3445my @beginning_of_txn;3799my @beginning_of_txn;
3446my $vp = new VersionParser;
3447my $q = new Quoter;3800my $q = new Quoter;
34483801
3449sub main {3802sub main {
@@ -3591,7 +3944,6 @@
3591 # ########################################################################3944 # ########################################################################
35923945
3593 my $tp = new TableParser(Quoter => $q);3946 my $tp = new TableParser(Quoter => $q);
3594 my $du = new MySQLDump();
3595 foreach my $table ( grep { $_ } ($src, $dst) ) {3947 foreach my $table ( grep { $_ } ($src, $dst) ) {
3596 my $ac = !$txnsize && !$commit_each;3948 my $ac = !$txnsize && !$commit_each;
3597 if ( !defined $table->{p} && $o->get('ask-pass') ) {3949 if ( !defined $table->{p} && $o->get('ask-pass') ) {
@@ -3641,7 +3993,7 @@
3641 }3993 }
36423994
3643 $table->{info} = $tp->parse(3995 $table->{info} = $tp->parse(
3644 $du->get_create_table($dbh, $q, $table->{D}, $table->{t}));3996 $tp->get_create_table( $dbh, $table->{D}, $table->{t} ));
36453997
3646 if ( $o->get('check-charset') ) {3998 if ( $o->get('check-charset') ) {
3647 my $sql = 'SELECT CONCAT(/*!40100 @@session.character_set_connection, */ "")';3999 my $sql = 'SELECT CONCAT(/*!40100 @@session.character_set_connection, */ "")';
@@ -3700,7 +4052,7 @@
3700 my $dsn_defaults = $dp->parse_options($o);4052 my $dsn_defaults = $dp->parse_options($o);
3701 my $dsn = $dp->parse($o->get('check-slave-lag'), $dsn_defaults);4053 my $dsn = $dp->parse($o->get('check-slave-lag'), $dsn_defaults);
3702 $lag_dbh = $dp->get_dbh($dp->get_cxn_params($dsn), { AutoCommit => 1 });4054 $lag_dbh = $dp->get_dbh($dp->get_cxn_params($dsn), { AutoCommit => 1 });
3703 $ms = new MasterSlave(VersionParser => $vp);4055 $ms = new MasterSlave();
3704 }4056 }
37054057
3706 # ########################################################################4058 # ########################################################################
@@ -3773,7 +4125,7 @@
3773 . join(',', map { $q->quote($_) } @{$sel_stmt->{cols}} )4125 . join(',', map { $q->quote($_) } @{$sel_stmt->{cols}} )
3774 . " FROM $src->{db_tbl}"4126 . " FROM $src->{db_tbl}"
3775 . ( $sel_stmt->{index}4127 . ( $sel_stmt->{index}
3776 ? (($vp->version_ge($dbh, '4.0.9') ? " FORCE" : " USE")4128 ? ((VersionParser->new($dbh) >= '4.0.9' ? " FORCE" : " USE")
3777 . " INDEX(`$sel_stmt->{index}`)")4129 . " INDEX(`$sel_stmt->{index}`)")
3778 : '')4130 : '')
3779 . " WHERE (".$o->get('where').")";4131 . " WHERE (".$o->get('where').")";
@@ -4473,7 +4825,7 @@
44734825
4474sub get_irot {4826sub get_irot {
4475 my ( $dbh ) = @_;4827 my ( $dbh ) = @_;
4476 return 1 unless $vp->version_ge($dbh, '5.0.13');4828 return 1 unless VersionParser->new($dbh) >= '5.0.13';
4477 my $rows = $dbh->selectall_arrayref(4829 my $rows = $dbh->selectall_arrayref(
4478 "show variables like 'innodb_rollback_on_timeout'",4830 "show variables like 'innodb_rollback_on_timeout'",
4479 { Slice => {} });4831 { Slice => {} });
@@ -4576,8 +4928,8 @@
4576rows. Specifying the index with the 'i' part of the L<"--source"> argument can4928rows. Specifying the index with the 'i' part of the L<"--source"> argument can
4577be crucial for this; use L<"--dry-run"> to examine the generated queries and be4929be crucial for this; use L<"--dry-run"> to examine the generated queries and be
4578sure to EXPLAIN them to see if they are efficient (most of the time you probably4930sure to EXPLAIN them to see if they are efficient (most of the time you probably
4579want to scan the PRIMARY key, which is the default). Even better, profile4931want to scan the PRIMARY key, which is the default). Even better, examine the
4580pt-archiver with mk-query-profiler (L<http://maatkit.org/get/mk-query-profiler>)4932difference in the Handler status counters before and after running the query,
4581and make sure it is not scanning the whole table every query.4933and make sure it is not scanning the whole table every query.
45824934
4583You can disable the seek-then-scan optimizations partially or wholly with4935You can disable the seek-then-scan optimizations partially or wholly with
@@ -5743,6 +6095,10 @@
57436095
5744=head1 VERSION6096=head1 VERSION
57456097
6098<<<<<<< TREE
5746pt-archiver 2.0.56099pt-archiver 2.0.5
6100=======
6101pt-archiver 2.1.2
6102>>>>>>> MERGE-SOURCE
57476103
5748=cut6104=cut
57496105
=== modified file 'bin/pt-config-diff'
--- bin/pt-config-diff 2012-06-09 21:53:04 +0000
+++ bin/pt-config-diff 2012-07-20 22:10:28 +0000
@@ -1262,51 +1262,10 @@
1262 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 1262 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
1263 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));1263 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
12641264
1265 eval {1265 $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
1266 $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);1266
1267
1268 if ( $cxn_string =~ m/mysql/i ) {
1269 my $sql;
1270
1271 $sql = 'SELECT @@SQL_MODE';
1272 PTDEBUG && _d($dbh, $sql);
1273 my ($sql_mode) = $dbh->selectrow_array($sql);
1274
1275 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
1276 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
1277 . ($sql_mode ? ",$sql_mode" : '')
1278 . '\'*/';
1279 PTDEBUG && _d($dbh, $sql);
1280 $dbh->do($sql);
1281
1282 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
1283 $sql = "/*!40101 SET NAMES $charset*/";
1284 PTDEBUG && _d($dbh, ':', $sql);
1285 $dbh->do($sql);
1286 PTDEBUG && _d('Enabling charset for STDOUT');
1287 if ( $charset eq 'utf8' ) {
1288 binmode(STDOUT, ':utf8')
1289 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
1290 }
1291 else {
1292 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
1293 }
1294 }
1295
1296 if ( $self->prop('set-vars') ) {
1297 $sql = "SET " . $self->prop('set-vars');
1298 PTDEBUG && _d($dbh, ':', $sql);
1299 $dbh->do($sql);
1300 }
1301 }
1302 };
1303 if ( !$dbh && $EVAL_ERROR ) {1267 if ( !$dbh && $EVAL_ERROR ) {
1304 PTDEBUG && _d($EVAL_ERROR);1268 if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1305 if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
1306 PTDEBUG && _d('Going to try again without utf8 support');
1307 delete $defaults->{mysql_enable_utf8};
1308 }
1309 elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1310 die "Cannot connect to MySQL because the Perl DBD::mysql module is "1269 die "Cannot connect to MySQL because the Perl DBD::mysql module is "
1311 . "not installed or not found. Run 'perl -MDBD::mysql' to see "1270 . "not installed or not found. Run 'perl -MDBD::mysql' to see "
1312 . "the directories that Perl searches for DBD::mysql. If "1271 . "the directories that Perl searches for DBD::mysql. If "
@@ -1315,19 +1274,70 @@
1315 . " RHEL/CentOS yum install perl-DBD-MySQL\n"1274 . " RHEL/CentOS yum install perl-DBD-MySQL\n"
1316 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";1275 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
1317 }1276 }
1277 elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
1278 PTDEBUG && _d('Going to try again without utf8 support');
1279 delete $defaults->{mysql_enable_utf8};
1280 }
1318 if ( !$tries ) {1281 if ( !$tries ) {
1319 die $EVAL_ERROR;1282 die $EVAL_ERROR;
1320 }1283 }
1321 }1284 }
1322 }1285 }
13231286
1287 if ( $cxn_string =~ m/mysql/i ) {
1288 my $sql;
1289
1290 $sql = 'SELECT @@SQL_MODE';
1291 PTDEBUG && _d($dbh, $sql);
1292 my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
1293 if ( $EVAL_ERROR ) {
1294 die $EVAL_ERROR;
1295 }
1296
1297 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
1298 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
1299 . ($sql_mode ? ",$sql_mode" : '')
1300 . '\'*/';
1301 PTDEBUG && _d($dbh, $sql);
1302 eval { $dbh->do($sql) };
1303 if ( $EVAL_ERROR ) {
1304 die $EVAL_ERROR;
1305 }
1306
1307 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
1308 $sql = "/*!40101 SET NAMES $charset*/";
1309 PTDEBUG && _d($dbh, ':', $sql);
1310 eval { $dbh->do($sql) };
1311 if ( $EVAL_ERROR ) {
1312 die $EVAL_ERROR;
1313 }
1314 PTDEBUG && _d('Enabling charset for STDOUT');
1315 if ( $charset eq 'utf8' ) {
1316 binmode(STDOUT, ':utf8')
1317 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
1318 }
1319 else {
1320 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
1321 }
1322 }
1323
1324 if ( $self->prop('set-vars') ) {
1325 $sql = "SET " . $self->prop('set-vars');
1326 PTDEBUG && _d($dbh, ':', $sql);
1327 eval { $dbh->do($sql) };
1328 if ( $EVAL_ERROR ) {
1329 die $EVAL_ERROR;
1330 }
1331 }
1332 }
1333
1324 PTDEBUG && _d('DBH info: ',1334 PTDEBUG && _d('DBH info: ',
1325 $dbh,1335 $dbh,
1326 Dumper($dbh->selectrow_hashref(1336 Dumper($dbh->selectrow_hashref(
1327 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),1337 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
1328 'Connection info:', $dbh->{mysql_hostinfo},1338 'Connection info:', $dbh->{mysql_hostinfo},
1329 'Character set info:', Dumper($dbh->selectall_arrayref(1339 'Character set info:', Dumper($dbh->selectall_arrayref(
1330 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})),1340 "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})),
1331 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,1341 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,
1332 '$DBI::VERSION:', $DBI::VERSION,1342 '$DBI::VERSION:', $DBI::VERSION,
1333 );1343 );
@@ -1408,9 +1418,11 @@
1408use strict;1418use strict;
1409use warnings FATAL => 'all';1419use warnings FATAL => 'all';
1410use English qw(-no_match_vars);1420use English qw(-no_match_vars);
1411use constant PTDEBUG => $ENV{PTDEBUG} || 0;1421use Scalar::Util qw(blessed);
14121422use constant {
1413use constant PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0;1423 PTDEBUG => $ENV{PTDEBUG} || 0,
1424 PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0,
1425};
14141426
1415sub new {1427sub new {
1416 my ( $class, %args ) = @_;1428 my ( $class, %args ) = @_;
@@ -1513,7 +1525,9 @@
15131525
1514sub DESTROY {1526sub DESTROY {
1515 my ($self) = @_;1527 my ($self) = @_;
1516 if ( $self->{dbh} ) {1528 if ( $self->{dbh}
1529 && blessed($self->{dbh})
1530 && $self->{dbh}->can("disconnect") ) {
1517 PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name});1531 PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name});
1518 $self->{dbh}->disconnect();1532 $self->{dbh}->disconnect();
1519 }1533 }
@@ -3408,6 +3422,10 @@
34083422
3409=head1 VERSION3423=head1 VERSION
34103424
3425<<<<<<< TREE
3411pt-config-diff 2.0.53426pt-config-diff 2.0.5
3427=======
3428pt-config-diff 2.1.2
3429>>>>>>> MERGE-SOURCE
34123430
3413=cut3431=cut
34143432
=== modified file 'bin/pt-deadlock-logger'
--- bin/pt-deadlock-logger 2012-06-09 21:53:04 +0000
+++ bin/pt-deadlock-logger 2012-07-20 22:10:28 +0000
@@ -959,7 +959,7 @@
959 $opt->{value} = ($pre || '') . $num;959 $opt->{value} = ($pre || '') . $num;
960 }960 }
961 else {961 else {
962 $self->save_error("Invalid size for --$opt->{long}");962 $self->save_error("Invalid size for --$opt->{long}: $val");
963 }963 }
964 return;964 return;
965}965}
@@ -1034,6 +1034,455 @@
1034# ###########################################################################1034# ###########################################################################
10351035
1036# ###########################################################################1036# ###########################################################################
1037# Mo package
1038# This package is a copy without comments from the original. The original
1039# with comments and its test file can be found in the Bazaar repository at,
1040# lib/Mo.pm
1041# t/lib/Mo.t
1042# See https://launchpad.net/percona-toolkit for more information.
1043# ###########################################################################
1044{
1045BEGIN {
1046$INC{"Mo.pm"} = __FILE__;
1047package Mo;
1048our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo.
1049
1050{
1051 no strict 'refs';
1052 sub _glob_for {
1053 return \*{shift()}
1054 }
1055
1056 sub _stash_for {
1057 return \%{ shift() . "::" };
1058 }
1059}
1060
1061use strict;
1062use warnings qw( FATAL all );
1063
1064use Carp ();
1065use Scalar::Util ();
1066
1067our %TYPES = (
1068 Bool => sub { !$_[0] || (defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == 1) },
1069 Num => sub { defined $_[0] && &Scalar::Util::looks_like_number },
1070 Int => sub { defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == int $_[0] },
1071 Str => sub { defined $_[0] },
1072 Object => sub { defined $_[0] && &Scalar::Util::blessed },
1073 FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened },
1074
1075 map {
1076 my $type = /R/ ? $_ : uc $_;
1077 $_ . "Ref" => sub { ref $_[0] eq $type }
1078 } qw(Array Code Hash Regexp Glob Scalar)
1079);
1080
1081our %metadata_for;
1082{
1083 package Mo::Object;
1084
1085 sub new {
1086 my $class = shift;
1087 my $args = $class->BUILDARGS(@_);
1088
1089 my @args_to_delete;
1090 while ( my ($attr, $meta) = each %{$metadata_for{$class}} ) {
1091 next unless exists $meta->{init_arg};
1092 my $init_arg = $meta->{init_arg};
1093
1094 if ( defined $init_arg ) {
1095 $args->{$attr} = delete $args->{$init_arg};
1096 }
1097 else {
1098 push @args_to_delete, $attr;
1099 }
1100 }
1101
1102 delete $args->{$_} for @args_to_delete;
1103
1104 for my $attribute ( keys %$args ) {
1105 if ( my $coerce = $metadata_for{$class}{$attribute}{coerce} ) {
1106 $args->{$attribute} = $coerce->($args->{$attribute});
1107 }
1108 if ( my $I = $metadata_for{$class}{$attribute}{isa} ) {
1109 ( (my $I_name), $I ) = @{$I};
1110 Mo::_check_type_constaints($attribute, $I, $I_name, $args->{$attribute});
1111 }
1112 }
1113
1114 while ( my ($attribute, $meta) = each %{$metadata_for{$class}} ) {
1115 next unless $meta->{required};
1116 Carp::confess("Attribute ($attribute) is required for $class")
1117 if ! exists $args->{$attribute}
1118 }
1119
1120 @_ = %$args;
1121 my $self = bless $args, $class;
1122
1123 my @build_subs;
1124 my $linearized_isa = mro::get_linear_isa($class);
1125
1126 for my $isa_class ( @$linearized_isa ) {
1127 unshift @build_subs, *{ Mo::_glob_for "${isa_class}::BUILD" }{CODE};
1128 }
1129 exists &$_ && $_->( $self, @_ ) for grep { defined } @build_subs;
1130 return $self;
1131 }
1132
1133 sub BUILDARGS {
1134 shift;
1135 my $ref;
1136 if ( @_ == 1 && ref($_[0]) ) {
1137 Carp::confess("Single parameters to new() must be a HASH ref")
1138 unless ref($_[0]) eq ref({});
1139 $ref = {%{$_[0]}} # We want a new reference, always
1140 }
1141 else {
1142 $ref = { @_ };
1143 }
1144 return $ref;
1145 }
1146}
1147
1148my %export_for;
1149sub Mo::import {
1150 warnings->import(qw(FATAL all));
1151 strict->import();
1152
1153 my $caller = scalar caller(); # Caller's package
1154 my $caller_pkg = $caller . "::"; # Caller's package with :: at the end
1155 my (%exports, %options);
1156
1157 my (undef, @features) = @_;
1158 my %ignore = ( map { $_ => 1 } qw( is isa init_arg builder buildargs clearer predicate build handles default required ) );
1159 for my $feature (grep { !$ignore{$_} } @features) {
1160 { local $@; require "Mo/$feature.pm"; }
1161 {
1162 no strict 'refs';
1163 &{"Mo::${feature}::e"}(
1164 $caller_pkg,
1165 \%exports,
1166 \%options,
1167 \@_
1168 );
1169 }
1170 }
1171
1172 return if $exports{M};
1173
1174 %exports = (
1175 extends => sub {
1176 for my $class ( map { "$_" } @_ ) {
1177 $class =~ s{::|'}{/}g;
1178 { local $@; eval { require "$class.pm" } } # or warn $@;
1179 }
1180 _set_package_isa($caller, @_);
1181 _set_inherited_metadata($caller);
1182 },
1183 has => sub {
1184 my $names = shift;
1185 for my $attribute ( ref $names ? @$names : $names ) {
1186 my %args = @_;
1187 my $method = ($args{is} || '') eq 'ro'
1188 ? sub {
1189 Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller_pkg}${attribute}")
1190 if $#_;
1191 return $_[0]{$attribute};
1192 }
1193 : sub {
1194 return $#_
1195 ? $_[0]{$attribute} = $_[1]
1196 : $_[0]{$attribute};
1197 };
1198
1199 $metadata_for{$caller}{$attribute} = ();
1200
1201 if ( my $I = $args{isa} ) {
1202 my $orig_I = $I;
1203 my $type;
1204 if ( $I =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
1205 $I = _nested_constraints($attribute, $1, $2);
1206 }
1207 $metadata_for{$caller}{$attribute}{isa} = [$orig_I, $I];
1208 my $orig_method = $method;
1209 $method = sub {
1210 if ( $#_ ) {
1211 Mo::_check_type_constaints($attribute, $I, $orig_I, $_[1]);
1212 }
1213 goto &$orig_method;
1214 };
1215 }
1216
1217 if ( my $builder = $args{builder} ) {
1218 my $original_method = $method;
1219 $method = sub {
1220 $#_
1221 ? goto &$original_method
1222 : ! exists $_[0]{$attribute}
1223 ? $_[0]{$attribute} = $_[0]->$builder
1224 : goto &$original_method
1225 };
1226 }
1227
1228 if ( my $code = $args{default} ) {
1229 Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef")
1230 unless ref($code) eq 'CODE';
1231 my $original_method = $method;
1232 $method = sub {
1233 $#_
1234 ? goto &$original_method
1235 : ! exists $_[0]{$attribute}
1236 ? $_[0]{$attribute} = $_[0]->$code
1237 : goto &$original_method
1238 };
1239 }
1240
1241 if ( my $role = $args{does} ) {
1242 my $original_method = $method;
1243 $method = sub {
1244 if ( $#_ ) {
1245 Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">)
1246 unless blessed($_[1]) && $_[1]->does($role)
1247 }
1248 goto &$original_method
1249 };
1250 }
1251
1252 if ( my $coercion = $args{coerce} ) {
1253 $metadata_for{$caller}{$attribute}{coerce} = $coercion;
1254 my $original_method = $method;
1255 $method = sub {
1256 if ( $#_ ) {
1257 return $original_method->($_[0], $coercion->($_[1]))
1258 }
1259 goto &$original_method;
1260 }
1261 }
1262
1263 $method = $options{$_}->($method, $attribute, @_)
1264 for sort keys %options;
1265
1266 *{ _glob_for "${caller}::$attribute" } = $method;
1267
1268 if ( $args{required} ) {
1269 $metadata_for{$caller}{$attribute}{required} = 1;
1270 }
1271
1272 if ($args{clearer}) {
1273 *{ _glob_for "${caller}::$args{clearer}" }
1274 = sub { delete shift->{$attribute} }
1275 }
1276
1277 if ($args{predicate}) {
1278 *{ _glob_for "${caller}::$args{predicate}" }
1279 = sub { exists shift->{$attribute} }
1280 }
1281
1282 if ($args{handles}) {
1283 _has_handles($caller, $attribute, \%args);
1284 }
1285
1286 if (exists $args{init_arg}) {
1287 $metadata_for{$caller}{$attribute}{init_arg} = $args{init_arg};
1288 }
1289 }
1290 },
1291 %exports,
1292 );
1293
1294 $export_for{$caller} = [ keys %exports ];
1295
1296 for my $keyword ( keys %exports ) {
1297 *{ _glob_for "${caller}::$keyword" } = $exports{$keyword}
1298 }
1299 *{ _glob_for "${caller}::extends" }{CODE}->( "Mo::Object" )
1300 unless @{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] };
1301};
1302
1303sub _check_type_constaints {
1304 my ($attribute, $I, $I_name, $val) = @_;
1305 ( ref($I) eq 'CODE'
1306 ? $I->($val)
1307 : (ref $val eq $I
1308 || ($val && $val eq $I)
1309 || (exists $TYPES{$I} && $TYPES{$I}->($val)))
1310 )
1311 || Carp::confess(
1312 qq<Attribute ($attribute) does not pass the type constraint because: >
1313 . qq<Validation failed for '$I_name' with value >
1314 . (defined $val ? Mo::Dumper($val) : 'undef') )
1315}
1316
1317sub _has_handles {
1318 my ($caller, $attribute, $args) = @_;
1319 my $handles = $args->{handles};
1320
1321 my $ref = ref $handles;
1322 my $kv;
1323 if ( $ref eq ref [] ) {
1324 $kv = { map { $_,$_ } @{$handles} };
1325 }
1326 elsif ( $ref eq ref {} ) {
1327 $kv = $handles;
1328 }
1329 elsif ( $ref eq ref qr// ) {
1330 Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)")
1331 unless $args->{isa};
1332 my $target_class = $args->{isa};
1333 $kv = {
1334 map { $_, $_ }
1335 grep { $_ =~ $handles }
1336 grep { !exists $Mo::Object::{$_} && $target_class->can($_) }
1337 grep { $_ ne 'has' && $_ ne 'extends' }
1338 keys %{ _stash_for $target_class }
1339 };
1340 }
1341 else {
1342 Carp::confess("handles for $ref not yet implemented");
1343 }
1344
1345 while ( my ($method, $target) = each %{$kv} ) {
1346 my $name = _glob_for "${caller}::$method";
1347 Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation")
1348 if defined &$name;
1349
1350 my ($target, @curried_args) = ref($target) ? @$target : $target;
1351 *$name = sub {
1352 my $self = shift;
1353 my $delegate_to = $self->$attribute();
1354 my $error = "Cannot delegate $method to $target because the value of $attribute";
1355 Carp::confess("$error is not defined") unless $delegate_to;
1356 Carp::confess("$error is not an object (got '$delegate_to')")
1357 unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target));
1358 return $delegate_to->$target(@curried_args, @_);
1359 }
1360 }
1361}
1362
1363sub _nested_constraints {
1364 my ($attribute, $aggregate_type, $type) = @_;
1365
1366 my $inner_types;
1367 if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) {
1368 $inner_types = _nested_constraints($1, $2);
1369 }
1370 else {
1371 $inner_types = $TYPES{$type};
1372 }
1373
1374 if ( $aggregate_type eq 'ArrayRef' ) {
1375 return sub {
1376 my ($val) = @_;
1377 return unless ref($val) eq ref([]);
1378
1379 if ($inner_types) {
1380 for my $value ( @{$val} ) {
1381 return unless $inner_types->($value)
1382 }
1383 }
1384 else {
1385 for my $value ( @{$val} ) {
1386 return unless $value && ($value eq $type
1387 || (Scalar::Util::blessed($value) && $value->isa($type)));
1388 }
1389 }
1390 return 1;
1391 };
1392 }
1393 elsif ( $aggregate_type eq 'Maybe' ) {
1394 return sub {
1395 my ($value) = @_;
1396 return 1 if ! defined($value);
1397 if ($inner_types) {
1398 return unless $inner_types->($value)
1399 }
1400 else {
1401 return unless $value eq $type
1402 || (Scalar::Util::blessed($value) && $value->isa($type));
1403 }
1404 return 1;
1405 }
1406 }
1407 else {
1408 Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe");
1409 }
1410}
1411
1412sub _set_package_isa {
1413 my ($package, @new_isa) = @_;
1414
1415 *{ _glob_for "${package}::ISA" } = [@new_isa];
1416}
1417
1418sub _set_inherited_metadata {
1419 my $class = shift;
1420 my $linearized_isa = mro::get_linear_isa($class);
1421 my %new_metadata;
1422
1423 for my $isa_class (reverse @$linearized_isa) {
1424 %new_metadata = (
1425 %new_metadata,
1426 %{ $metadata_for{$isa_class} || {} },
1427 );
1428 }
1429 $metadata_for{$class} = \%new_metadata;
1430}
1431
1432sub unimport {
1433 my $caller = scalar caller();
1434 my $stash = _stash_for( $caller );
1435
1436 delete $stash->{$_} for @{$export_for{$caller}};
1437}
1438
1439sub Dumper {
1440 require Data::Dumper;
1441 local $Data::Dumper::Indent = 0;
1442 local $Data::Dumper::Sortkeys = 0;
1443 local $Data::Dumper::Quotekeys = 0;
1444 local $Data::Dumper::Terse = 1;
1445
1446 Data::Dumper::Dumper(@_)
1447}
1448
1449BEGIN {
1450 if ($] >= 5.010) {
1451 { local $@; require mro; }
1452 }
1453 else {
1454 local $@;
1455 eval {
1456 require MRO::Compat;
1457 } or do {
1458 *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub {
1459 no strict 'refs';
1460
1461 my $classname = shift;
1462
1463 my @lin = ($classname);
1464 my %stored;
1465 foreach my $parent (@{"$classname\::ISA"}) {
1466 my $plin = mro::get_linear_isa_dfs($parent);
1467 foreach (@$plin) {
1468 next if exists $stored{$_};
1469 push(@lin, $_);
1470 $stored{$_} = 1;
1471 }
1472 }
1473 return \@lin;
1474 };
1475 }
1476 }
1477}
1478
1479}
14801;
1481}
1482# ###########################################################################
1483# End Mo package
1484# ###########################################################################
1485# ###########################################################################
1037# VersionParser package1486# VersionParser package
1038# This package is a copy without comments from the original. The original1487# This package is a copy without comments from the original. The original
1039# with comments and its test file can be found in the Bazaar repository at,1488# with comments and its test file can be found in the Bazaar repository at,
@@ -1044,35 +1493,145 @@
1044{1493{
1045package VersionParser;1494package VersionParser;
10461495
1047use strict;1496use Mo;
1048use warnings FATAL => 'all';1497use Scalar::Util qw(blessed);
1049use English qw(-no_match_vars);1498use English qw(-no_match_vars);
1050use constant PTDEBUG => $ENV{PTDEBUG} || 0;1499use constant PTDEBUG => $ENV{PTDEBUG} || 0;
10511500
1052sub new {1501use overload (
1053 my ( $class ) = @_;1502 '""' => "version",
1054 bless {}, $class;1503 '<=>' => "cmp",
1055}1504 'cmp' => "cmp",
10561505 fallback => 1,
1057sub parse {1506);
1058 my ( $self, $str ) = @_;1507
1059 my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g);1508use Carp ();
1060 PTDEBUG && _d($str, 'parses to', $result);1509
1061 return $result;1510our $VERSION = 0.01;
1062}1511
10631512has major => (
1064sub version_ge {1513 is => 'ro',
1065 my ( $self, $dbh, $target ) = @_;1514 isa => 'Int',
1066 if ( !$self->{$dbh} ) {1515 required => 1,
1067 $self->{$dbh} = $self->parse(1516);
1068 $dbh->selectrow_array('SELECT VERSION()'));1517
1069 }1518has [qw( minor revision )] => (
1070 my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;1519 is => 'ro',
1071 PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);1520 isa => 'Num',
1072 return $result;1521);
1073}1522
10741523has flavor => (
1075sub innodb_version {1524 is => 'ro',
1525 isa => 'Str',
1526 default => sub { 'Unknown' },
1527);
1528
1529has innodb_version => (
1530 is => 'ro',
1531 isa => 'Str',
1532 default => sub { 'NO' },
1533);
1534
1535sub series {
1536 my $self = shift;
1537 return $self->_join_version($self->major, $self->minor);
1538}
1539
1540sub version {
1541 my $self = shift;
1542 return $self->_join_version($self->major, $self->minor, $self->revision);
1543}
1544
1545sub is_in {
1546 my ($self, $target) = @_;
1547
1548 return $self eq $target;
1549}
1550
1551sub _join_version {
1552 my ($self, @parts) = @_;
1553
1554 return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts;
1555}
1556sub _split_version {
1557 my ($self, $str) = @_;
1558 my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g;
1559 return @version_parts[0..2];
1560}
1561
1562sub normalized_version {
1563 my ( $self ) = @_;
1564 my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major,
1565 $self->minor,
1566 $self->revision);
1567 PTDEBUG && _d($self->version, 'normalizes to', $result);
1568 return $result;
1569}
1570
1571sub comment {
1572 my ( $self, $cmd ) = @_;
1573 my $v = $self->normalized_version();
1574
1575 return "/*!$v $cmd */"
1576}
1577
1578my @methods = qw(major minor revision);
1579sub cmp {
1580 my ($left, $right) = @_;
1581 my $right_obj = (blessed($right) && $right->isa(ref($left)))
1582 ? $right
1583 : ref($left)->new($right);
1584
1585 my $retval = 0;
1586 for my $m ( @methods ) {
1587 last unless defined($left->$m) && defined($right_obj->$m);
1588 $retval = $left->$m <=> $right_obj->$m;
1589 last if $retval;
1590 }
1591 return $retval;
1592}
1593
1594sub BUILDARGS {
1595 my $self = shift;
1596
1597 if ( @_ == 1 ) {
1598 my %args;
1599 if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) {
1600 PTDEBUG && _d("VersionParser got a dbh, trying to get the version");
1601 my $dbh = $_[0];
1602 local $dbh->{FetchHashKeyName} = 'NAME_lc';
1603 my $query = eval {
1604 $dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} })
1605 };
1606 if ( $query ) {
1607 $query = { map { $_->{variable_name} => $_->{value} } @$query };
1608 @args{@methods} = $self->_split_version($query->{version});
1609 $args{flavor} = delete $query->{version_comment}
1610 if $query->{version_comment};
1611 }
1612 elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) {
1613 @args{@methods} = $self->_split_version($query);
1614 }
1615 else {
1616 Carp::confess("Couldn't get the version from the dbh while "
1617 . "creating a VersionParser object: $@");
1618 }
1619 $args{innodb_version} = eval { $self->_innodb_version($dbh) };
1620 }
1621 elsif ( !ref($_[0]) ) {
1622 @args{@methods} = $self->_split_version($_[0]);
1623 }
1624
1625 for my $method (@methods) {
1626 delete $args{$method} unless defined $args{$method};
1627 }
1628 @_ = %args if %args;
1629 }
1630
1631 return $self->SUPER::BUILDARGS(@_);
1632}
1633
1634sub _innodb_version {
1076 my ( $self, $dbh ) = @_;1635 my ( $self, $dbh ) = @_;
1077 return unless $dbh;1636 return unless $dbh;
1078 my $innodb_version = "NO";1637 my $innodb_version = "NO";
@@ -1110,6 +1669,7 @@
1110 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";1669 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
1111}1670}
11121671
1672no Mo;
11131;16731;
1114}1674}
1115# ###########################################################################1675# ###########################################################################
@@ -1187,6 +1747,48 @@
1187 return $db ? "$db.$tbl" : $tbl;1747 return $db ? "$db.$tbl" : $tbl;
1188}1748}
11891749
1750sub serialize_list {
1751 my ( $self, @args ) = @_;
1752 return unless @args;
1753
1754 return $args[0] if @args == 1 && !defined $args[0];
1755
1756 die "Cannot serialize multiple values with undef/NULL"
1757 if grep { !defined $_ } @args;
1758
1759 return join ',', map { quotemeta } @args;
1760}
1761
1762sub deserialize_list {
1763 my ( $self, $string ) = @_;
1764 return $string unless defined $string;
1765 my @escaped_parts = $string =~ /
1766 \G # Start of string, or end of previous match.
1767 ( # Each of these is an element in the original list.
1768 [^\\,]* # Anything not a backslash or a comma
1769 (?: # When we get here, we found one of the above.
1770 \\. # A backslash followed by something so we can continue
1771 [^\\,]* # Same as above.
1772 )* # Repeat zero of more times.
1773 )
1774 , # Comma dividing elements
1775 /sxgc;
1776
1777 push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
1778
1779 my @unescaped_parts = map {
1780 my $part = $_;
1781
1782 my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
1783 ? qr/(?=\p{ASCII})\W/ # We only care about non-word
1784 : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
1785 $part =~ s/\\($char_class)/$1/g;
1786 $part;
1787 } @escaped_parts;
1788
1789 return @unescaped_parts;
1790}
1791
11901;17921;
1191}1793}
1192# ###########################################################################1794# ###########################################################################
@@ -1422,51 +2024,10 @@
1422 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 2024 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
1423 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));2025 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
14242026
1425 eval {2027 $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
1426 $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);2028
1427
1428 if ( $cxn_string =~ m/mysql/i ) {
1429 my $sql;
1430
1431 $sql = 'SELECT @@SQL_MODE';
1432 PTDEBUG && _d($dbh, $sql);
1433 my ($sql_mode) = $dbh->selectrow_array($sql);
1434
1435 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
1436 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
1437 . ($sql_mode ? ",$sql_mode" : '')
1438 . '\'*/';
1439 PTDEBUG && _d($dbh, $sql);
1440 $dbh->do($sql);
1441
1442 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
1443 $sql = "/*!40101 SET NAMES $charset*/";
1444 PTDEBUG && _d($dbh, ':', $sql);
1445 $dbh->do($sql);
1446 PTDEBUG && _d('Enabling charset for STDOUT');
1447 if ( $charset eq 'utf8' ) {
1448 binmode(STDOUT, ':utf8')
1449 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
1450 }
1451 else {
1452 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
1453 }
1454 }
1455
1456 if ( $self->prop('set-vars') ) {
1457 $sql = "SET " . $self->prop('set-vars');
1458 PTDEBUG && _d($dbh, ':', $sql);
1459 $dbh->do($sql);
1460 }
1461 }
1462 };
1463 if ( !$dbh && $EVAL_ERROR ) {2029 if ( !$dbh && $EVAL_ERROR ) {
1464 PTDEBUG && _d($EVAL_ERROR);2030 if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1465 if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
1466 PTDEBUG && _d('Going to try again without utf8 support');
1467 delete $defaults->{mysql_enable_utf8};
1468 }
1469 elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1470 die "Cannot connect to MySQL because the Perl DBD::mysql module is "2031 die "Cannot connect to MySQL because the Perl DBD::mysql module is "
1471 . "not installed or not found. Run 'perl -MDBD::mysql' to see "2032 . "not installed or not found. Run 'perl -MDBD::mysql' to see "
1472 . "the directories that Perl searches for DBD::mysql. If "2033 . "the directories that Perl searches for DBD::mysql. If "
@@ -1475,19 +2036,70 @@
1475 . " RHEL/CentOS yum install perl-DBD-MySQL\n"2036 . " RHEL/CentOS yum install perl-DBD-MySQL\n"
1476 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";2037 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
1477 }2038 }
2039 elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
2040 PTDEBUG && _d('Going to try again without utf8 support');
2041 delete $defaults->{mysql_enable_utf8};
2042 }
1478 if ( !$tries ) {2043 if ( !$tries ) {
1479 die $EVAL_ERROR;2044 die $EVAL_ERROR;
1480 }2045 }
1481 }2046 }
1482 }2047 }
14832048
2049 if ( $cxn_string =~ m/mysql/i ) {
2050 my $sql;
2051
2052 $sql = 'SELECT @@SQL_MODE';
2053 PTDEBUG && _d($dbh, $sql);
2054 my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
2055 if ( $EVAL_ERROR ) {
2056 die $EVAL_ERROR;
2057 }
2058
2059 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
2060 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
2061 . ($sql_mode ? ",$sql_mode" : '')
2062 . '\'*/';
2063 PTDEBUG && _d($dbh, $sql);
2064 eval { $dbh->do($sql) };
2065 if ( $EVAL_ERROR ) {
2066 die $EVAL_ERROR;
2067 }
2068
2069 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
2070 $sql = "/*!40101 SET NAMES $charset*/";
2071 PTDEBUG && _d($dbh, ':', $sql);
2072 eval { $dbh->do($sql) };
2073 if ( $EVAL_ERROR ) {
2074 die $EVAL_ERROR;
2075 }
2076 PTDEBUG && _d('Enabling charset for STDOUT');
2077 if ( $charset eq 'utf8' ) {
2078 binmode(STDOUT, ':utf8')
2079 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
2080 }
2081 else {
2082 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
2083 }
2084 }
2085
2086 if ( $self->prop('set-vars') ) {
2087 $sql = "SET " . $self->prop('set-vars');
2088 PTDEBUG && _d($dbh, ':', $sql);
2089 eval { $dbh->do($sql) };
2090 if ( $EVAL_ERROR ) {
2091 die $EVAL_ERROR;
2092 }
2093 }
2094 }
2095
1484 PTDEBUG && _d('DBH info: ',2096 PTDEBUG && _d('DBH info: ',
1485 $dbh,2097 $dbh,
1486 Dumper($dbh->selectrow_hashref(2098 Dumper($dbh->selectrow_hashref(
1487 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),2099 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
1488 'Connection info:', $dbh->{mysql_hostinfo},2100 'Connection info:', $dbh->{mysql_hostinfo},
1489 'Character set info:', Dumper($dbh->selectall_arrayref(2101 'Character set info:', Dumper($dbh->selectall_arrayref(
1490 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})),2102 "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})),
1491 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,2103 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,
1492 '$DBI::VERSION:', $DBI::VERSION,2104 '$DBI::VERSION:', $DBI::VERSION,
1493 );2105 );
@@ -1773,7 +2385,7 @@
17732385
1774# Some common patterns and variables2386# Some common patterns and variables
1775my $d = qr/(\d+)/; # Digit2387my $d = qr/(\d+)/; # Digit
1776my $t = qr/(\d+ \d+)/; # Transaction ID2388my $t = qr/((?:\d+ \d+)|(?:[A-Fa-f0-9]+))/; # Transaction ID
1777my $i = qr/((?:\d{1,3}\.){3}\d+)/; # IP address2389my $i = qr/((?:\d{1,3}\.){3}\d+)/; # IP address
1778my $n = qr/([^`\s]+)/; # MySQL object name2390my $n = qr/([^`\s]+)/; # MySQL object name
1779my $w = qr/(\w+)/; # Words2391my $w = qr/(\w+)/; # Words
@@ -1816,7 +2428,6 @@
1816 @ARGV = @_; # set global ARGV for this package2428 @ARGV = @_; # set global ARGV for this package
18172429
1818 my $q = new Quoter();2430 my $q = new Quoter();
1819 my $vp = new VersionParser();
18202431
1821 # ########################################################################2432 # ########################################################################
1822 # Get configuration information.2433 # Get configuration information.
@@ -1969,7 +2580,7 @@
1969 $dbh->{AutoCommit} = 0;2580 $dbh->{AutoCommit} = 0;
1970 my $sql = $o->read_para_after(__FILE__, qr/MAGIC_clear_deadlocks/);2581 my $sql = $o->read_para_after(__FILE__, qr/MAGIC_clear_deadlocks/);
19712582
1972 if ( !$vp->version_ge($dbh, '4.1.2') ) {2583 if ( VersionParser->new($dbh) < '4.1.2') {
1973 $sql =~ s/ENGINE=/TYPE=/;2584 $sql =~ s/ENGINE=/TYPE=/;
1974 }2585 }
1975 $sql =~ s/test.deadlock_maker/$db_tbl/;2586 $sql =~ s/test.deadlock_maker/$db_tbl/;
@@ -1987,7 +2598,7 @@
1987 PTDEBUG && _d($sql);2598 PTDEBUG && _d($sql);
1988 eval { $dbh_child->do($sql); }; # Should block against parent.2599 eval { $dbh_child->do($sql); }; # Should block against parent.
1989 PTDEBUG && _d($EVAL_ERROR); # Parent inserted value 0.2600 PTDEBUG && _d($EVAL_ERROR); # Parent inserted value 0.
1990 $sql = "DROP TABLE $db_tbl";2601 $sql = "COMMIT";
1991 PTDEBUG && _d($sql);2602 PTDEBUG && _d($sql);
1992 $dbh_child->do($sql);2603 $dbh_child->do($sql);
1993 exit;2604 exit;
@@ -2001,6 +2612,9 @@
2001 eval { $dbh->do($sql); };2612 eval { $dbh->do($sql); };
2002 PTDEBUG && _d($EVAL_ERROR);2613 PTDEBUG && _d($EVAL_ERROR);
2003 waitpid($pid, 0);2614 waitpid($pid, 0);
2615 $sql = "DROP TABLE $db_tbl";
2616 PTDEBUG && _d($sql);
2617 $dbh->do($sql);
2004 }2618 }
2005 2619
2006 # If there's an --interval argument, run forever or till specified.2620 # If there's an --interval argument, run forever or till specified.
@@ -2030,6 +2644,7 @@
2030 while ( my ( $start, $name, $text, $end ) = splice(@matches, 0, 4) ) {2644 while ( my ( $start, $name, $text, $end ) = splice(@matches, 0, 4) ) {
2031 next unless $name eq 'LATEST DETECTED DEADLOCK';2645 next unless $name eq 'LATEST DETECTED DEADLOCK';
2032 $dl_text = $text;2646 $dl_text = $text;
2647 last;
2033 }2648 }
20342649
2035 return {} unless $dl_text;2650 return {} unless $dl_text;
@@ -2748,6 +3363,10 @@
27483363
2749=head1 VERSION3364=head1 VERSION
27503365
3366<<<<<<< TREE
2751pt-deadlock-logger 2.0.53367pt-deadlock-logger 2.0.5
3368=======
3369pt-deadlock-logger 2.1.2
3370>>>>>>> MERGE-SOURCE
27523371
2753=cut3372=cut
27543373
=== modified file 'bin/pt-diskstats'
--- bin/pt-diskstats 2012-06-09 21:53:04 +0000
+++ bin/pt-diskstats 2012-07-20 22:10:28 +0000
@@ -6,7 +6,7 @@
66
7use strict;7use strict;
8use warnings FATAL => 'all';8use warnings FATAL => 'all';
9use constant MKDEBUG => $ENV{MKDEBUG} || 0;9use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1010
11# %INC magic to allow us to require/use these even within the big file.11# %INC magic to allow us to require/use these even within the big file.
12BEGIN {12BEGIN {
@@ -1058,6 +1058,7 @@
10581058
1059use Time::Local qw(timegm timelocal);1059use Time::Local qw(timegm timelocal);
1060use Digest::MD5 qw(md5_hex);1060use Digest::MD5 qw(md5_hex);
1061use B qw();
10611062
1062require Exporter;1063require Exporter;
1063our @ISA = qw(Exporter);1064our @ISA = qw(Exporter);
@@ -1075,6 +1076,7 @@
1075 any_unix_timestamp1076 any_unix_timestamp
1076 make_checksum1077 make_checksum
1077 crc321078 crc32
1079 encode_json
1078);1080);
10791081
1080our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;1082our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/;
@@ -1282,6 +1284,96 @@
1282 return $crc ^ 0xFFFFFFFF;1284 return $crc ^ 0xFFFFFFFF;
1283}1285}
12841286
1287my $got_json = eval { require JSON };
1288sub encode_json {
1289 return JSON::encode_json(@_) if $got_json;
1290 my ( $data ) = @_;
1291 return (object_to_json($data) || '');
1292}
1293
1294
1295sub object_to_json {
1296 my ($obj) = @_;
1297 my $type = ref($obj);
1298
1299 if($type eq 'HASH'){
1300 return hash_to_json($obj);
1301 }
1302 elsif($type eq 'ARRAY'){
1303 return array_to_json($obj);
1304 }
1305 else {
1306 return value_to_json($obj);
1307 }
1308}
1309
1310sub hash_to_json {
1311 my ($obj) = @_;
1312 my @res;
1313 for my $k ( sort { $a cmp $b } keys %$obj ) {
1314 push @res, string_to_json( $k )
1315 . ":"
1316 . ( object_to_json( $obj->{$k} ) || value_to_json( $obj->{$k} ) );
1317 }
1318 return '{' . ( @res ? join( ",", @res ) : '' ) . '}';
1319}
1320
1321sub array_to_json {
1322 my ($obj) = @_;
1323 my @res;
1324
1325 for my $v (@$obj) {
1326 push @res, object_to_json($v) || value_to_json($v);
1327 }
1328
1329 return '[' . ( @res ? join( ",", @res ) : '' ) . ']';
1330}
1331
1332sub value_to_json {
1333 my ($value) = @_;
1334
1335 return 'null' if(!defined $value);
1336
1337 my $b_obj = B::svref_2object(\$value); # for round trip problem
1338 my $flags = $b_obj->FLAGS;
1339 return $value # as is
1340 if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV?
1341
1342 my $type = ref($value);
1343
1344 if( !$type ) {
1345 return string_to_json($value);
1346 }
1347 else {
1348 return 'null';
1349 }
1350
1351}
1352
1353my %esc = (
1354 "\n" => '\n',
1355 "\r" => '\r',
1356 "\t" => '\t',
1357 "\f" => '\f',
1358 "\b" => '\b',
1359 "\"" => '\"',
1360 "\\" => '\\\\',
1361 "\'" => '\\\'',
1362);
1363
1364sub string_to_json {
1365 my ($arg) = @_;
1366
1367 $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
1368 $arg =~ s/\//\\\//g;
1369 $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;
1370
1371 utf8::upgrade($arg);
1372 utf8::encode($arg);
1373
1374 return '"' . $arg . '"';
1375}
1376
1285sub _d {1377sub _d {
1286 my ($package, undef, $line) = caller 0;1378 my ($package, undef, $line) = caller 0;
1287 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }1379 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -1319,9 +1411,10 @@
1319use warnings;1411use warnings;
1320use strict;1412use strict;
1321use English qw(-no_match_vars);1413use English qw(-no_match_vars);
1322use constant MKDEBUG => $ENV{MKDEBUG} || 0;1414use constant PTDEBUG => $ENV{PTDEBUG} || 0;
13231415
1324use POSIX qw( :termios_h );1416use POSIX qw( :termios_h );
1417use Fcntl qw( F_SETFL F_GETFL );
13251418
1326use base qw( Exporter );1419use base qw( Exporter );
13271420
@@ -1344,8 +1437,12 @@
1344# This primarily comes from the Perl Cookbook, recipe 15.81437# This primarily comes from the Perl Cookbook, recipe 15.8
13451438
1346{1439{
1347
1348 my $fd_stdin = fileno(STDIN);1440 my $fd_stdin = fileno(STDIN);
1441 my $flags;
1442 unless ( $PerconaTest::DONT_RESTORE_STDIN ) {
1443 $flags = fcntl(STDIN, F_GETFL, 0)
1444 or die "can't fcntl F_GETFL: $!";
1445 }
1349 my $term = POSIX::Termios->new();1446 my $term = POSIX::Termios->new();
1350 $term->getattr($fd_stdin);1447 $term->getattr($fd_stdin);
1351 my $oterm = $term->getlflag();1448 my $oterm = $term->getlflag();
@@ -1376,6 +1473,10 @@
1376 $term->setlflag($oterm);1473 $term->setlflag($oterm);
1377 $term->setcc( VTIME, 0 );1474 $term->setcc( VTIME, 0 );
1378 $term->setattr( $fd_stdin, TCSANOW );1475 $term->setattr( $fd_stdin, TCSANOW );
1476 unless ( $PerconaTest::DONT_RESTORE_STDIN ) {
1477 fcntl(STDIN, F_SETFL, $flags)
1478 or die "can't fcntl F_SETFL: $!";
1479 }
1379 }1480 }
13801481
1381 END { cooked() }1482 END { cooked() }
@@ -2480,7 +2581,7 @@
2480use warnings;2581use warnings;
2481use strict;2582use strict;
2482use English qw(-no_match_vars);2583use English qw(-no_match_vars);
2483use constant MKDEBUG => $ENV{MKDEBUG} || 0;2584use constant PTDEBUG => $ENV{PTDEBUG} || 0;
24842585
2485use base qw( Diskstats );2586use base qw( Diskstats );
24862587
@@ -2553,7 +2654,7 @@
2553use warnings;2654use warnings;
2554use strict;2655use strict;
2555use English qw(-no_match_vars);2656use English qw(-no_match_vars);
2556use constant MKDEBUG => $ENV{MKDEBUG} || 0;2657use constant PTDEBUG => $ENV{PTDEBUG} || 0;
25572658
2558use base qw( Diskstats );2659use base qw( Diskstats );
25592660
@@ -3407,7 +3508,7 @@
3407use constant PTDEBUG => $ENV{PTDEBUG} || 0;3508use constant PTDEBUG => $ENV{PTDEBUG} || 0;
34083509
3409sub main {3510sub main {
3410 @ARGV = @_; # set global ARGV for this package3511 local @ARGV = @_; # set global ARGV for this package
34113512
3412 # ########################################################################3513 # ########################################################################
3413 # Get configuration information.3514 # Get configuration information.
@@ -4106,6 +4207,10 @@
41064207
4107=head1 VERSION4208=head1 VERSION
41084209
4210<<<<<<< TREE
4109pt-diskstats 2.0.54211pt-diskstats 2.0.5
4212=======
4213pt-diskstats 2.1.2
4214>>>>>>> MERGE-SOURCE
41104215
4111=cut4216=cut
41124217
=== modified file 'bin/pt-duplicate-key-checker'
--- bin/pt-duplicate-key-checker 2012-06-09 21:53:04 +0000
+++ bin/pt-duplicate-key-checker 2012-07-20 22:10:28 +0000
@@ -9,89 +9,6 @@
9use constant PTDEBUG => $ENV{PTDEBUG} || 0;9use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1010
11# ###########################################################################11# ###########################################################################
12# VersionParser package
13# This package is a copy without comments from the original. The original
14# with comments and its test file can be found in the Bazaar repository at,
15# lib/VersionParser.pm
16# t/lib/VersionParser.t
17# See https://launchpad.net/percona-toolkit for more information.
18# ###########################################################################
19{
20package VersionParser;
21
22use strict;
23use warnings FATAL => 'all';
24use English qw(-no_match_vars);
25use constant PTDEBUG => $ENV{PTDEBUG} || 0;
26
27sub new {
28 my ( $class ) = @_;
29 bless {}, $class;
30}
31
32sub parse {
33 my ( $self, $str ) = @_;
34 my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g);
35 PTDEBUG && _d($str, 'parses to', $result);
36 return $result;
37}
38
39sub version_ge {
40 my ( $self, $dbh, $target ) = @_;
41 if ( !$self->{$dbh} ) {
42 $self->{$dbh} = $self->parse(
43 $dbh->selectrow_array('SELECT VERSION()'));
44 }
45 my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
46 PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);
47 return $result;
48}
49
50sub innodb_version {
51 my ( $self, $dbh ) = @_;
52 return unless $dbh;
53 my $innodb_version = "NO";
54
55 my ($innodb) =
56 grep { $_->{engine} =~ m/InnoDB/i }
57 map {
58 my %hash;
59 @hash{ map { lc $_ } keys %$_ } = values %$_;
60 \%hash;
61 }
62 @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) };
63 if ( $innodb ) {
64 PTDEBUG && _d("InnoDB support:", $innodb->{support});
65 if ( $innodb->{support} =~ m/YES|DEFAULT/i ) {
66 my $vars = $dbh->selectrow_hashref(
67 "SHOW VARIABLES LIKE 'innodb_version'");
68 $innodb_version = !$vars ? "BUILTIN"
69 : ($vars->{Value} || $vars->{value});
70 }
71 else {
72 $innodb_version = $innodb->{support}; # probably DISABLED or NO
73 }
74 }
75
76 PTDEBUG && _d("InnoDB version:", $innodb_version);
77 return $innodb_version;
78}
79
80sub _d {
81 my ($package, undef, $line) = caller 0;
82 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
83 map { defined $_ ? $_ : 'undef' }
84 @_;
85 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
86}
87
881;
89}
90# ###########################################################################
91# End VersionParser package
92# ###########################################################################
93
94# ###########################################################################
95# Quoter package12# Quoter package
96# This package is a copy without comments from the original. The original13# This package is a copy without comments from the original. The original
97# with comments and its test file can be found in the Bazaar repository at,14# with comments and its test file can be found in the Bazaar repository at,
@@ -162,6 +79,48 @@
162 return $db ? "$db.$tbl" : $tbl;79 return $db ? "$db.$tbl" : $tbl;
163}80}
16481
82sub serialize_list {
83 my ( $self, @args ) = @_;
84 return unless @args;
85
86 return $args[0] if @args == 1 && !defined $args[0];
87
88 die "Cannot serialize multiple values with undef/NULL"
89 if grep { !defined $_ } @args;
90
91 return join ',', map { quotemeta } @args;
92}
93
94sub deserialize_list {
95 my ( $self, $string ) = @_;
96 return $string unless defined $string;
97 my @escaped_parts = $string =~ /
98 \G # Start of string, or end of previous match.
99 ( # Each of these is an element in the original list.
100 [^\\,]* # Anything not a backslash or a comma
101 (?: # When we get here, we found one of the above.
102 \\. # A backslash followed by something so we can continue
103 [^\\,]* # Same as above.
104 )* # Repeat zero of more times.
105 )
106 , # Comma dividing elements
107 /sxgc;
108
109 push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
110
111 my @unescaped_parts = map {
112 my $part = $_;
113
114 my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
115 ? qr/(?=\p{ASCII})\W/ # We only care about non-word
116 : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
117 $part =~ s/\\($char_class)/$1/g;
118 $part;
119 } @escaped_parts;
120
121 return @unescaped_parts;
122}
123
1651;1241;
166}125}
167# ###########################################################################126# ###########################################################################
@@ -199,23 +158,64 @@
199 return bless $self, $class;158 return bless $self, $class;
200}159}
201160
161sub get_create_table {
162 my ( $self, $dbh, $db, $tbl ) = @_;
163 die "I need a dbh parameter" unless $dbh;
164 die "I need a db parameter" unless $db;
165 die "I need a tbl parameter" unless $tbl;
166 my $q = $self->{Quoter};
167
168 my $new_sql_mode
169 = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
170 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
171 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
172 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
173
174 my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
175 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
176
177 PTDEBUG && _d($new_sql_mode);
178 eval { $dbh->do($new_sql_mode); };
179 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
180
181 my $use_sql = 'USE ' . $q->quote($db);
182 PTDEBUG && _d($dbh, $use_sql);
183 $dbh->do($use_sql);
184
185 my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl);
186 PTDEBUG && _d($show_sql);
187 my $href;
188 eval { $href = $dbh->selectrow_hashref($show_sql); };
189 if ( $EVAL_ERROR ) {
190 PTDEBUG && _d($EVAL_ERROR);
191
192 PTDEBUG && _d($old_sql_mode);
193 $dbh->do($old_sql_mode);
194
195 return;
196 }
197
198 PTDEBUG && _d($old_sql_mode);
199 $dbh->do($old_sql_mode);
200
201 my ($key) = grep { m/create (?:table|view)/i } keys %$href;
202 if ( !$key ) {
203 die "Error: no 'Create Table' or 'Create View' in result set from "
204 . "$show_sql: " . Dumper($href);
205 }
206
207 return $href->{$key};
208}
209
202sub parse {210sub parse {
203 my ( $self, $ddl, $opts ) = @_;211 my ( $self, $ddl, $opts ) = @_;
204 return unless $ddl;212 return unless $ddl;
205 if ( ref $ddl eq 'ARRAY' ) {213
206 if ( lc $ddl->[0] eq 'table' ) {214 if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) {
207 $ddl = $ddl->[1];215 $ddl = $self->ansi_to_legacy($ddl);
208 }
209 else {
210 return {
211 engine => 'VIEW',
212 };
213 }
214 }216 }
215217 elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {
216 if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {218 die "TableParser doesn't handle CREATE TABLE without quoting.";
217 die "Cannot parse table definition; is ANSI quoting "
218 . "enabled or SQL_QUOTE_SHOW_CREATE disabled?";
219 }219 }
220220
221 my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;221 my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;
@@ -424,19 +424,13 @@
424 my $key_ddl = $key;424 my $key_ddl = $key;
425 PTDEBUG && _d('Parsed key:', $key_ddl);425 PTDEBUG && _d('Parsed key:', $key_ddl);
426426
427 if ( $engine !~ m/MEMORY|HEAP/ ) {427 if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) {
428 $key =~ s/USING HASH/USING BTREE/;428 $key =~ s/USING HASH/USING BTREE/;
429 }429 }
430430
431 my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;431 my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;
432 my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;432 my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;
433 $type = $type || $special || 'BTREE';433 $type = $type || $special || 'BTREE';
434 if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000'
435 && $engine =~ m/HEAP|MEMORY/i )
436 {
437 $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP
438 }
439
440 my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;434 my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;
441 my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;435 my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;
442 my @cols;436 my @cols;
@@ -462,7 +456,7 @@
462 ddl => $key_ddl,456 ddl => $key_ddl,
463 };457 };
464458
465 if ( $engine =~ m/InnoDB/i && !$clustered_key ) {459 if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) {
466 my $this_key = $keys->{$name};460 my $this_key = $keys->{$name};
467 if ( $this_key->{name} eq 'PRIMARY' ) {461 if ( $this_key->{name} eq 'PRIMARY' ) {
468 $clustered_key = 'PRIMARY';462 $clustered_key = 'PRIMARY';
@@ -518,41 +512,46 @@
518 return $ddl;512 return $ddl;
519}513}
520514
521sub remove_secondary_indexes {515sub get_table_status {
522 my ( $self, $ddl ) = @_;516 my ( $self, $dbh, $db, $like ) = @_;
523 my $sec_indexes_ddl;517 my $q = $self->{Quoter};
524 my $tbl_struct = $self->parse($ddl);518 my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db);
525519 my @params;
526 if ( ($tbl_struct->{engine} || '') =~ m/InnoDB/i ) {520 if ( $like ) {
527 my $clustered_key = $tbl_struct->{clustered_key};521 $sql .= ' LIKE ?';
528 $clustered_key ||= '';522 push @params, $like;
529523 }
530 my @sec_indexes = map {524 PTDEBUG && _d($sql, @params);
531 my $key_def = $_->{ddl};525 my $sth = $dbh->prepare($sql);
532 $key_def =~ s/([\(\)])/\\$1/g;526 eval { $sth->execute(@params); };
533 $ddl =~ s/\s+$key_def//i;527 if ($EVAL_ERROR) {
534528 PTDEBUG && _d($EVAL_ERROR);
535 my $key_ddl = "ADD $_->{ddl}";529 return;
536 $key_ddl .= ',' unless $key_ddl =~ m/,$/;530 }
537 $key_ddl;531 my @tables = @{$sth->fetchall_arrayref({})};
538 }532 @tables = map {
539 grep { $_->{name} ne $clustered_key }533 my %tbl; # Make a copy with lowercased keys
540 values %{$tbl_struct->{keys}};534 @tbl{ map { lc $_ } keys %$_ } = values %$_;
541 PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes));535 $tbl{engine} ||= $tbl{type} || $tbl{comment};
542536 delete $tbl{type};
543 if ( @sec_indexes ) {537 \%tbl;
544 $sec_indexes_ddl = join(' ', @sec_indexes);538 } @tables;
545 $sec_indexes_ddl =~ s/,$//;539 return @tables;
546 }540}
547541
548 $ddl =~ s/,(\n\) )/$1/s;542my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx;
549 }543sub ansi_to_legacy {
550 else {544 my ($self, $ddl) = @_;
551 PTDEBUG && _d('Not removing secondary indexes from',545 $ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge;
552 $tbl_struct->{engine}, 'table');546 return $ddl;
553 }547}
554548
555 return $ddl, $sec_indexes_ddl, $tbl_struct;549sub ansi_quote_replace {
550 my ($val) = @_;
551 $val =~ s/^"|"$//g;
552 $val =~ s/`/``/g;
553 $val =~ s/""/"/g;
554 return "`$val`";
556}555}
557556
558sub _d {557sub _d {
@@ -570,311 +569,6 @@
570# ###########################################################################569# ###########################################################################
571570
572# ###########################################################################571# ###########################################################################
573# MySQLDump package
574# This package is a copy without comments from the original. The original
575# with comments and its test file can be found in the Bazaar repository at,
576# lib/MySQLDump.pm
577# t/lib/MySQLDump.t
578# See https://launchpad.net/percona-toolkit for more information.
579# ###########################################################################
580{
581package MySQLDump;
582
583use strict;
584use warnings FATAL => 'all';
585use English qw(-no_match_vars);
586use constant PTDEBUG => $ENV{PTDEBUG} || 0;
587
588( our $before = <<'EOF') =~ s/^ //gm;
589 /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
590 /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
591 /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
592 /*!40101 SET NAMES utf8 */;
593 /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
594 /*!40103 SET TIME_ZONE='+00:00' */;
595 /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
596 /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
597 /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
598 /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;
599EOF
600
601( our $after = <<'EOF') =~ s/^ //gm;
602 /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
603 /*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
604 /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
605 /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
606 /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
607 /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
608 /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
609 /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;
610EOF
611
612sub new {
613 my ( $class, %args ) = @_;
614 my $self = {
615 cache => 0, # Afaik no script uses this cache any longer because
616 };
617 return bless $self, $class;
618}
619
620sub dump {
621 my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_;
622
623 if ( $what eq 'table' ) {
624 my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
625 return unless $ddl;
626 if ( $ddl->[0] eq 'table' ) {
627 return $before
628 . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
629 . $ddl->[1] . ";\n";
630 }
631 else {
632 return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
633 . '/*!50001 DROP VIEW IF EXISTS '
634 . $quoter->quote($tbl) . "*/;\n/*!50001 "
635 . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n";
636 }
637 }
638 elsif ( $what eq 'triggers' ) {
639 my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl);
640 if ( $trgs && @$trgs ) {
641 my $result = $before . "\nDELIMITER ;;\n";
642 foreach my $trg ( @$trgs ) {
643 if ( $trg->{sql_mode} ) {
644 $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n};
645 }
646 $result .= "/*!50003 CREATE */ ";
647 if ( $trg->{definer} ) {
648 my ( $user, $host )
649 = map { s/'/''/g; "'$_'"; }
650 split('@', $trg->{definer}, 2);
651 $result .= "/*!50017 DEFINER=$user\@$host */ ";
652 }
653 $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n",
654 $quoter->quote($trg->{trigger}),
655 @{$trg}{qw(timing event)},
656 $quoter->quote($trg->{table}),
657 $trg->{statement});
658 }
659 $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n";
660 return $result;
661 }
662 else {
663 return undef;
664 }
665 }
666 elsif ( $what eq 'view' ) {
667 my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
668 return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
669 . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
670 . '/*!50001 ' . $ddl->[1] . "*/;\n";
671 }
672 else {
673 die "You didn't say what to dump.";
674 }
675}
676
677sub _use_db {
678 my ( $self, $dbh, $quoter, $new ) = @_;
679 if ( !$new ) {
680 PTDEBUG && _d('No new DB to use');
681 return;
682 }
683 my $sql = 'USE ' . $quoter->quote($new);
684 PTDEBUG && _d($dbh, $sql);
685 $dbh->do($sql);
686 return;
687}
688
689sub get_create_table {
690 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
691 if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) {
692 my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
693 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
694 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
695 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
696 PTDEBUG && _d($sql);
697 eval { $dbh->do($sql); };
698 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
699 $self->_use_db($dbh, $quoter, $db);
700 $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl);
701 PTDEBUG && _d($sql);
702 my $href;
703 eval { $href = $dbh->selectrow_hashref($sql); };
704 if ( $EVAL_ERROR ) {
705 warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR";
706 return;
707 }
708
709 $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
710 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
711 PTDEBUG && _d($sql);
712 $dbh->do($sql);
713 my ($key) = grep { m/create table/i } keys %$href;
714 if ( $key ) {
715 PTDEBUG && _d('This table is a base table');
716 $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ];
717 }
718 else {
719 PTDEBUG && _d('This table is a view');
720 ($key) = grep { m/create view/i } keys %$href;
721 $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ];
722 }
723 }
724 return $self->{tables}->{$db}->{$tbl};
725}
726
727sub get_columns {
728 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
729 PTDEBUG && _d('Get columns for', $db, $tbl);
730 if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) {
731 $self->_use_db($dbh, $quoter, $db);
732 my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl);
733 PTDEBUG && _d($sql);
734 my $cols = $dbh->selectall_arrayref($sql, { Slice => {} });
735
736 $self->{columns}->{$db}->{$tbl} = [
737 map {
738 my %row;
739 @row{ map { lc $_ } keys %$_ } = values %$_;
740 \%row;
741 } @$cols
742 ];
743 }
744 return $self->{columns}->{$db}->{$tbl};
745}
746
747sub get_tmp_table {
748 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
749 my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n";
750 $result .= join(",\n",
751 map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} }
752 @{$self->get_columns($dbh, $quoter, $db, $tbl)});
753 $result .= "\n)";
754 PTDEBUG && _d($result);
755 return $result;
756}
757
758sub get_triggers {
759 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
760 if ( !$self->{cache} || !$self->{triggers}->{$db} ) {
761 $self->{triggers}->{$db} = {};
762 my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
763 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
764 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
765 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
766 PTDEBUG && _d($sql);
767 eval { $dbh->do($sql); };
768 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
769 $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db);
770 PTDEBUG && _d($sql);
771 my $sth = $dbh->prepare($sql);
772 $sth->execute();
773 if ( $sth->rows ) {
774 my $trgs = $sth->fetchall_arrayref({});
775 foreach my $trg (@$trgs) {
776 my %trg;
777 @trg{ map { lc $_ } keys %$trg } = values %$trg;
778 push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg;
779 }
780 }
781 $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
782 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
783 PTDEBUG && _d($sql);
784 $dbh->do($sql);
785 }
786 if ( $tbl ) {
787 return $self->{triggers}->{$db}->{$tbl};
788 }
789 return values %{$self->{triggers}->{$db}};
790}
791
792sub get_databases {
793 my ( $self, $dbh, $quoter, $like ) = @_;
794 if ( !$self->{cache} || !$self->{databases} || $like ) {
795 my $sql = 'SHOW DATABASES';
796 my @params;
797 if ( $like ) {
798 $sql .= ' LIKE ?';
799 push @params, $like;
800 }
801 my $sth = $dbh->prepare($sql);
802 PTDEBUG && _d($sql, @params);
803 $sth->execute( @params );
804 my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()};
805 $self->{databases} = \@dbs unless $like;
806 return @dbs;
807 }
808 return @{$self->{databases}};
809}
810
811sub get_table_status {
812 my ( $self, $dbh, $quoter, $db, $like ) = @_;
813 if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) {
814 my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db);
815 my @params;
816 if ( $like ) {
817 $sql .= ' LIKE ?';
818 push @params, $like;
819 }
820 PTDEBUG && _d($sql, @params);
821 my $sth = $dbh->prepare($sql);
822 $sth->execute(@params);
823 my @tables = @{$sth->fetchall_arrayref({})};
824 @tables = map {
825 my %tbl; # Make a copy with lowercased keys
826 @tbl{ map { lc $_ } keys %$_ } = values %$_;
827 $tbl{engine} ||= $tbl{type} || $tbl{comment};
828 delete $tbl{type};
829 \%tbl;
830 } @tables;
831 $self->{table_status}->{$db} = \@tables unless $like;
832 return @tables;
833 }
834 return @{$self->{table_status}->{$db}};
835}
836
837sub get_table_list {
838 my ( $self, $dbh, $quoter, $db, $like ) = @_;
839 if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) {
840 my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db);
841 my @params;
842 if ( $like ) {
843 $sql .= ' LIKE ?';
844 push @params, $like;
845 }
846 PTDEBUG && _d($sql, @params);
847 my $sth = $dbh->prepare($sql);
848 $sth->execute(@params);
849 my @tables = @{$sth->fetchall_arrayref()};
850 @tables = map {
851 my %tbl = (
852 name => $_->[0],
853 engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '',
854 );
855 \%tbl;
856 } @tables;
857 $self->{table_list}->{$db} = \@tables unless $like;
858 return @tables;
859 }
860 return @{$self->{table_list}->{$db}};
861}
862
863sub _d {
864 my ($package, undef, $line) = caller 0;
865 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
866 map { defined $_ ? $_ : 'undef' }
867 @_;
868 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
869}
870
8711;
872}
873# ###########################################################################
874# End MySQLDump package
875# ###########################################################################
876
877# ###########################################################################
878# DSNParser package572# DSNParser package
879# This package is a copy without comments from the original. The original573# This package is a copy without comments from the original. The original
880# with comments and its test file can be found in the Bazaar repository at,574# with comments and its test file can be found in the Bazaar repository at,
@@ -1103,51 +797,10 @@
1103 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 797 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
1104 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));798 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
1105799
1106 eval {800 $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
1107 $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);801
1108
1109 if ( $cxn_string =~ m/mysql/i ) {
1110 my $sql;
1111
1112 $sql = 'SELECT @@SQL_MODE';
1113 PTDEBUG && _d($dbh, $sql);
1114 my ($sql_mode) = $dbh->selectrow_array($sql);
1115
1116 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
1117 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
1118 . ($sql_mode ? ",$sql_mode" : '')
1119 . '\'*/';
1120 PTDEBUG && _d($dbh, $sql);
1121 $dbh->do($sql);
1122
1123 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
1124 $sql = "/*!40101 SET NAMES $charset*/";
1125 PTDEBUG && _d($dbh, ':', $sql);
1126 $dbh->do($sql);
1127 PTDEBUG && _d('Enabling charset for STDOUT');
1128 if ( $charset eq 'utf8' ) {
1129 binmode(STDOUT, ':utf8')
1130 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
1131 }
1132 else {
1133 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
1134 }
1135 }
1136
1137 if ( $self->prop('set-vars') ) {
1138 $sql = "SET " . $self->prop('set-vars');
1139 PTDEBUG && _d($dbh, ':', $sql);
1140 $dbh->do($sql);
1141 }
1142 }
1143 };
1144 if ( !$dbh && $EVAL_ERROR ) {802 if ( !$dbh && $EVAL_ERROR ) {
1145 PTDEBUG && _d($EVAL_ERROR);803 if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1146 if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
1147 PTDEBUG && _d('Going to try again without utf8 support');
1148 delete $defaults->{mysql_enable_utf8};
1149 }
1150 elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
1151 die "Cannot connect to MySQL because the Perl DBD::mysql module is "804 die "Cannot connect to MySQL because the Perl DBD::mysql module is "
1152 . "not installed or not found. Run 'perl -MDBD::mysql' to see "805 . "not installed or not found. Run 'perl -MDBD::mysql' to see "
1153 . "the directories that Perl searches for DBD::mysql. If "806 . "the directories that Perl searches for DBD::mysql. If "
@@ -1156,19 +809,70 @@
1156 . " RHEL/CentOS yum install perl-DBD-MySQL\n"809 . " RHEL/CentOS yum install perl-DBD-MySQL\n"
1157 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";810 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
1158 }811 }
812 elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
813 PTDEBUG && _d('Going to try again without utf8 support');
814 delete $defaults->{mysql_enable_utf8};
815 }
1159 if ( !$tries ) {816 if ( !$tries ) {
1160 die $EVAL_ERROR;817 die $EVAL_ERROR;
1161 }818 }
1162 }819 }
1163 }820 }
1164821
822 if ( $cxn_string =~ m/mysql/i ) {
823 my $sql;
824
825 $sql = 'SELECT @@SQL_MODE';
826 PTDEBUG && _d($dbh, $sql);
827 my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
828 if ( $EVAL_ERROR ) {
829 die $EVAL_ERROR;
830 }
831
832 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
833 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
834 . ($sql_mode ? ",$sql_mode" : '')
835 . '\'*/';
836 PTDEBUG && _d($dbh, $sql);
837 eval { $dbh->do($sql) };
838 if ( $EVAL_ERROR ) {
839 die $EVAL_ERROR;
840 }
841
842 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
843 $sql = "/*!40101 SET NAMES $charset*/";
844 PTDEBUG && _d($dbh, ':', $sql);
845 eval { $dbh->do($sql) };
846 if ( $EVAL_ERROR ) {
847 die $EVAL_ERROR;
848 }
849 PTDEBUG && _d('Enabling charset for STDOUT');
850 if ( $charset eq 'utf8' ) {
851 binmode(STDOUT, ':utf8')
852 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
853 }
854 else {
855 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
856 }
857 }
858
859 if ( $self->prop('set-vars') ) {
860 $sql = "SET " . $self->prop('set-vars');
861 PTDEBUG && _d($dbh, ':', $sql);
862 eval { $dbh->do($sql) };
863 if ( $EVAL_ERROR ) {
864 die $EVAL_ERROR;
865 }
866 }
867 }
868
1165 PTDEBUG && _d('DBH info: ',869 PTDEBUG && _d('DBH info: ',
1166 $dbh,870 $dbh,
1167 Dumper($dbh->selectrow_hashref(871 Dumper($dbh->selectrow_hashref(
1168 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),872 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
1169 'Connection info:', $dbh->{mysql_hostinfo},873 'Connection info:', $dbh->{mysql_hostinfo},
1170 'Character set info:', Dumper($dbh->selectall_arrayref(874 'Character set info:', Dumper($dbh->selectall_arrayref(
1171 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})),875 "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})),
1172 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,876 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,
1173 '$DBI::VERSION:', $DBI::VERSION,877 '$DBI::VERSION:', $DBI::VERSION,
1174 );878 );
@@ -2186,7 +1890,7 @@
2186 $opt->{value} = ($pre || '') . $num;1890 $opt->{value} = ($pre || '') . $num;
2187 }1891 }
2188 else {1892 else {
2189 $self->save_error("Invalid size for --$opt->{long}");1893 $self->save_error("Invalid size for --$opt->{long}: $val");
2190 }1894 }
2191 return;1895 return;
2192}1896}
@@ -3054,9 +2758,9 @@
3054 ($col, $tbl, $db) = @args{qw(col tbl db)};2758 ($col, $tbl, $db) = @args{qw(col tbl db)};
3055 }2759 }
30562760
3057 $db = lc $db;2761 $db = lc($db || '');
3058 $tbl = lc $tbl;2762 $tbl = lc($tbl || '');
3059 $col = lc $col;2763 $col = lc($col || '');
30602764
3061 if ( !$col ) {2765 if ( !$col ) {
3062 PTDEBUG && _d('No column specified or parsed');2766 PTDEBUG && _d('No column specified or parsed');
@@ -3116,8 +2820,8 @@
3116 ($tbl, $db) = @args{qw(tbl db)};2820 ($tbl, $db) = @args{qw(tbl db)};
3117 }2821 }
31182822
3119 $db = lc $db;2823 $db = lc($db || '');
3120 $tbl = lc $tbl;2824 $tbl = lc($tbl || '');
31212825
3122 if ( !$tbl ) {2826 if ( !$tbl ) {
3123 PTDEBUG && _d('No table specified or parsed');2827 PTDEBUG && _d('No table specified or parsed');
@@ -3200,7 +2904,7 @@
32002904
3201sub new {2905sub new {
3202 my ( $class, %args ) = @_;2906 my ( $class, %args ) = @_;
3203 my @required_args = qw(OptionParser Quoter);2907 my @required_args = qw(OptionParser TableParser Quoter);
3204 foreach my $arg ( @required_args ) {2908 foreach my $arg ( @required_args ) {
3205 die "I need a $arg argument" unless $args{$arg};2909 die "I need a $arg argument" unless $args{$arg};
3206 }2910 }
@@ -3209,8 +2913,19 @@
3209 die "I need either a dbh or file_itr argument"2913 die "I need either a dbh or file_itr argument"
3210 if (!$dbh && !$file_itr) || ($dbh && $file_itr);2914 if (!$dbh && !$file_itr) || ($dbh && $file_itr);
32112915
2916 my %resume;
2917 if ( my $table = $args{resume} ) {
2918 PTDEBUG && _d('Will resume from or after', $table);
2919 my ($db, $tbl) = $args{Quoter}->split_unquote($table);
2920 die "Resume table must be database-qualified: $table"
2921 unless $db && $tbl;
2922 $resume{db} = $db;
2923 $resume{tbl} = $tbl;
2924 }
2925
3212 my $self = {2926 my $self = {
3213 %args,2927 %args,
2928 resume => \%resume,
3214 filters => _make_filters(%args),2929 filters => _make_filters(%args),
3215 };2930 };
32162931
@@ -3271,9 +2986,19 @@
3271 return \%filters;2986 return \%filters;
3272}2987}
32732988
3274sub next_schema_object {2989sub next {
3275 my ( $self ) = @_;2990 my ( $self ) = @_;
32762991
2992 if ( !$self->{initialized} ) {
2993 $self->{initialized} = 1;
2994 if ( $self->{resume}->{tbl}
2995 && !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) {
2996 PTDEBUG && _d('Will resume after',
2997 join('.', @{$self->{resume}}{qw(db tbl)}));
2998 $self->{resume}->{after} = 1;
2999 }
3000 }
3001
3277 my $schema_obj;3002 my $schema_obj;
3278 if ( $self->{file_itr} ) {3003 if ( $self->{file_itr} ) {
3279 $schema_obj= $self->_iterate_files();3004 $schema_obj= $self->_iterate_files();
@@ -3283,19 +3008,13 @@
3283 }3008 }
32843009
3285 if ( $schema_obj ) {3010 if ( $schema_obj ) {
3286 if ( $schema_obj->{ddl} && $self->{TableParser} ) {
3287 $schema_obj->{tbl_struct}
3288 = $self->{TableParser}->parse($schema_obj->{ddl});
3289 }
3290
3291 delete $schema_obj->{ddl} unless $self->{keep_ddl};
3292
3293 if ( my $schema = $self->{Schema} ) {3011 if ( my $schema = $self->{Schema} ) {
3294 $schema->add_schema_object($schema_obj);3012 $schema->add_schema_object($schema_obj);
3295 }3013 }
3014 PTDEBUG && _d('Next schema object:',
3015 $schema_obj->{db}, $schema_obj->{tbl});
3296 }3016 }
32973017
3298 PTDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl});
3299 return $schema_obj;3018 return $schema_obj;
3300}3019}
33013020
@@ -3321,7 +3040,8 @@
3321 my $db = $1; # XXX3040 my $db = $1; # XXX
3322 $db =~ s/^`//; # strip leading `3041 $db =~ s/^`//; # strip leading `
3323 $db =~ s/`$//; # and trailing `3042 $db =~ s/`$//; # and trailing `
3324 if ( $self->database_is_allowed($db) ) {3043 if ( $self->database_is_allowed($db)
3044 && $self->_resume_from_database($db) ) {
3325 $self->{db} = $db;3045 $self->{db} = $db;
3326 }3046 }
3327 }3047 }
@@ -3334,21 +3054,22 @@
3334 my ($tbl) = $chunk =~ m/$tbl_name/;3054 my ($tbl) = $chunk =~ m/$tbl_name/;
3335 $tbl =~ s/^\s*`//;3055 $tbl =~ s/^\s*`//;
3336 $tbl =~ s/`\s*$//;3056 $tbl =~ s/`\s*$//;
3337 if ( $self->table_is_allowed($self->{db}, $tbl) ) {3057 if ( $self->_resume_from_table($tbl)
3058 && $self->table_is_allowed($self->{db}, $tbl) ) {
3338 my ($ddl) = $chunk =~ m/^(?:$open_comment)?(CREATE TABLE.+?;)$/ms;3059 my ($ddl) = $chunk =~ m/^(?:$open_comment)?(CREATE TABLE.+?;)$/ms;
3339 if ( !$ddl ) {3060 if ( !$ddl ) {
3340 warn "Failed to parse CREATE TABLE from\n" . $chunk;3061 warn "Failed to parse CREATE TABLE from\n" . $chunk;
3341 next CHUNK;3062 next CHUNK;
3342 }3063 }
3343 $ddl =~ s/ \*\/;\Z/;/; # remove end of version comment3064 $ddl =~ s/ \*\/;\Z/;/; # remove end of version comment
33443065 my $tbl_struct = $self->{TableParser}->parse($ddl);
3345 my ($engine) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; 3066 if ( $self->engine_is_allowed($tbl_struct->{engine}) ) {
3346
3347 if ( !$engine || $self->engine_is_allowed($engine) ) {
3348 return {3067 return {
3349 db => $self->{db},3068 db => $self->{db},
3350 tbl => $tbl,3069 tbl => $tbl,
3351 ddl => $ddl,3070 name => $self->{Quoter}->quote($self->{db}, $tbl),
3071 ddl => $ddl,
3072 tbl_struct => $tbl_struct,
3352 };3073 };
3353 }3074 }
3354 }3075 }
@@ -3365,6 +3086,7 @@
3365sub _iterate_dbh {3086sub _iterate_dbh {
3366 my ( $self ) = @_;3087 my ( $self ) = @_;
3367 my $q = $self->{Quoter};3088 my $q = $self->{Quoter};
3089 my $tp = $self->{TableParser};
3368 my $dbh = $self->{dbh};3090 my $dbh = $self->{dbh};
3369 PTDEBUG && _d('Getting next schema object from dbh', $dbh);3091 PTDEBUG && _d('Getting next schema object from dbh', $dbh);
33703092
@@ -3378,7 +3100,9 @@
3378 }3100 }
33793101
3380 if ( !$self->{db} ) {3102 if ( !$self->{db} ) {
3381 $self->{db} = shift @{$self->{dbs}};3103 do {
3104 $self->{db} = shift @{$self->{dbs}};
3105 } until $self->_resume_from_database($self->{db});
3382 PTDEBUG && _d('Next database:', $self->{db});3106 PTDEBUG && _d('Next database:', $self->{db});
3383 return unless $self->{db};3107 return unless $self->{db};
3384 }3108 }
@@ -3391,8 +3115,9 @@
3391 }3115 }
3392 grep {3116 grep {
3393 my ($tbl, $type) = @$_;3117 my ($tbl, $type) = @$_;
3394 $self->table_is_allowed($self->{db}, $tbl)3118 (!$type || ($type ne 'VIEW'))
3395 && (!$type || ($type ne 'VIEW'));3119 && $self->_resume_from_table($tbl)
3120 && $self->table_is_allowed($self->{db}, $tbl);
3396 }3121 }
3397 @{$dbh->selectall_arrayref($sql)};3122 @{$dbh->selectall_arrayref($sql)};
3398 PTDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db});3123 PTDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db});
@@ -3400,27 +3125,15 @@
3400 }3125 }
34013126
3402 while ( my $tbl = shift @{$self->{tbls}} ) {3127 while ( my $tbl = shift @{$self->{tbls}} ) {
3403 my $engine;3128 my $ddl = $tp->get_create_table($dbh, $self->{db}, $tbl);
3404 if ( $self->{filters}->{'engines'}3129 my $tbl_struct = $tp->parse($ddl);
3405 || $self->{filters}->{'ignore-engines'} ) {3130 if ( $self->engine_is_allowed($tbl_struct->{engine}) ) {
3406 my $sql = "SHOW TABLE STATUS FROM " . $q->quote($self->{db})
3407 . " LIKE \'$tbl\'";
3408 PTDEBUG && _d($sql);
3409 $engine = $dbh->selectrow_hashref($sql)->{engine};
3410 PTDEBUG && _d($tbl, 'uses', $engine, 'engine');
3411 }
3412
3413
3414 if ( !$engine || $self->engine_is_allowed($engine) ) {
3415 my $ddl;
3416 if ( my $du = $self->{MySQLDump} ) {
3417 $ddl = $du->get_create_table($dbh, $q, $self->{db}, $tbl)->[1];
3418 }
3419
3420 return {3131 return {
3421 db => $self->{db},3132 db => $self->{db},
3422 tbl => $tbl,3133 tbl => $tbl,
3423 ddl => $ddl,3134 name => $q->quote($self->{db}, $tbl),
3135 ddl => $ddl,
3136 tbl_struct => $tbl_struct,
3424 };3137 };
3425 }3138 }
3426 }3139 }
@@ -3481,6 +3194,10 @@
34813194
3482 my $filter = $self->{filters};3195 my $filter = $self->{filters};
34833196
3197 if ( $db eq 'mysql' && ($tbl eq 'general_log' || $tbl eq 'slow_log') ) {
3198 return 0;
3199 }
3200
3484 if ( $filter->{'ignore-tables'}->{$tbl}3201 if ( $filter->{'ignore-tables'}->{$tbl}
3485 && ($filter->{'ignore-tables'}->{$tbl} eq '*'3202 && ($filter->{'ignore-tables'}->{$tbl} eq '*'
3486 || $filter->{'ignore-tables'}->{$tbl} eq $db) ) {3203 || $filter->{'ignore-tables'}->{$tbl} eq $db) ) {
@@ -3520,7 +3237,11 @@
35203237
3521sub engine_is_allowed {3238sub engine_is_allowed {
3522 my ( $self, $engine ) = @_;3239 my ( $self, $engine ) = @_;
3523 die "I need an engine argument" unless $engine;3240
3241 if ( !$engine ) {
3242 PTDEBUG && _d('No engine specified; allowing the table');
3243 return 1;
3244 }
35243245
3525 $engine = lc $engine;3246 $engine = lc $engine;
35263247
@@ -3540,6 +3261,40 @@
3540 return 1;3261 return 1;
3541}3262}
35423263
3264sub _resume_from_database {
3265 my ($self, $db) = @_;
3266
3267 return 1 unless $self->{resume}->{db};
3268
3269 if ( $db eq $self->{resume}->{db} ) {
3270 PTDEBUG && _d('At resume db', $db);
3271 delete $self->{resume}->{db};
3272 return 1;
3273 }
3274
3275 return 0;
3276}
3277
3278sub _resume_from_table {
3279 my ($self, $tbl) = @_;
3280
3281 return 1 unless $self->{resume}->{tbl};
3282
3283 if ( $tbl eq $self->{resume}->{tbl} ) {
3284 if ( !$self->{resume}->{after} ) {
3285 PTDEBUG && _d('Resuming from table', $tbl);
3286 delete $self->{resume}->{tbl};
3287 return 1;
3288 }
3289 else {
3290 PTDEBUG && _d('Resuming after table', $tbl);
3291 delete $self->{resume}->{tbl};
3292 }
3293 }
3294
3295 return 0;
3296}
3297
3543sub _d {3298sub _d {
3544 my ($package, undef, $line) = caller 0;3299 my ($package, undef, $line) = caller 0;
3545 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }3300 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
@@ -3622,15 +3377,11 @@
3622 my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn),3377 my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn),
3623 { AutoCommit => 1, });3378 { AutoCommit => 1, });
36243379
3625 my $vp = new VersionParser();
3626 my $version = $vp->parse($dbh->selectrow_array('SELECT VERSION()'));
3627
3628 # #######################################################################3380 # #######################################################################
3629 # Do the main work.3381 # Do the main work.
3630 # #######################################################################3382 # #######################################################################
3631 my $ks = $o->get('summary') ? new KeySize(q=>$q) : undef;3383 my $ks = $o->get('summary') ? new KeySize(q=>$q) : undef;
3632 my $dk = new DuplicateKeyFinder();3384 my $dk = new DuplicateKeyFinder();
3633 my $du = new MySQLDump();
36343385
3635 my %tp_opts = (3386 my %tp_opts = (
3636 ignore_type => $o->get('all-structs'),3387 ignore_type => $o->get('all-structs'),
@@ -3646,25 +3397,23 @@
3646 dbh => $dbh,3397 dbh => $dbh,
3647 OptionParser => $o,3398 OptionParser => $o,
3648 Quoter => $q,3399 Quoter => $q,
3649 MySQLDump => $du,
3650 TableParser => $tp,3400 TableParser => $tp,
3651 Schema => $schema,3401 Schema => $schema,
3652 keep_ddl => 1,
3653 );3402 );
3654 TABLE:3403 TABLE:
3655 while ( my $tbl = $schema_itr->next_schema_object() ) {3404 while ( my $tbl = $schema_itr->next() ) {
3656 $tbl->{engine} = $tp->get_engine($tbl->{ddl});3405 $tbl->{engine} = $tbl->{tbl_struct}->{engine};
36573406
3658 my ($keys, $clustered_key, $fks);3407 my ($keys, $clustered_key, $fks);
3659 if ( $get_keys ) {3408 if ( $get_keys ) {
3660 ($keys, $clustered_key)3409 ($keys, $clustered_key)
3661 = $tp->get_keys($tbl->{ddl}, {version => $version});3410 = $tp->get_keys($tbl->{ddl}, {});
3662 }3411 }
3663 if ( $get_fks ) {3412 if ( $get_fks ) {
3664 $fks = $tp->get_fks($tbl->{ddl}, {database => $tbl->{db}});3413 $fks = $tp->get_fks($tbl->{ddl}, {database => $tbl->{db}});
3665 }3414 }
36663415
3667 next TABLE unless %$keys || %$fks;3416 next TABLE unless ($keys && %$keys) || ($fks && %$fks);
36683417
3669 if ( $o->got('verbose') ) {3418 if ( $o->got('verbose') ) {
3670 print_all_keys($keys, $tbl, \%seen_tbl) if $keys;3419 print_all_keys($keys, $tbl, \%seen_tbl) if $keys;
@@ -4279,6 +4028,10 @@
42794028
4280=head1 VERSION4029=head1 VERSION
42814030
4031<<<<<<< TREE
4282pt-duplicate-key-checker 2.0.54032pt-duplicate-key-checker 2.0.5
4033=======
4034pt-duplicate-key-checker 2.1.2
4035>>>>>>> MERGE-SOURCE
42834036
4284=cut4037=cut
42854038
=== modified file 'bin/pt-fifo-split'
--- bin/pt-fifo-split 2012-06-09 21:53:04 +0000
+++ bin/pt-fifo-split 2012-07-20 22:10:28 +0000
@@ -959,7 +959,7 @@
959 $opt->{value} = ($pre || '') . $num;959 $opt->{value} = ($pre || '') . $num;
960 }960 }
961 else {961 else {
962 $self->save_error("Invalid size for --$opt->{long}");962 $self->save_error("Invalid size for --$opt->{long}: $val");
963 }963 }
964 return;964 return;
965}965}
@@ -1547,6 +1547,10 @@
15471547
1548=head1 VERSION1548=head1 VERSION
15491549
1550<<<<<<< TREE
1550pt-fifo-split 2.0.51551pt-fifo-split 2.0.5
1552=======
1553pt-fifo-split 2.1.2
1554>>>>>>> MERGE-SOURCE
15511555
1552=cut1556=cut
15531557
=== modified file 'bin/pt-find'
--- bin/pt-find 2012-06-09 21:53:04 +0000
+++ bin/pt-find 2012-07-20 22:10:28 +0000
@@ -237,51 +237,10 @@
237 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, 237 PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass,
238 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));238 join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults ));
239239
240 eval {240 $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) };
241 $dbh = DBI->connect($cxn_string, $user, $pass, $defaults);241
242
243 if ( $cxn_string =~ m/mysql/i ) {
244 my $sql;
245
246 $sql = 'SELECT @@SQL_MODE';
247 PTDEBUG && _d($dbh, $sql);
248 my ($sql_mode) = $dbh->selectrow_array($sql);
249
250 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
251 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
252 . ($sql_mode ? ",$sql_mode" : '')
253 . '\'*/';
254 PTDEBUG && _d($dbh, $sql);
255 $dbh->do($sql);
256
257 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
258 $sql = "/*!40101 SET NAMES $charset*/";
259 PTDEBUG && _d($dbh, ':', $sql);
260 $dbh->do($sql);
261 PTDEBUG && _d('Enabling charset for STDOUT');
262 if ( $charset eq 'utf8' ) {
263 binmode(STDOUT, ':utf8')
264 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
265 }
266 else {
267 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
268 }
269 }
270
271 if ( $self->prop('set-vars') ) {
272 $sql = "SET " . $self->prop('set-vars');
273 PTDEBUG && _d($dbh, ':', $sql);
274 $dbh->do($sql);
275 }
276 }
277 };
278 if ( !$dbh && $EVAL_ERROR ) {242 if ( !$dbh && $EVAL_ERROR ) {
279 PTDEBUG && _d($EVAL_ERROR);243 if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
280 if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
281 PTDEBUG && _d('Going to try again without utf8 support');
282 delete $defaults->{mysql_enable_utf8};
283 }
284 elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) {
285 die "Cannot connect to MySQL because the Perl DBD::mysql module is "244 die "Cannot connect to MySQL because the Perl DBD::mysql module is "
286 . "not installed or not found. Run 'perl -MDBD::mysql' to see "245 . "not installed or not found. Run 'perl -MDBD::mysql' to see "
287 . "the directories that Perl searches for DBD::mysql. If "246 . "the directories that Perl searches for DBD::mysql. If "
@@ -290,19 +249,70 @@
290 . " RHEL/CentOS yum install perl-DBD-MySQL\n"249 . " RHEL/CentOS yum install perl-DBD-MySQL\n"
291 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";250 . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n";
292 }251 }
252 elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) {
253 PTDEBUG && _d('Going to try again without utf8 support');
254 delete $defaults->{mysql_enable_utf8};
255 }
293 if ( !$tries ) {256 if ( !$tries ) {
294 die $EVAL_ERROR;257 die $EVAL_ERROR;
295 }258 }
296 }259 }
297 }260 }
298261
262 if ( $cxn_string =~ m/mysql/i ) {
263 my $sql;
264
265 $sql = 'SELECT @@SQL_MODE';
266 PTDEBUG && _d($dbh, $sql);
267 my ($sql_mode) = eval { $dbh->selectrow_array($sql) };
268 if ( $EVAL_ERROR ) {
269 die $EVAL_ERROR;
270 }
271
272 $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1'
273 . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO'
274 . ($sql_mode ? ",$sql_mode" : '')
275 . '\'*/';
276 PTDEBUG && _d($dbh, $sql);
277 eval { $dbh->do($sql) };
278 if ( $EVAL_ERROR ) {
279 die $EVAL_ERROR;
280 }
281
282 if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) {
283 $sql = "/*!40101 SET NAMES $charset*/";
284 PTDEBUG && _d($dbh, ':', $sql);
285 eval { $dbh->do($sql) };
286 if ( $EVAL_ERROR ) {
287 die $EVAL_ERROR;
288 }
289 PTDEBUG && _d('Enabling charset for STDOUT');
290 if ( $charset eq 'utf8' ) {
291 binmode(STDOUT, ':utf8')
292 or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR";
293 }
294 else {
295 binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR";
296 }
297 }
298
299 if ( $self->prop('set-vars') ) {
300 $sql = "SET " . $self->prop('set-vars');
301 PTDEBUG && _d($dbh, ':', $sql);
302 eval { $dbh->do($sql) };
303 if ( $EVAL_ERROR ) {
304 die $EVAL_ERROR;
305 }
306 }
307 }
308
299 PTDEBUG && _d('DBH info: ',309 PTDEBUG && _d('DBH info: ',
300 $dbh,310 $dbh,
301 Dumper($dbh->selectrow_hashref(311 Dumper($dbh->selectrow_hashref(
302 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),312 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')),
303 'Connection info:', $dbh->{mysql_hostinfo},313 'Connection info:', $dbh->{mysql_hostinfo},
304 'Character set info:', Dumper($dbh->selectall_arrayref(314 'Character set info:', Dumper($dbh->selectall_arrayref(
305 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})),315 "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})),
306 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,316 '$DBD::mysql::VERSION:', $DBD::mysql::VERSION,
307 '$DBI::VERSION:', $DBI::VERSION,317 '$DBI::VERSION:', $DBI::VERSION,
308 );318 );
@@ -1320,7 +1330,7 @@
1320 $opt->{value} = ($pre || '') . $num;1330 $opt->{value} = ($pre || '') . $num;
1321 }1331 }
1322 else {1332 else {
1323 $self->save_error("Invalid size for --$opt->{long}");1333 $self->save_error("Invalid size for --$opt->{long}: $val");
1324 }1334 }
1325 return;1335 return;
1326}1336}
@@ -1465,6 +1475,48 @@
1465 return $db ? "$db.$tbl" : $tbl;1475 return $db ? "$db.$tbl" : $tbl;
1466}1476}
14671477
1478sub serialize_list {
1479 my ( $self, @args ) = @_;
1480 return unless @args;
1481
1482 return $args[0] if @args == 1 && !defined $args[0];
1483
1484 die "Cannot serialize multiple values with undef/NULL"
1485 if grep { !defined $_ } @args;
1486
1487 return join ',', map { quotemeta } @args;
1488}
1489
1490sub deserialize_list {
1491 my ( $self, $string ) = @_;
1492 return $string unless defined $string;
1493 my @escaped_parts = $string =~ /
1494 \G # Start of string, or end of previous match.
1495 ( # Each of these is an element in the original list.
1496 [^\\,]* # Anything not a backslash or a comma
1497 (?: # When we get here, we found one of the above.
1498 \\. # A backslash followed by something so we can continue
1499 [^\\,]* # Same as above.
1500 )* # Repeat zero of more times.
1501 )
1502 , # Comma dividing elements
1503 /sxgc;
1504
1505 push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string;
1506
1507 my @unescaped_parts = map {
1508 my $part = $_;
1509
1510 my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string,
1511 ? qr/(?=\p{ASCII})\W/ # We only care about non-word
1512 : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise,
1513 $part =~ s/\\($char_class)/$1/g;
1514 $part;
1515 } @escaped_parts;
1516
1517 return @unescaped_parts;
1518}
1519
14681;15201;
1469}1521}
1470# ###########################################################################1522# ###########################################################################
@@ -1472,89 +1524,6 @@
1472# ###########################################################################1524# ###########################################################################
14731525
1474# ###########################################################################1526# ###########################################################################
1475# VersionParser package
1476# This package is a copy without comments from the original. The original
1477# with comments and its test file can be found in the Bazaar repository at,
1478# lib/VersionParser.pm
1479# t/lib/VersionParser.t
1480# See https://launchpad.net/percona-toolkit for more information.
1481# ###########################################################################
1482{
1483package VersionParser;
1484
1485use strict;
1486use warnings FATAL => 'all';
1487use English qw(-no_match_vars);
1488use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1489
1490sub new {
1491 my ( $class ) = @_;
1492 bless {}, $class;
1493}
1494
1495sub parse {
1496 my ( $self, $str ) = @_;
1497 my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g);
1498 PTDEBUG && _d($str, 'parses to', $result);
1499 return $result;
1500}
1501
1502sub version_ge {
1503 my ( $self, $dbh, $target ) = @_;
1504 if ( !$self->{$dbh} ) {
1505 $self->{$dbh} = $self->parse(
1506 $dbh->selectrow_array('SELECT VERSION()'));
1507 }
1508 my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0;
1509 PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result);
1510 return $result;
1511}
1512
1513sub innodb_version {
1514 my ( $self, $dbh ) = @_;
1515 return unless $dbh;
1516 my $innodb_version = "NO";
1517
1518 my ($innodb) =
1519 grep { $_->{engine} =~ m/InnoDB/i }
1520 map {
1521 my %hash;
1522 @hash{ map { lc $_ } keys %$_ } = values %$_;
1523 \%hash;
1524 }
1525 @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) };
1526 if ( $innodb ) {
1527 PTDEBUG && _d("InnoDB support:", $innodb->{support});
1528 if ( $innodb->{support} =~ m/YES|DEFAULT/i ) {
1529 my $vars = $dbh->selectrow_hashref(
1530 "SHOW VARIABLES LIKE 'innodb_version'");
1531 $innodb_version = !$vars ? "BUILTIN"
1532 : ($vars->{Value} || $vars->{value});
1533 }
1534 else {
1535 $innodb_version = $innodb->{support}; # probably DISABLED or NO
1536 }
1537 }
1538
1539 PTDEBUG && _d("InnoDB version:", $innodb_version);
1540 return $innodb_version;
1541}
1542
1543sub _d {
1544 my ($package, undef, $line) = caller 0;
1545 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
1546 map { defined $_ ? $_ : 'undef' }
1547 @_;
1548 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
1549}
1550
15511;
1552}
1553# ###########################################################################
1554# End VersionParser package
1555# ###########################################################################
1556
1557# ###########################################################################
1558# TableParser package1527# TableParser package
1559# This package is a copy without comments from the original. The original1528# This package is a copy without comments from the original. The original
1560# with comments and its test file can be found in the Bazaar repository at,1529# with comments and its test file can be found in the Bazaar repository at,
@@ -1585,23 +1554,64 @@
1585 return bless $self, $class;1554 return bless $self, $class;
1586}1555}
15871556
1557sub get_create_table {
1558 my ( $self, $dbh, $db, $tbl ) = @_;
1559 die "I need a dbh parameter" unless $dbh;
1560 die "I need a db parameter" unless $db;
1561 die "I need a tbl parameter" unless $tbl;
1562 my $q = $self->{Quoter};
1563
1564 my $new_sql_mode
1565 = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
1566 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
1567 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
1568 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
1569
1570 my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
1571 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
1572
1573 PTDEBUG && _d($new_sql_mode);
1574 eval { $dbh->do($new_sql_mode); };
1575 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
1576
1577 my $use_sql = 'USE ' . $q->quote($db);
1578 PTDEBUG && _d($dbh, $use_sql);
1579 $dbh->do($use_sql);
1580
1581 my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl);
1582 PTDEBUG && _d($show_sql);
1583 my $href;
1584 eval { $href = $dbh->selectrow_hashref($show_sql); };
1585 if ( $EVAL_ERROR ) {
1586 PTDEBUG && _d($EVAL_ERROR);
1587
1588 PTDEBUG && _d($old_sql_mode);
1589 $dbh->do($old_sql_mode);
1590
1591 return;
1592 }
1593
1594 PTDEBUG && _d($old_sql_mode);
1595 $dbh->do($old_sql_mode);
1596
1597 my ($key) = grep { m/create (?:table|view)/i } keys %$href;
1598 if ( !$key ) {
1599 die "Error: no 'Create Table' or 'Create View' in result set from "
1600 . "$show_sql: " . Dumper($href);
1601 }
1602
1603 return $href->{$key};
1604}
1605
1588sub parse {1606sub parse {
1589 my ( $self, $ddl, $opts ) = @_;1607 my ( $self, $ddl, $opts ) = @_;
1590 return unless $ddl;1608 return unless $ddl;
1591 if ( ref $ddl eq 'ARRAY' ) {1609
1592 if ( lc $ddl->[0] eq 'table' ) {1610 if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) {
1593 $ddl = $ddl->[1];1611 $ddl = $self->ansi_to_legacy($ddl);
1594 }
1595 else {
1596 return {
1597 engine => 'VIEW',
1598 };
1599 }
1600 }1612 }
16011613 elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {
1602 if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) {1614 die "TableParser doesn't handle CREATE TABLE without quoting.";
1603 die "Cannot parse table definition; is ANSI quoting "
1604 . "enabled or SQL_QUOTE_SHOW_CREATE disabled?";
1605 }1615 }
16061616
1607 my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;1617 my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/;
@@ -1810,19 +1820,13 @@
1810 my $key_ddl = $key;1820 my $key_ddl = $key;
1811 PTDEBUG && _d('Parsed key:', $key_ddl);1821 PTDEBUG && _d('Parsed key:', $key_ddl);
18121822
1813 if ( $engine !~ m/MEMORY|HEAP/ ) {1823 if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) {
1814 $key =~ s/USING HASH/USING BTREE/;1824 $key =~ s/USING HASH/USING BTREE/;
1815 }1825 }
18161826
1817 my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;1827 my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/;
1818 my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;1828 my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/;
1819 $type = $type || $special || 'BTREE';1829 $type = $type || $special || 'BTREE';
1820 if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000'
1821 && $engine =~ m/HEAP|MEMORY/i )
1822 {
1823 $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP
1824 }
1825
1826 my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;1830 my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/;
1827 my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;1831 my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0;
1828 my @cols;1832 my @cols;
@@ -1848,7 +1852,7 @@
1848 ddl => $key_ddl,1852 ddl => $key_ddl,
1849 };1853 };
18501854
1851 if ( $engine =~ m/InnoDB/i && !$clustered_key ) {1855 if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) {
1852 my $this_key = $keys->{$name};1856 my $this_key = $keys->{$name};
1853 if ( $this_key->{name} eq 'PRIMARY' ) {1857 if ( $this_key->{name} eq 'PRIMARY' ) {
1854 $clustered_key = 'PRIMARY';1858 $clustered_key = 'PRIMARY';
@@ -1904,41 +1908,46 @@
1904 return $ddl;1908 return $ddl;
1905}1909}
19061910
1907sub remove_secondary_indexes {1911sub get_table_status {
1908 my ( $self, $ddl ) = @_;1912 my ( $self, $dbh, $db, $like ) = @_;
1909 my $sec_indexes_ddl;1913 my $q = $self->{Quoter};
1910 my $tbl_struct = $self->parse($ddl);1914 my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db);
19111915 my @params;
1912 if ( ($tbl_struct->{engine} || '') =~ m/InnoDB/i ) {1916 if ( $like ) {
1913 my $clustered_key = $tbl_struct->{clustered_key};1917 $sql .= ' LIKE ?';
1914 $clustered_key ||= '';1918 push @params, $like;
19151919 }
1916 my @sec_indexes = map {1920 PTDEBUG && _d($sql, @params);
1917 my $key_def = $_->{ddl};1921 my $sth = $dbh->prepare($sql);
1918 $key_def =~ s/([\(\)])/\\$1/g;1922 eval { $sth->execute(@params); };
1919 $ddl =~ s/\s+$key_def//i;1923 if ($EVAL_ERROR) {
19201924 PTDEBUG && _d($EVAL_ERROR);
1921 my $key_ddl = "ADD $_->{ddl}";1925 return;
1922 $key_ddl .= ',' unless $key_ddl =~ m/,$/;1926 }
1923 $key_ddl;1927 my @tables = @{$sth->fetchall_arrayref({})};
1924 }1928 @tables = map {
1925 grep { $_->{name} ne $clustered_key }1929 my %tbl; # Make a copy with lowercased keys
1926 values %{$tbl_struct->{keys}};1930 @tbl{ map { lc $_ } keys %$_ } = values %$_;
1927 PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes));1931 $tbl{engine} ||= $tbl{type} || $tbl{comment};
19281932 delete $tbl{type};
1929 if ( @sec_indexes ) {1933 \%tbl;
1930 $sec_indexes_ddl = join(' ', @sec_indexes);1934 } @tables;
1931 $sec_indexes_ddl =~ s/,$//;1935 return @tables;
1932 }1936}
19331937
1934 $ddl =~ s/,(\n\) )/$1/s;1938my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx;
1935 }1939sub ansi_to_legacy {
1936 else {1940 my ($self, $ddl) = @_;
1937 PTDEBUG && _d('Not removing secondary indexes from',1941 $ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge;
1938 $tbl_struct->{engine}, 'table');1942 return $ddl;
1939 }1943}
19401944
1941 return $ddl, $sec_indexes_ddl, $tbl_struct;1945sub ansi_quote_replace {
1946 my ($val) = @_;
1947 $val =~ s/^"|"$//g;
1948 $val =~ s/`/``/g;
1949 $val =~ s/""/"/g;
1950 return "`$val`";
1942}1951}
19431952
1944sub _d {1953sub _d {
@@ -1956,311 +1965,6 @@
1956# ###########################################################################1965# ###########################################################################
19571966
1958# ###########################################################################1967# ###########################################################################
1959# MySQLDump package
1960# This package is a copy without comments from the original. The original
1961# with comments and its test file can be found in the Bazaar repository at,
1962# lib/MySQLDump.pm
1963# t/lib/MySQLDump.t
1964# See https://launchpad.net/percona-toolkit for more information.
1965# ###########################################################################
1966{
1967package MySQLDump;
1968
1969use strict;
1970use warnings FATAL => 'all';
1971use English qw(-no_match_vars);
1972use constant PTDEBUG => $ENV{PTDEBUG} || 0;
1973
1974( our $before = <<'EOF') =~ s/^ //gm;
1975 /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
1976 /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
1977 /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
1978 /*!40101 SET NAMES utf8 */;
1979 /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
1980 /*!40103 SET TIME_ZONE='+00:00' */;
1981 /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
1982 /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
1983 /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
1984 /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;
1985EOF
1986
1987( our $after = <<'EOF') =~ s/^ //gm;
1988 /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
1989 /*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
1990 /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
1991 /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
1992 /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
1993 /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
1994 /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
1995 /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;
1996EOF
1997
1998sub new {
1999 my ( $class, %args ) = @_;
2000 my $self = {
2001 cache => 0, # Afaik no script uses this cache any longer because
2002 };
2003 return bless $self, $class;
2004}
2005
2006sub dump {
2007 my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_;
2008
2009 if ( $what eq 'table' ) {
2010 my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
2011 return unless $ddl;
2012 if ( $ddl->[0] eq 'table' ) {
2013 return $before
2014 . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
2015 . $ddl->[1] . ";\n";
2016 }
2017 else {
2018 return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n"
2019 . '/*!50001 DROP VIEW IF EXISTS '
2020 . $quoter->quote($tbl) . "*/;\n/*!50001 "
2021 . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n";
2022 }
2023 }
2024 elsif ( $what eq 'triggers' ) {
2025 my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl);
2026 if ( $trgs && @$trgs ) {
2027 my $result = $before . "\nDELIMITER ;;\n";
2028 foreach my $trg ( @$trgs ) {
2029 if ( $trg->{sql_mode} ) {
2030 $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n};
2031 }
2032 $result .= "/*!50003 CREATE */ ";
2033 if ( $trg->{definer} ) {
2034 my ( $user, $host )
2035 = map { s/'/''/g; "'$_'"; }
2036 split('@', $trg->{definer}, 2);
2037 $result .= "/*!50017 DEFINER=$user\@$host */ ";
2038 }
2039 $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n",
2040 $quoter->quote($trg->{trigger}),
2041 @{$trg}{qw(timing event)},
2042 $quoter->quote($trg->{table}),
2043 $trg->{statement});
2044 }
2045 $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n";
2046 return $result;
2047 }
2048 else {
2049 return undef;
2050 }
2051 }
2052 elsif ( $what eq 'view' ) {
2053 my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl);
2054 return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
2055 . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n"
2056 . '/*!50001 ' . $ddl->[1] . "*/;\n";
2057 }
2058 else {
2059 die "You didn't say what to dump.";
2060 }
2061}
2062
2063sub _use_db {
2064 my ( $self, $dbh, $quoter, $new ) = @_;
2065 if ( !$new ) {
2066 PTDEBUG && _d('No new DB to use');
2067 return;
2068 }
2069 my $sql = 'USE ' . $quoter->quote($new);
2070 PTDEBUG && _d($dbh, $sql);
2071 $dbh->do($sql);
2072 return;
2073}
2074
2075sub get_create_table {
2076 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2077 if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) {
2078 my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
2079 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
2080 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
2081 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
2082 PTDEBUG && _d($sql);
2083 eval { $dbh->do($sql); };
2084 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
2085 $self->_use_db($dbh, $quoter, $db);
2086 $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl);
2087 PTDEBUG && _d($sql);
2088 my $href;
2089 eval { $href = $dbh->selectrow_hashref($sql); };
2090 if ( $EVAL_ERROR ) {
2091 warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR";
2092 return;
2093 }
2094
2095 $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
2096 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
2097 PTDEBUG && _d($sql);
2098 $dbh->do($sql);
2099 my ($key) = grep { m/create table/i } keys %$href;
2100 if ( $key ) {
2101 PTDEBUG && _d('This table is a base table');
2102 $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ];
2103 }
2104 else {
2105 PTDEBUG && _d('This table is a view');
2106 ($key) = grep { m/create view/i } keys %$href;
2107 $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ];
2108 }
2109 }
2110 return $self->{tables}->{$db}->{$tbl};
2111}
2112
2113sub get_columns {
2114 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2115 PTDEBUG && _d('Get columns for', $db, $tbl);
2116 if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) {
2117 $self->_use_db($dbh, $quoter, $db);
2118 my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl);
2119 PTDEBUG && _d($sql);
2120 my $cols = $dbh->selectall_arrayref($sql, { Slice => {} });
2121
2122 $self->{columns}->{$db}->{$tbl} = [
2123 map {
2124 my %row;
2125 @row{ map { lc $_ } keys %$_ } = values %$_;
2126 \%row;
2127 } @$cols
2128 ];
2129 }
2130 return $self->{columns}->{$db}->{$tbl};
2131}
2132
2133sub get_tmp_table {
2134 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2135 my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n";
2136 $result .= join(",\n",
2137 map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} }
2138 @{$self->get_columns($dbh, $quoter, $db, $tbl)});
2139 $result .= "\n)";
2140 PTDEBUG && _d($result);
2141 return $result;
2142}
2143
2144sub get_triggers {
2145 my ( $self, $dbh, $quoter, $db, $tbl ) = @_;
2146 if ( !$self->{cache} || !$self->{triggers}->{$db} ) {
2147 $self->{triggers}->{$db} = {};
2148 my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, '
2149 . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), }
2150 . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, '
2151 . '@@SQL_QUOTE_SHOW_CREATE := 1 */';
2152 PTDEBUG && _d($sql);
2153 eval { $dbh->do($sql); };
2154 PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR);
2155 $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db);
2156 PTDEBUG && _d($sql);
2157 my $sth = $dbh->prepare($sql);
2158 $sth->execute();
2159 if ( $sth->rows ) {
2160 my $trgs = $sth->fetchall_arrayref({});
2161 foreach my $trg (@$trgs) {
2162 my %trg;
2163 @trg{ map { lc $_ } keys %$trg } = values %$trg;
2164 push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg;
2165 }
2166 }
2167 $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, '
2168 . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */';
2169 PTDEBUG && _d($sql);
2170 $dbh->do($sql);
2171 }
2172 if ( $tbl ) {
2173 return $self->{triggers}->{$db}->{$tbl};
2174 }
2175 return values %{$self->{triggers}->{$db}};
2176}
2177
2178sub get_databases {
2179 my ( $self, $dbh, $quoter, $like ) = @_;
2180 if ( !$self->{cache} || !$self->{databases} || $like ) {
2181 my $sql = 'SHOW DATABASES';
2182 my @params;
2183 if ( $like ) {
2184 $sql .= ' LIKE ?';
2185 push @params, $like;
2186 }
2187 my $sth = $dbh->prepare($sql);
2188 PTDEBUG && _d($sql, @params);
2189 $sth->execute( @params );
2190 my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()};
2191 $self->{databases} = \@dbs unless $like;
2192 return @dbs;
2193 }
2194 return @{$self->{databases}};
2195}
2196
2197sub get_table_status {
2198 my ( $self, $dbh, $quoter, $db, $like ) = @_;
2199 if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) {
2200 my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db);
2201 my @params;
2202 if ( $like ) {
2203 $sql .= ' LIKE ?';
2204 push @params, $like;
2205 }
2206 PTDEBUG && _d($sql, @params);
2207 my $sth = $dbh->prepare($sql);
2208 $sth->execute(@params);
2209 my @tables = @{$sth->fetchall_arrayref({})};
2210 @tables = map {
2211 my %tbl; # Make a copy with lowercased keys
2212 @tbl{ map { lc $_ } keys %$_ } = values %$_;
2213 $tbl{engine} ||= $tbl{type} || $tbl{comment};
2214 delete $tbl{type};
2215 \%tbl;
2216 } @tables;
2217 $self->{table_status}->{$db} = \@tables unless $like;
2218 return @tables;
2219 }
2220 return @{$self->{table_status}->{$db}};
2221}
2222
2223sub get_table_list {
2224 my ( $self, $dbh, $quoter, $db, $like ) = @_;
2225 if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) {
2226 my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db);
2227 my @params;
2228 if ( $like ) {
2229 $sql .= ' LIKE ?';
2230 push @params, $like;
2231 }
2232 PTDEBUG && _d($sql, @params);
2233 my $sth = $dbh->prepare($sql);
2234 $sth->execute(@params);
2235 my @tables = @{$sth->fetchall_arrayref()};
2236 @tables = map {
2237 my %tbl = (
2238 name => $_->[0],
2239 engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '',
2240 );
2241 \%tbl;
2242 } @tables;
2243 $self->{table_list}->{$db} = \@tables unless $like;
2244 return @tables;
2245 }
2246 return @{$self->{table_list}->{$db}};
2247}
2248
2249sub _d {
2250 my ($package, undef, $line) = caller 0;
2251 @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; }
2252 map { defined $_ ? $_ : 'undef' }
2253 @_;
2254 print STDERR "# $package:$line $PID ", join(' ', @_), "\n";
2255}
2256
22571;
2258}
2259# ###########################################################################
2260# End MySQLDump package
2261# ###########################################################################
2262
2263# ###########################################################################
2264# Daemon package1968# Daemon package
2265# This package is a copy without comments from the original. The original1969# This package is a copy without comments from the original. The original
2266# with comments and its test file can be found in the Bazaar repository at,1970# with comments and its test file can be found in the Bazaar repository at,
@@ -2479,7 +2183,6 @@
2479my $dbh; # This program's $dbh2183my $dbh; # This program's $dbh
2480my $exec_dbh; # The $dbh to use for exec and exec-plus2184my $exec_dbh; # The $dbh to use for exec and exec-plus
2481my $tp;2185my $tp;
2482my $du;
24832186
2484# Functions to call while evaluating tests.2187# Functions to call while evaluating tests.
2485my %test_for = (2188my %test_for = (
@@ -2774,7 +2477,6 @@
2774 my $need_table_struct = grep { $o->got($_); } @table_struct_tests;2477 my $need_table_struct = grep { $o->got($_); } @table_struct_tests;
2775 PTDEBUG && _d('Need table struct:', $need_table_struct);2478 PTDEBUG && _d('Need table struct:', $need_table_struct);
2776 if ( $need_table_struct ) {2479 if ( $need_table_struct ) {
2777 $du = new MySQLDump();
2778 $tp = new TableParser(Quoter => $q);2480 $tp = new TableParser(Quoter => $q);
2779 }2481 }
27802482
@@ -2847,11 +2549,7 @@
2847 ($server_id) = $dbh->selectrow_array('SELECT @@SERVER_ID');2549 ($server_id) = $dbh->selectrow_array('SELECT @@SERVER_ID');
28482550
2849 # Discover if we need to get stored code. Need dbh to do this.2551 # Discover if we need to get stored code. Need dbh to do this.
2850 my $vp = new VersionParser();2552 my $need_stored_code = grep { $o->got($_); } @stored_code_tests;
2851 my $need_stored_code = $vp->version_ge($dbh, '5.0.0');
2852 $need_stored_code = grep { $o->got($_); } @stored_code_tests
2853 if $need_stored_code;
2854 PTDEBUG && _d('Need stored code:', $need_stored_code);
28552553
2856 # ########################################################################2554 # ########################################################################
2857 # Go do it.2555 # Go do it.
@@ -2900,8 +2598,8 @@
2900 if ( $need_table_struct ) {2598 if ( $need_table_struct ) {
2901 PTDEBUG && _d('Getting table struct for',2599 PTDEBUG && _d('Getting table struct for',
2902 $database, '.', $table->{Name});2600 $database, '.', $table->{Name});
2903 my $ddl = $du->get_create_table($dbh,$q, $database, $table->{Name});2601 my $ddl = $tp->get_create_table($dbh, $database, $table->{Name});
2904 if ( $ddl->[0] eq 'table' ) {2602 if ( $ddl =~ m/CREATE TABLE/ ) {
2905 my $table_struct;2603 my $table_struct;
2906 eval { $table_struct = $tp->parse($ddl) };2604 eval { $table_struct = $tp->parse($ddl) };
2907 if ( $EVAL_ERROR ) {2605 if ( $EVAL_ERROR ) {
@@ -2909,8 +2607,8 @@
2909 }2607 }
2910 $table->{struct} = $table_struct;2608 $table->{struct} = $table_struct;
2911 }2609 }
2912 elsif ( $ddl->[0] eq 'view' ) {2610 else {
2913 $table->{view} = $ddl->[1];2611 $table->{view} = $ddl;
2914 }2612 }
2915 }2613 }
2916 }2614 }
@@ -3827,6 +3525,10 @@
38273525
3828=head1 VERSION3526=head1 VERSION
38293527
3528<<<<<<< TREE
3830pt-find 2.0.53529pt-find 2.0.5
3530=======
3531pt-find 2.1.2
3532>>>>>>> MERGE-SOURCE
38313533
3832=cut3534=cut
38333535
=== added file 'bin/pt-fingerprint'
--- bin/pt-fingerprint 1970-01-01 00:00:00 +0000
+++ bin/pt-fingerprint 2012-07-20 22:10:28 +0000
@@ -0,0 +1,2143 @@
1#!/usr/bin/env perl
2
3# This program is part of Percona Toolkit: http://www.percona.com/software/
4# See "COPYRIGHT, LICENSE, AND WARRANTY" at the end of this file for legal
5# notices and disclaimers.
6
7use strict;
8use warnings FATAL => 'all';
9use constant PTDEBUG => $ENV{PTDEBUG} || 0;
10
11# ###########################################################################
12# OptionParser package
13# This package is a copy without comments from the original. The original
14# with comments and its test file can be found in the Bazaar repository at,
15# lib/OptionParser.pm
16# t/lib/OptionParser.t
17# See https://launchpad.net/percona-toolkit for more information.
18# ###########################################################################
19{
20package OptionParser;
21
22use strict;
23use warnings FATAL => 'all';
24use English qw(-no_match_vars);
25use constant PTDEBUG => $ENV{PTDEBUG} || 0;
26
27use List::Util qw(max);
28use Getopt::Long;
29
30my $POD_link_re = '[LC]<"?([^">]+)"?>';
31
32sub new {
33 my ( $class, %args ) = @_;
34 my @required_args = qw();
35 foreach my $arg ( @required_args ) {
36 die "I need a $arg argument" unless $args{$arg};
37 }
38
39 my ($program_name) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/;
40 $program_name ||= $PROGRAM_NAME;
41 my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.';
42
43 my %attributes = (
44 'type' => 1,
45 'short form' => 1,
46 'group' => 1,
47 'default' => 1,
48 'cumulative' => 1,
49 'negatable' => 1,
50 );
51
52 my $self = {
53 head1 => 'OPTIONS', # These args are used internally
54 skip_rules => 0, # to instantiate another Option-
55 item => '--(.*)', # Parser obj that parses the
56 attributes => \%attributes, # DSN OPTIONS section. Tools
57 parse_attributes => \&_parse_attribs, # don't tinker with these args.
58
59 %args,
60
61 strict => 1, # disabled by a special rule
62 program_name => $program_name,
63 opts => {},
64 got_opts => 0,
65 short_opts => {},
66 defaults => {},
67 groups => {},
68 allowed_groups => {},
69 errors => [],
70 rules => [], # desc of rules for --help
71 mutex => [], # rule: opts are mutually exclusive
72 atleast1 => [], # rule: at least one opt is required
73 disables => {}, # rule: opt disables other opts
74 defaults_to => {}, # rule: opt defaults to value of other opt
75 DSNParser => undef,
76 default_files => [
77 "/etc/percona-toolkit/percona-toolkit.conf",
78 "/etc/percona-toolkit/$program_name.conf",
79 "$home/.percona-toolkit.conf",
80 "$home/.$program_name.conf",
81 ],
82 types => {
83 string => 's', # standard Getopt type
84 int => 'i', # standard Getopt type
85 float => 'f', # standard Getopt type
86 Hash => 'H', # hash, formed from a comma-separated list
87 hash => 'h', # hash as above, but only if a value is given
88 Array => 'A', # array, similar to Hash
89 array => 'a', # array, similar to hash
90 DSN => 'd', # DSN
91 size => 'z', # size with kMG suffix (powers of 2^10)
92 time => 'm', # time, with an optional suffix of s/h/m/d
93 },
94 };
95
96 return bless $self, $class;
97}
98
99sub get_specs {
100 my ( $self, $file ) = @_;
101 $file ||= $self->{file} || __FILE__;
102 my @specs = $self->_pod_to_specs($file);
103 $self->_parse_specs(@specs);
104
105 open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR";
106 my $contents = do { local $/ = undef; <$fh> };
The diff has been truncated for viewing.

Subscribers

People subscribed via source and target branches