Merge lp:~percona-toolkit-dev/percona-toolkit/fix-pt-heartbeat-dupe-key-bug-1004567 into lp:percona-toolkit/2.0
- fix-pt-heartbeat-dupe-key-bug-1004567
- Merge into 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 |
Related bugs: |
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Daniel Nichter | Approve | ||
Review via email: mp+116084@code.launchpad.net |
Commit message
Description of the change
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
1 | === modified file '.bzrignore' | |||
2 | --- .bzrignore 2011-12-30 00:39:26 +0000 | |||
3 | +++ .bzrignore 2012-07-20 22:10:28 +0000 | |||
4 | @@ -4,5 +4,6 @@ | |||
5 | 4 | docs/test-coverage/db | 4 | docs/test-coverage/db |
6 | 5 | docs/test-coverage/html | 5 | docs/test-coverage/html |
7 | 6 | release | 6 | release |
8 | 7 | snapshot | ||
9 | 7 | .DS_Store | 8 | .DS_Store |
10 | 8 | build | 9 | build |
11 | 9 | 10 | ||
12 | === modified file 'Changelog' | |||
13 | --- Changelog 2012-06-09 21:53:04 +0000 | |||
14 | +++ Changelog 2012-07-20 22:10:28 +0000 | |||
15 | @@ -1,5 +1,6 @@ | |||
16 | 1 | Changelog for Percona Toolkit | 1 | Changelog for Percona Toolkit |
17 | 2 | 2 | ||
18 | 3 | <<<<<<< TREE | ||
19 | 3 | v2.0.5 released 2012-06-09 | 4 | v2.0.5 released 2012-06-09 |
20 | 4 | 5 | ||
21 | 5 | * Fixed bug 1002365: pt-table-sync --ignore-* options don't work with --replicate | 6 | * Fixed bug 1002365: pt-table-sync --ignore-* options don't work with --replicate |
22 | @@ -30,6 +31,96 @@ | |||
23 | 30 | * Fixed bug 953461: pt-upgrade manual broken 'output' section | 31 | * Fixed bug 953461: pt-upgrade manual broken 'output' section |
24 | 31 | * Fixed bug 949653: pt-table-checksum docs don't mention risks posed by inconsistent schemas | 32 | * Fixed bug 949653: pt-table-checksum docs don't mention risks posed by inconsistent schemas |
25 | 32 | 33 | ||
26 | 34 | ======= | ||
27 | 35 | v2.1.2 released 2012-06-12 | ||
28 | 36 | |||
29 | 37 | * pt-heartbeat: Implemented --recursion-method=none | ||
30 | 38 | * pt-index-usage: MySQL 5.5 compatibility fixes | ||
31 | 39 | * pt-log-player: MySQL 5.5 compatibility fixes | ||
32 | 40 | * pt-online-schema-change: Added --chunk-index-columns | ||
33 | 41 | * pt-online-schema-change: Added --[no]check-plan | ||
34 | 42 | * pt-online-schema-change: Added --[no]drop-new-table | ||
35 | 43 | * pt-online-schema-change: Implemented --recursion-method=none | ||
36 | 44 | * pt-query-advisor: Added --report-type for JSON output | ||
37 | 45 | * pt-query-digest: Removed --[no]zero-bool | ||
38 | 46 | * pt-slave-delay: Added --database | ||
39 | 47 | * pt-slave-find: Implemented --recursion-method=none | ||
40 | 48 | * pt-slave-restart: Implemented --recursion-method=none | ||
41 | 49 | * pt-table-checksum: Added --chunk-index-columns | ||
42 | 50 | * pt-table-checksum: Added --[no]check-plan | ||
43 | 51 | * pt-table-checksum: Implemented --recursion-method=none | ||
44 | 52 | * pt-table-sync: Disabled --lock-and-rename except for MySQL 5.5 and newer | ||
45 | 53 | * pt-table-sync: Implemented --recursion-method=none | ||
46 | 54 | * Fixed bug 945079: Shell tools TMPDIR may break | ||
47 | 55 | * Fixed bug 912902: Some shell tools still use basename | ||
48 | 56 | * Fixed bug 987694: There is no --recursion-method=none option | ||
49 | 57 | * Fixed bug 886077: Passwords with commas don't work, expose part of password | ||
50 | 58 | * Fixed bug 856024: Lintian warnings when building percona-toolkit Debian package | ||
51 | 59 | * Fixed bug 903379: pt-archiver --file doesn't create a file | ||
52 | 60 | * Fixed bug 979092: pt-archiver --sleep conflicts with bulk operations | ||
53 | 61 | * Fixed bug 903443: pt-deadlock-logger crashes on MySQL 5.5 | ||
54 | 62 | * Fixed bug 941064: pt-deadlock-logger can't clear deadlocks on 5.5 | ||
55 | 63 | * Fixed bug 952727: pt-diskstats shows incorrect wr_mb_s | ||
56 | 64 | * Fixed bug 994176: pt-diskstats --group-by=all --headers=scroll prints a header for every sample | ||
57 | 65 | * Fixed bug 894140: pt-duplicate-key-checker sometimes recreates a key it shouldn't | ||
58 | 66 | * Fixed bug 923896: pt-kill: uninitialized value causes script to exit | ||
59 | 67 | * Fixed bug 1003003: pt-online-schema-change uses different keys for chunking and triggers | ||
60 | 68 | * Fixed bug 1003315: pt-online-schema-change --dry-run always fails on table with foreign keys | ||
61 | 69 | * Fixed bug 1004551: pt-online-schema-change --no-swap-tables causes error | ||
62 | 70 | * Fixed bug 976108: pt-online-schema-change doesn't allow to disable foreign key checks | ||
63 | 71 | * Fixed bug 976109: pt-online-schema-change doesn't handle column renames | ||
64 | 72 | * Fixed bug 988036: pt-online-schema-change causes deadlocks under heavy write load | ||
65 | 73 | * Fixed bug 989227: pt-online-schema-change crashes with PTDEBUG | ||
66 | 74 | * Fixed bug 994002: pt-online-schema-change 2.1.1 doesn't choose the PRIMARY KEY | ||
67 | 75 | * Fixed bug 994010: pt-online-schema-change 2.1.1 crashes without InnoDB | ||
68 | 76 | * Fixed bug 996915: pt-online-schema-change crashes with invalid --max-load and --critical-load | ||
69 | 77 | * Fixed bug 998831: pt-online-schema-change -- Should have an option to NOT drop tables on failure | ||
70 | 78 | * Fixed bug 1002448: pt-online-schema-change: typo for finding usable indexes | ||
71 | 79 | * Fixed bug 885382: pt-query-digest --embedded-attributes doesn't check cardinality | ||
72 | 80 | * Fixed bug 888114: pt-query-digest report crashes with infinite loop | ||
73 | 81 | * Fixed bug 949630: pt-query-digest mentions a Subversion repository | ||
74 | 82 | * Fixed bug 844034: pt-show-grants --separate fails with proxy user | ||
75 | 83 | * Fixed bug 946707: pt-sift loses STDIN after pt-diskstats | ||
76 | 84 | * Fixed bug 994947: pt-stalk doesn't reset cycles_true after collection | ||
77 | 85 | * Fixed bug 986151: pt-stalk-has mktemp error | ||
78 | 86 | * Fixed bug 993436: pt-summary Memory: Total reports M instead of G | ||
79 | 87 | * Fixed bug 1008778: pt-table-checksum doesn't wait for checksum table to replicate | ||
80 | 88 | * Fixed bug 1010232: pt-table-checksum doesn't check the size of checksum chunks | ||
81 | 89 | * Fixed bug 1011738: pt-table-checksum SKIPPED is zero but chunks were skipped | ||
82 | 90 | * Fixed bug 919499: pt-table-checksum fails with binary log error in mysql >= 5.5.18 | ||
83 | 91 | * Fixed bug 972399: pt-table-checksum docs are not rendered right | ||
84 | 92 | * Fixed bug 978432: pt-table-checksum ignoring primary key | ||
85 | 93 | * Fixed bug 995274: pt-table-checksum can't use an undefined value as an ARRAY reference at line 2206 | ||
86 | 94 | * Fixed bug 996110: pt-table-checksum crashes if InnoDB is disabled | ||
87 | 95 | * Fixed bug 987393: pt-table-checksum: Empy tables cause "undefined value as an ARRAY" errors | ||
88 | 96 | * Fixed bug 997155: pt-table-sync sets binlog_format needlessly | ||
89 | 97 | * Fixed bug 1002365: pt-table-sync --ignore-* options don't work with --replicate | ||
90 | 98 | * Fixed bug 1003014: pt-table-sync --replicate and --sync-to-master error "index does not exist" | ||
91 | 99 | * Fixed bug 823403: pt-table-sync --lock-and-rename doesn't work on 5.1 | ||
92 | 100 | * Fixed bug 898138: pt-variable-advisor doesn't recognize 5.5.3+ concurrent_insert values | ||
93 | 101 | |||
94 | 102 | v2.1.1 released 2012-04-03 | ||
95 | 103 | |||
96 | 104 | * Completely redesigned pt-online-schema-change | ||
97 | 105 | * Completely redesigned pt-mysql-summary | ||
98 | 106 | * Completely redesigned pt-summary | ||
99 | 107 | * Added new tool: pt-table-usage | ||
100 | 108 | * Added new tool: pt-fingerprint | ||
101 | 109 | * Fixed bug 955860: pt-stalk doesn't run vmstat, iostat, and mpstat for --run-time | ||
102 | 110 | * Fixed bug 960513: SHOW TABLE STATUS is used needlessly | ||
103 | 111 | * Fixed bug 969726: pt-online-schema-change loses foreign keys | ||
104 | 112 | * Fixed bug 846028: pt-online-schema-change does not show progress until completed | ||
105 | 113 | * Fixed bug 898695: pt-online-schema-change add useless ORDER BY | ||
106 | 114 | * Fixed bug 952727: pt-diskstats shows incorrect wr_mb_s | ||
107 | 115 | * Fixed bug 963225: pt-query-digest fails to set history columns for disk tmp tables and disk filesort | ||
108 | 116 | * Fixed bug 967451: Char chunking doesn't quote column name | ||
109 | 117 | * Fixed bug 972399: pt-table-checksum docs are not rendered right | ||
110 | 118 | * Fixed bug 896553: Various documentation spelling fixes | ||
111 | 119 | * Fixed bug 949154: pt-variable-advisor advice for relay-log-space-limit | ||
112 | 120 | * Fixed bug 953461: pt-upgrade manual broken 'output' section | ||
113 | 121 | * Fixed bug 949653: pt-table-checksum docs don't mention risks posed by inconsistent schemas | ||
114 | 122 | |||
115 | 123 | >>>>>>> MERGE-SOURCE | ||
116 | 33 | v2.0.4 released 2012-03-07 | 124 | v2.0.4 released 2012-03-07 |
117 | 34 | 125 | ||
118 | 35 | * Added --filter to pt-kill to allow arbitrary --group-by | 126 | * Added --filter to pt-kill to allow arbitrary --group-by |
119 | 36 | 127 | ||
120 | === modified file 'MANIFEST' | |||
121 | --- MANIFEST 2012-02-03 23:25:29 +0000 | |||
122 | +++ MANIFEST 2012-07-20 22:10:28 +0000 | |||
123 | @@ -12,6 +12,7 @@ | |||
124 | 12 | bin/pt-duplicate-key-checker | 12 | bin/pt-duplicate-key-checker |
125 | 13 | bin/pt-fifo-split | 13 | bin/pt-fifo-split |
126 | 14 | bin/pt-find | 14 | bin/pt-find |
127 | 15 | bin/pt-fingerprint | ||
128 | 15 | bin/pt-fk-error-logger | 16 | bin/pt-fk-error-logger |
129 | 16 | bin/pt-heartbeat | 17 | bin/pt-heartbeat |
130 | 17 | bin/pt-index-usage | 18 | bin/pt-index-usage |
131 | @@ -33,6 +34,7 @@ | |||
132 | 33 | bin/pt-summary | 34 | bin/pt-summary |
133 | 34 | bin/pt-table-checksum | 35 | bin/pt-table-checksum |
134 | 35 | bin/pt-table-sync | 36 | bin/pt-table-sync |
135 | 37 | bin/pt-table-usage | ||
136 | 36 | bin/pt-tcp-model | 38 | bin/pt-tcp-model |
137 | 37 | bin/pt-trend | 39 | bin/pt-trend |
138 | 38 | bin/pt-upgrade | 40 | bin/pt-upgrade |
139 | 39 | 41 | ||
140 | === modified file 'Makefile.PL' | |||
141 | --- Makefile.PL 2012-06-09 21:53:04 +0000 | |||
142 | +++ Makefile.PL 2012-07-20 22:10:28 +0000 | |||
143 | @@ -2,13 +2,17 @@ | |||
144 | 2 | 2 | ||
145 | 3 | WriteMakefile( | 3 | WriteMakefile( |
146 | 4 | NAME => 'percona-toolkit', | 4 | NAME => 'percona-toolkit', |
147 | 5 | <<<<<<< TREE | ||
148 | 5 | VERSION => '2.0.5', | 6 | VERSION => '2.0.5', |
149 | 7 | ======= | ||
150 | 8 | VERSION => '2.1.2', | ||
151 | 9 | >>>>>>> MERGE-SOURCE | ||
152 | 6 | EXE_FILES => [ <bin/*> ], | 10 | EXE_FILES => [ <bin/*> ], |
153 | 7 | MAN1PODS => { | 11 | MAN1PODS => { |
155 | 8 | 'docs/percona-toolkit.pod' => 'blib/man1/percona-toolkit.1', | 12 | 'docs/percona-toolkit.pod' => 'blib/man1/percona-toolkit.1p', |
156 | 9 | map { | 13 | map { |
157 | 10 | (my $name = $_) =~ s/^bin.//; | 14 | (my $name = $_) =~ s/^bin.//; |
159 | 11 | $_ => "blib/man1/$name.1"; | 15 | $_ => "blib/man1/$name.1p"; |
160 | 12 | } <bin/*> | 16 | } <bin/*> |
161 | 13 | }, | 17 | }, |
162 | 14 | MAN3PODS => {}, # man(3) pages are for C libs | 18 | MAN3PODS => {}, # man(3) pages are for C libs |
163 | 15 | 19 | ||
164 | === modified file 'bin/pt-align' | |||
165 | --- bin/pt-align 2012-06-09 21:53:04 +0000 | |||
166 | +++ bin/pt-align 2012-07-20 22:10:28 +0000 | |||
167 | @@ -218,6 +218,10 @@ | |||
168 | 218 | 218 | ||
169 | 219 | =head1 VERSION | 219 | =head1 VERSION |
170 | 220 | 220 | ||
171 | 221 | <<<<<<< TREE | ||
172 | 221 | pt-align 2.0.5 | 222 | pt-align 2.0.5 |
173 | 223 | ======= | ||
174 | 224 | pt-align 2.1.2 | ||
175 | 225 | >>>>>>> MERGE-SOURCE | ||
176 | 222 | 226 | ||
177 | 223 | =cut | 227 | =cut |
178 | 224 | 228 | ||
179 | === modified file 'bin/pt-archiver' | |||
180 | --- bin/pt-archiver 2012-06-09 21:53:04 +0000 | |||
181 | +++ bin/pt-archiver 2012-07-20 22:10:28 +0000 | |||
182 | @@ -959,7 +959,7 @@ | |||
183 | 959 | $opt->{value} = ($pre || '') . $num; | 959 | $opt->{value} = ($pre || '') . $num; |
184 | 960 | } | 960 | } |
185 | 961 | else { | 961 | else { |
187 | 962 | $self->save_error("Invalid size for --$opt->{long}"); | 962 | $self->save_error("Invalid size for --$opt->{long}: $val"); |
188 | 963 | } | 963 | } |
189 | 964 | return; | 964 | return; |
190 | 965 | } | 965 | } |
191 | @@ -1034,6 +1034,456 @@ | |||
192 | 1034 | # ########################################################################### | 1034 | # ########################################################################### |
193 | 1035 | 1035 | ||
194 | 1036 | # ########################################################################### | 1036 | # ########################################################################### |
195 | 1037 | # Mo package | ||
196 | 1038 | # This package is a copy without comments from the original. The original | ||
197 | 1039 | # with comments and its test file can be found in the Bazaar repository at, | ||
198 | 1040 | # lib/Mo.pm | ||
199 | 1041 | # t/lib/Mo.t | ||
200 | 1042 | # See https://launchpad.net/percona-toolkit for more information. | ||
201 | 1043 | # ########################################################################### | ||
202 | 1044 | { | ||
203 | 1045 | BEGIN { | ||
204 | 1046 | $INC{"Mo.pm"} = __FILE__; | ||
205 | 1047 | package Mo; | ||
206 | 1048 | our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo. | ||
207 | 1049 | |||
208 | 1050 | { | ||
209 | 1051 | no strict 'refs'; | ||
210 | 1052 | sub _glob_for { | ||
211 | 1053 | return \*{shift()} | ||
212 | 1054 | } | ||
213 | 1055 | |||
214 | 1056 | sub _stash_for { | ||
215 | 1057 | return \%{ shift() . "::" }; | ||
216 | 1058 | } | ||
217 | 1059 | } | ||
218 | 1060 | |||
219 | 1061 | use strict; | ||
220 | 1062 | use warnings qw( FATAL all ); | ||
221 | 1063 | |||
222 | 1064 | use Carp (); | ||
223 | 1065 | use Scalar::Util (); | ||
224 | 1066 | |||
225 | 1067 | our %TYPES = ( | ||
226 | 1068 | Bool => sub { !$_[0] || (defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == 1) }, | ||
227 | 1069 | Num => sub { defined $_[0] && &Scalar::Util::looks_like_number }, | ||
228 | 1070 | Int => sub { defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == int $_[0] }, | ||
229 | 1071 | Str => sub { defined $_[0] }, | ||
230 | 1072 | Object => sub { defined $_[0] && &Scalar::Util::blessed }, | ||
231 | 1073 | FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened }, | ||
232 | 1074 | |||
233 | 1075 | map { | ||
234 | 1076 | my $type = /R/ ? $_ : uc $_; | ||
235 | 1077 | $_ . "Ref" => sub { ref $_[0] eq $type } | ||
236 | 1078 | } qw(Array Code Hash Regexp Glob Scalar) | ||
237 | 1079 | ); | ||
238 | 1080 | |||
239 | 1081 | our %metadata_for; | ||
240 | 1082 | { | ||
241 | 1083 | package Mo::Object; | ||
242 | 1084 | |||
243 | 1085 | sub new { | ||
244 | 1086 | my $class = shift; | ||
245 | 1087 | my $args = $class->BUILDARGS(@_); | ||
246 | 1088 | |||
247 | 1089 | my @args_to_delete; | ||
248 | 1090 | while ( my ($attr, $meta) = each %{$metadata_for{$class}} ) { | ||
249 | 1091 | next unless exists $meta->{init_arg}; | ||
250 | 1092 | my $init_arg = $meta->{init_arg}; | ||
251 | 1093 | |||
252 | 1094 | if ( defined $init_arg ) { | ||
253 | 1095 | $args->{$attr} = delete $args->{$init_arg}; | ||
254 | 1096 | } | ||
255 | 1097 | else { | ||
256 | 1098 | push @args_to_delete, $attr; | ||
257 | 1099 | } | ||
258 | 1100 | } | ||
259 | 1101 | |||
260 | 1102 | delete $args->{$_} for @args_to_delete; | ||
261 | 1103 | |||
262 | 1104 | for my $attribute ( keys %$args ) { | ||
263 | 1105 | if ( my $coerce = $metadata_for{$class}{$attribute}{coerce} ) { | ||
264 | 1106 | $args->{$attribute} = $coerce->($args->{$attribute}); | ||
265 | 1107 | } | ||
266 | 1108 | if ( my $I = $metadata_for{$class}{$attribute}{isa} ) { | ||
267 | 1109 | ( (my $I_name), $I ) = @{$I}; | ||
268 | 1110 | Mo::_check_type_constaints($attribute, $I, $I_name, $args->{$attribute}); | ||
269 | 1111 | } | ||
270 | 1112 | } | ||
271 | 1113 | |||
272 | 1114 | while ( my ($attribute, $meta) = each %{$metadata_for{$class}} ) { | ||
273 | 1115 | next unless $meta->{required}; | ||
274 | 1116 | Carp::confess("Attribute ($attribute) is required for $class") | ||
275 | 1117 | if ! exists $args->{$attribute} | ||
276 | 1118 | } | ||
277 | 1119 | |||
278 | 1120 | @_ = %$args; | ||
279 | 1121 | my $self = bless $args, $class; | ||
280 | 1122 | |||
281 | 1123 | my @build_subs; | ||
282 | 1124 | my $linearized_isa = mro::get_linear_isa($class); | ||
283 | 1125 | |||
284 | 1126 | for my $isa_class ( @$linearized_isa ) { | ||
285 | 1127 | unshift @build_subs, *{ Mo::_glob_for "${isa_class}::BUILD" }{CODE}; | ||
286 | 1128 | } | ||
287 | 1129 | exists &$_ && $_->( $self, @_ ) for grep { defined } @build_subs; | ||
288 | 1130 | return $self; | ||
289 | 1131 | } | ||
290 | 1132 | |||
291 | 1133 | sub BUILDARGS { | ||
292 | 1134 | shift; | ||
293 | 1135 | my $ref; | ||
294 | 1136 | if ( @_ == 1 && ref($_[0]) ) { | ||
295 | 1137 | Carp::confess("Single parameters to new() must be a HASH ref") | ||
296 | 1138 | unless ref($_[0]) eq ref({}); | ||
297 | 1139 | $ref = {%{$_[0]}} # We want a new reference, always | ||
298 | 1140 | } | ||
299 | 1141 | else { | ||
300 | 1142 | $ref = { @_ }; | ||
301 | 1143 | } | ||
302 | 1144 | return $ref; | ||
303 | 1145 | } | ||
304 | 1146 | } | ||
305 | 1147 | |||
306 | 1148 | my %export_for; | ||
307 | 1149 | sub Mo::import { | ||
308 | 1150 | warnings->import(qw(FATAL all)); | ||
309 | 1151 | strict->import(); | ||
310 | 1152 | |||
311 | 1153 | my $caller = scalar caller(); # Caller's package | ||
312 | 1154 | my $caller_pkg = $caller . "::"; # Caller's package with :: at the end | ||
313 | 1155 | my (%exports, %options); | ||
314 | 1156 | |||
315 | 1157 | my (undef, @features) = @_; | ||
316 | 1158 | my %ignore = ( map { $_ => 1 } qw( is isa init_arg builder buildargs clearer predicate build handles default required ) ); | ||
317 | 1159 | for my $feature (grep { !$ignore{$_} } @features) { | ||
318 | 1160 | { local $@; require "Mo/$feature.pm"; } | ||
319 | 1161 | { | ||
320 | 1162 | no strict 'refs'; | ||
321 | 1163 | &{"Mo::${feature}::e"}( | ||
322 | 1164 | $caller_pkg, | ||
323 | 1165 | \%exports, | ||
324 | 1166 | \%options, | ||
325 | 1167 | \@_ | ||
326 | 1168 | ); | ||
327 | 1169 | } | ||
328 | 1170 | } | ||
329 | 1171 | |||
330 | 1172 | return if $exports{M}; | ||
331 | 1173 | |||
332 | 1174 | %exports = ( | ||
333 | 1175 | extends => sub { | ||
334 | 1176 | for my $class ( map { "$_" } @_ ) { | ||
335 | 1177 | $class =~ s{::|'}{/}g; | ||
336 | 1178 | { local $@; eval { require "$class.pm" } } # or warn $@; | ||
337 | 1179 | } | ||
338 | 1180 | _set_package_isa($caller, @_); | ||
339 | 1181 | _set_inherited_metadata($caller); | ||
340 | 1182 | }, | ||
341 | 1183 | has => sub { | ||
342 | 1184 | my $names = shift; | ||
343 | 1185 | for my $attribute ( ref $names ? @$names : $names ) { | ||
344 | 1186 | my %args = @_; | ||
345 | 1187 | my $method = ($args{is} || '') eq 'ro' | ||
346 | 1188 | ? sub { | ||
347 | 1189 | Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller_pkg}${attribute}") | ||
348 | 1190 | if $#_; | ||
349 | 1191 | return $_[0]{$attribute}; | ||
350 | 1192 | } | ||
351 | 1193 | : sub { | ||
352 | 1194 | return $#_ | ||
353 | 1195 | ? $_[0]{$attribute} = $_[1] | ||
354 | 1196 | : $_[0]{$attribute}; | ||
355 | 1197 | }; | ||
356 | 1198 | |||
357 | 1199 | $metadata_for{$caller}{$attribute} = (); | ||
358 | 1200 | |||
359 | 1201 | if ( my $I = $args{isa} ) { | ||
360 | 1202 | my $orig_I = $I; | ||
361 | 1203 | my $type; | ||
362 | 1204 | if ( $I =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) { | ||
363 | 1205 | $I = _nested_constraints($attribute, $1, $2); | ||
364 | 1206 | } | ||
365 | 1207 | $metadata_for{$caller}{$attribute}{isa} = [$orig_I, $I]; | ||
366 | 1208 | my $orig_method = $method; | ||
367 | 1209 | $method = sub { | ||
368 | 1210 | if ( $#_ ) { | ||
369 | 1211 | Mo::_check_type_constaints($attribute, $I, $orig_I, $_[1]); | ||
370 | 1212 | } | ||
371 | 1213 | goto &$orig_method; | ||
372 | 1214 | }; | ||
373 | 1215 | } | ||
374 | 1216 | |||
375 | 1217 | if ( my $builder = $args{builder} ) { | ||
376 | 1218 | my $original_method = $method; | ||
377 | 1219 | $method = sub { | ||
378 | 1220 | $#_ | ||
379 | 1221 | ? goto &$original_method | ||
380 | 1222 | : ! exists $_[0]{$attribute} | ||
381 | 1223 | ? $_[0]{$attribute} = $_[0]->$builder | ||
382 | 1224 | : goto &$original_method | ||
383 | 1225 | }; | ||
384 | 1226 | } | ||
385 | 1227 | |||
386 | 1228 | if ( my $code = $args{default} ) { | ||
387 | 1229 | Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef") | ||
388 | 1230 | unless ref($code) eq 'CODE'; | ||
389 | 1231 | my $original_method = $method; | ||
390 | 1232 | $method = sub { | ||
391 | 1233 | $#_ | ||
392 | 1234 | ? goto &$original_method | ||
393 | 1235 | : ! exists $_[0]{$attribute} | ||
394 | 1236 | ? $_[0]{$attribute} = $_[0]->$code | ||
395 | 1237 | : goto &$original_method | ||
396 | 1238 | }; | ||
397 | 1239 | } | ||
398 | 1240 | |||
399 | 1241 | if ( my $role = $args{does} ) { | ||
400 | 1242 | my $original_method = $method; | ||
401 | 1243 | $method = sub { | ||
402 | 1244 | if ( $#_ ) { | ||
403 | 1245 | Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">) | ||
404 | 1246 | unless blessed($_[1]) && $_[1]->does($role) | ||
405 | 1247 | } | ||
406 | 1248 | goto &$original_method | ||
407 | 1249 | }; | ||
408 | 1250 | } | ||
409 | 1251 | |||
410 | 1252 | if ( my $coercion = $args{coerce} ) { | ||
411 | 1253 | $metadata_for{$caller}{$attribute}{coerce} = $coercion; | ||
412 | 1254 | my $original_method = $method; | ||
413 | 1255 | $method = sub { | ||
414 | 1256 | if ( $#_ ) { | ||
415 | 1257 | return $original_method->($_[0], $coercion->($_[1])) | ||
416 | 1258 | } | ||
417 | 1259 | goto &$original_method; | ||
418 | 1260 | } | ||
419 | 1261 | } | ||
420 | 1262 | |||
421 | 1263 | $method = $options{$_}->($method, $attribute, @_) | ||
422 | 1264 | for sort keys %options; | ||
423 | 1265 | |||
424 | 1266 | *{ _glob_for "${caller}::$attribute" } = $method; | ||
425 | 1267 | |||
426 | 1268 | if ( $args{required} ) { | ||
427 | 1269 | $metadata_for{$caller}{$attribute}{required} = 1; | ||
428 | 1270 | } | ||
429 | 1271 | |||
430 | 1272 | if ($args{clearer}) { | ||
431 | 1273 | *{ _glob_for "${caller}::$args{clearer}" } | ||
432 | 1274 | = sub { delete shift->{$attribute} } | ||
433 | 1275 | } | ||
434 | 1276 | |||
435 | 1277 | if ($args{predicate}) { | ||
436 | 1278 | *{ _glob_for "${caller}::$args{predicate}" } | ||
437 | 1279 | = sub { exists shift->{$attribute} } | ||
438 | 1280 | } | ||
439 | 1281 | |||
440 | 1282 | if ($args{handles}) { | ||
441 | 1283 | _has_handles($caller, $attribute, \%args); | ||
442 | 1284 | } | ||
443 | 1285 | |||
444 | 1286 | if (exists $args{init_arg}) { | ||
445 | 1287 | $metadata_for{$caller}{$attribute}{init_arg} = $args{init_arg}; | ||
446 | 1288 | } | ||
447 | 1289 | } | ||
448 | 1290 | }, | ||
449 | 1291 | %exports, | ||
450 | 1292 | ); | ||
451 | 1293 | |||
452 | 1294 | $export_for{$caller} = [ keys %exports ]; | ||
453 | 1295 | |||
454 | 1296 | for my $keyword ( keys %exports ) { | ||
455 | 1297 | *{ _glob_for "${caller}::$keyword" } = $exports{$keyword} | ||
456 | 1298 | } | ||
457 | 1299 | *{ _glob_for "${caller}::extends" }{CODE}->( "Mo::Object" ) | ||
458 | 1300 | unless @{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] }; | ||
459 | 1301 | }; | ||
460 | 1302 | |||
461 | 1303 | sub _check_type_constaints { | ||
462 | 1304 | my ($attribute, $I, $I_name, $val) = @_; | ||
463 | 1305 | ( ref($I) eq 'CODE' | ||
464 | 1306 | ? $I->($val) | ||
465 | 1307 | : (ref $val eq $I | ||
466 | 1308 | || ($val && $val eq $I) | ||
467 | 1309 | || (exists $TYPES{$I} && $TYPES{$I}->($val))) | ||
468 | 1310 | ) | ||
469 | 1311 | || Carp::confess( | ||
470 | 1312 | qq<Attribute ($attribute) does not pass the type constraint because: > | ||
471 | 1313 | . qq<Validation failed for '$I_name' with value > | ||
472 | 1314 | . (defined $val ? Mo::Dumper($val) : 'undef') ) | ||
473 | 1315 | } | ||
474 | 1316 | |||
475 | 1317 | sub _has_handles { | ||
476 | 1318 | my ($caller, $attribute, $args) = @_; | ||
477 | 1319 | my $handles = $args->{handles}; | ||
478 | 1320 | |||
479 | 1321 | my $ref = ref $handles; | ||
480 | 1322 | my $kv; | ||
481 | 1323 | if ( $ref eq ref [] ) { | ||
482 | 1324 | $kv = { map { $_,$_ } @{$handles} }; | ||
483 | 1325 | } | ||
484 | 1326 | elsif ( $ref eq ref {} ) { | ||
485 | 1327 | $kv = $handles; | ||
486 | 1328 | } | ||
487 | 1329 | elsif ( $ref eq ref qr// ) { | ||
488 | 1330 | Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)") | ||
489 | 1331 | unless $args->{isa}; | ||
490 | 1332 | my $target_class = $args->{isa}; | ||
491 | 1333 | $kv = { | ||
492 | 1334 | map { $_, $_ } | ||
493 | 1335 | grep { $_ =~ $handles } | ||
494 | 1336 | grep { !exists $Mo::Object::{$_} && $target_class->can($_) } | ||
495 | 1337 | grep { $_ ne 'has' && $_ ne 'extends' } | ||
496 | 1338 | keys %{ _stash_for $target_class } | ||
497 | 1339 | }; | ||
498 | 1340 | } | ||
499 | 1341 | else { | ||
500 | 1342 | Carp::confess("handles for $ref not yet implemented"); | ||
501 | 1343 | } | ||
502 | 1344 | |||
503 | 1345 | while ( my ($method, $target) = each %{$kv} ) { | ||
504 | 1346 | my $name = _glob_for "${caller}::$method"; | ||
505 | 1347 | Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation") | ||
506 | 1348 | if defined &$name; | ||
507 | 1349 | |||
508 | 1350 | my ($target, @curried_args) = ref($target) ? @$target : $target; | ||
509 | 1351 | *$name = sub { | ||
510 | 1352 | my $self = shift; | ||
511 | 1353 | my $delegate_to = $self->$attribute(); | ||
512 | 1354 | my $error = "Cannot delegate $method to $target because the value of $attribute"; | ||
513 | 1355 | Carp::confess("$error is not defined") unless $delegate_to; | ||
514 | 1356 | Carp::confess("$error is not an object (got '$delegate_to')") | ||
515 | 1357 | unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target)); | ||
516 | 1358 | return $delegate_to->$target(@curried_args, @_); | ||
517 | 1359 | } | ||
518 | 1360 | } | ||
519 | 1361 | } | ||
520 | 1362 | |||
521 | 1363 | sub _nested_constraints { | ||
522 | 1364 | my ($attribute, $aggregate_type, $type) = @_; | ||
523 | 1365 | |||
524 | 1366 | my $inner_types; | ||
525 | 1367 | if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) { | ||
526 | 1368 | $inner_types = _nested_constraints($1, $2); | ||
527 | 1369 | } | ||
528 | 1370 | else { | ||
529 | 1371 | $inner_types = $TYPES{$type}; | ||
530 | 1372 | } | ||
531 | 1373 | |||
532 | 1374 | if ( $aggregate_type eq 'ArrayRef' ) { | ||
533 | 1375 | return sub { | ||
534 | 1376 | my ($val) = @_; | ||
535 | 1377 | return unless ref($val) eq ref([]); | ||
536 | 1378 | |||
537 | 1379 | if ($inner_types) { | ||
538 | 1380 | for my $value ( @{$val} ) { | ||
539 | 1381 | return unless $inner_types->($value) | ||
540 | 1382 | } | ||
541 | 1383 | } | ||
542 | 1384 | else { | ||
543 | 1385 | for my $value ( @{$val} ) { | ||
544 | 1386 | return unless $value && ($value eq $type | ||
545 | 1387 | || (Scalar::Util::blessed($value) && $value->isa($type))); | ||
546 | 1388 | } | ||
547 | 1389 | } | ||
548 | 1390 | return 1; | ||
549 | 1391 | }; | ||
550 | 1392 | } | ||
551 | 1393 | elsif ( $aggregate_type eq 'Maybe' ) { | ||
552 | 1394 | return sub { | ||
553 | 1395 | my ($value) = @_; | ||
554 | 1396 | return 1 if ! defined($value); | ||
555 | 1397 | if ($inner_types) { | ||
556 | 1398 | return unless $inner_types->($value) | ||
557 | 1399 | } | ||
558 | 1400 | else { | ||
559 | 1401 | return unless $value eq $type | ||
560 | 1402 | || (Scalar::Util::blessed($value) && $value->isa($type)); | ||
561 | 1403 | } | ||
562 | 1404 | return 1; | ||
563 | 1405 | } | ||
564 | 1406 | } | ||
565 | 1407 | else { | ||
566 | 1408 | Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe"); | ||
567 | 1409 | } | ||
568 | 1410 | } | ||
569 | 1411 | |||
570 | 1412 | sub _set_package_isa { | ||
571 | 1413 | my ($package, @new_isa) = @_; | ||
572 | 1414 | |||
573 | 1415 | *{ _glob_for "${package}::ISA" } = [@new_isa]; | ||
574 | 1416 | } | ||
575 | 1417 | |||
576 | 1418 | sub _set_inherited_metadata { | ||
577 | 1419 | my $class = shift; | ||
578 | 1420 | my $linearized_isa = mro::get_linear_isa($class); | ||
579 | 1421 | my %new_metadata; | ||
580 | 1422 | |||
581 | 1423 | for my $isa_class (reverse @$linearized_isa) { | ||
582 | 1424 | %new_metadata = ( | ||
583 | 1425 | %new_metadata, | ||
584 | 1426 | %{ $metadata_for{$isa_class} || {} }, | ||
585 | 1427 | ); | ||
586 | 1428 | } | ||
587 | 1429 | $metadata_for{$class} = \%new_metadata; | ||
588 | 1430 | } | ||
589 | 1431 | |||
590 | 1432 | sub unimport { | ||
591 | 1433 | my $caller = scalar caller(); | ||
592 | 1434 | my $stash = _stash_for( $caller ); | ||
593 | 1435 | |||
594 | 1436 | delete $stash->{$_} for @{$export_for{$caller}}; | ||
595 | 1437 | } | ||
596 | 1438 | |||
597 | 1439 | sub Dumper { | ||
598 | 1440 | require Data::Dumper; | ||
599 | 1441 | local $Data::Dumper::Indent = 0; | ||
600 | 1442 | local $Data::Dumper::Sortkeys = 0; | ||
601 | 1443 | local $Data::Dumper::Quotekeys = 0; | ||
602 | 1444 | local $Data::Dumper::Terse = 1; | ||
603 | 1445 | |||
604 | 1446 | Data::Dumper::Dumper(@_) | ||
605 | 1447 | } | ||
606 | 1448 | |||
607 | 1449 | BEGIN { | ||
608 | 1450 | if ($] >= 5.010) { | ||
609 | 1451 | { local $@; require mro; } | ||
610 | 1452 | } | ||
611 | 1453 | else { | ||
612 | 1454 | local $@; | ||
613 | 1455 | eval { | ||
614 | 1456 | require MRO::Compat; | ||
615 | 1457 | } or do { | ||
616 | 1458 | *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub { | ||
617 | 1459 | no strict 'refs'; | ||
618 | 1460 | |||
619 | 1461 | my $classname = shift; | ||
620 | 1462 | |||
621 | 1463 | my @lin = ($classname); | ||
622 | 1464 | my %stored; | ||
623 | 1465 | foreach my $parent (@{"$classname\::ISA"}) { | ||
624 | 1466 | my $plin = mro::get_linear_isa_dfs($parent); | ||
625 | 1467 | foreach (@$plin) { | ||
626 | 1468 | next if exists $stored{$_}; | ||
627 | 1469 | push(@lin, $_); | ||
628 | 1470 | $stored{$_} = 1; | ||
629 | 1471 | } | ||
630 | 1472 | } | ||
631 | 1473 | return \@lin; | ||
632 | 1474 | }; | ||
633 | 1475 | } | ||
634 | 1476 | } | ||
635 | 1477 | } | ||
636 | 1478 | |||
637 | 1479 | } | ||
638 | 1480 | 1; | ||
639 | 1481 | } | ||
640 | 1482 | # ########################################################################### | ||
641 | 1483 | # End Mo package | ||
642 | 1484 | # ########################################################################### | ||
643 | 1485 | |||
644 | 1486 | # ########################################################################### | ||
645 | 1037 | # TableParser package | 1487 | # TableParser package |
646 | 1038 | # This package is a copy without comments from the original. The original | 1488 | # This package is a copy without comments from the original. The original |
647 | 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, |
648 | @@ -1064,23 +1514,64 @@ | |||
649 | 1064 | return bless $self, $class; | 1514 | return bless $self, $class; |
650 | 1065 | } | 1515 | } |
651 | 1066 | 1516 | ||
652 | 1517 | sub get_create_table { | ||
653 | 1518 | my ( $self, $dbh, $db, $tbl ) = @_; | ||
654 | 1519 | die "I need a dbh parameter" unless $dbh; | ||
655 | 1520 | die "I need a db parameter" unless $db; | ||
656 | 1521 | die "I need a tbl parameter" unless $tbl; | ||
657 | 1522 | my $q = $self->{Quoter}; | ||
658 | 1523 | |||
659 | 1524 | my $new_sql_mode | ||
660 | 1525 | = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
661 | 1526 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
662 | 1527 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
663 | 1528 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
664 | 1529 | |||
665 | 1530 | my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
666 | 1531 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
667 | 1532 | |||
668 | 1533 | PTDEBUG && _d($new_sql_mode); | ||
669 | 1534 | eval { $dbh->do($new_sql_mode); }; | ||
670 | 1535 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
671 | 1536 | |||
672 | 1537 | my $use_sql = 'USE ' . $q->quote($db); | ||
673 | 1538 | PTDEBUG && _d($dbh, $use_sql); | ||
674 | 1539 | $dbh->do($use_sql); | ||
675 | 1540 | |||
676 | 1541 | my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl); | ||
677 | 1542 | PTDEBUG && _d($show_sql); | ||
678 | 1543 | my $href; | ||
679 | 1544 | eval { $href = $dbh->selectrow_hashref($show_sql); }; | ||
680 | 1545 | if ( $EVAL_ERROR ) { | ||
681 | 1546 | PTDEBUG && _d($EVAL_ERROR); | ||
682 | 1547 | |||
683 | 1548 | PTDEBUG && _d($old_sql_mode); | ||
684 | 1549 | $dbh->do($old_sql_mode); | ||
685 | 1550 | |||
686 | 1551 | return; | ||
687 | 1552 | } | ||
688 | 1553 | |||
689 | 1554 | PTDEBUG && _d($old_sql_mode); | ||
690 | 1555 | $dbh->do($old_sql_mode); | ||
691 | 1556 | |||
692 | 1557 | my ($key) = grep { m/create (?:table|view)/i } keys %$href; | ||
693 | 1558 | if ( !$key ) { | ||
694 | 1559 | die "Error: no 'Create Table' or 'Create View' in result set from " | ||
695 | 1560 | . "$show_sql: " . Dumper($href); | ||
696 | 1561 | } | ||
697 | 1562 | |||
698 | 1563 | return $href->{$key}; | ||
699 | 1564 | } | ||
700 | 1565 | |||
701 | 1067 | sub parse { | 1566 | sub parse { |
702 | 1068 | my ( $self, $ddl, $opts ) = @_; | 1567 | my ( $self, $ddl, $opts ) = @_; |
703 | 1069 | return unless $ddl; | 1568 | return unless $ddl; |
713 | 1070 | if ( ref $ddl eq 'ARRAY' ) { | 1569 | |
714 | 1071 | if ( lc $ddl->[0] eq 'table' ) { | 1570 | if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) { |
715 | 1072 | $ddl = $ddl->[1]; | 1571 | $ddl = $self->ansi_to_legacy($ddl); |
707 | 1073 | } | ||
708 | 1074 | else { | ||
709 | 1075 | return { | ||
710 | 1076 | engine => 'VIEW', | ||
711 | 1077 | }; | ||
712 | 1078 | } | ||
716 | 1079 | } | 1572 | } |
721 | 1080 | 1573 | elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { | |
722 | 1081 | if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { | 1574 | die "TableParser doesn't handle CREATE TABLE without quoting."; |
719 | 1082 | die "Cannot parse table definition; is ANSI quoting " | ||
720 | 1083 | . "enabled or SQL_QUOTE_SHOW_CREATE disabled?"; | ||
723 | 1084 | } | 1575 | } |
724 | 1085 | 1576 | ||
725 | 1086 | my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; | 1577 | my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; |
726 | @@ -1289,19 +1780,13 @@ | |||
727 | 1289 | my $key_ddl = $key; | 1780 | my $key_ddl = $key; |
728 | 1290 | PTDEBUG && _d('Parsed key:', $key_ddl); | 1781 | PTDEBUG && _d('Parsed key:', $key_ddl); |
729 | 1291 | 1782 | ||
731 | 1292 | if ( $engine !~ m/MEMORY|HEAP/ ) { | 1783 | if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) { |
732 | 1293 | $key =~ s/USING HASH/USING BTREE/; | 1784 | $key =~ s/USING HASH/USING BTREE/; |
733 | 1294 | } | 1785 | } |
734 | 1295 | 1786 | ||
735 | 1296 | my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; | 1787 | my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; |
736 | 1297 | my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; | 1788 | my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; |
737 | 1298 | $type = $type || $special || 'BTREE'; | 1789 | $type = $type || $special || 'BTREE'; |
738 | 1299 | if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000' | ||
739 | 1300 | && $engine =~ m/HEAP|MEMORY/i ) | ||
740 | 1301 | { | ||
741 | 1302 | $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP | ||
742 | 1303 | } | ||
743 | 1304 | |||
744 | 1305 | my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; | 1790 | my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; |
745 | 1306 | my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; | 1791 | my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; |
746 | 1307 | my @cols; | 1792 | my @cols; |
747 | @@ -1327,7 +1812,7 @@ | |||
748 | 1327 | ddl => $key_ddl, | 1812 | ddl => $key_ddl, |
749 | 1328 | }; | 1813 | }; |
750 | 1329 | 1814 | ||
752 | 1330 | if ( $engine =~ m/InnoDB/i && !$clustered_key ) { | 1815 | if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) { |
753 | 1331 | my $this_key = $keys->{$name}; | 1816 | my $this_key = $keys->{$name}; |
754 | 1332 | if ( $this_key->{name} eq 'PRIMARY' ) { | 1817 | if ( $this_key->{name} eq 'PRIMARY' ) { |
755 | 1333 | $clustered_key = 'PRIMARY'; | 1818 | $clustered_key = 'PRIMARY'; |
756 | @@ -1383,41 +1868,46 @@ | |||
757 | 1383 | return $ddl; | 1868 | return $ddl; |
758 | 1384 | } | 1869 | } |
759 | 1385 | 1870 | ||
795 | 1386 | sub remove_secondary_indexes { | 1871 | sub get_table_status { |
796 | 1387 | my ( $self, $ddl ) = @_; | 1872 | my ( $self, $dbh, $db, $like ) = @_; |
797 | 1388 | my $sec_indexes_ddl; | 1873 | my $q = $self->{Quoter}; |
798 | 1389 | my $tbl_struct = $self->parse($ddl); | 1874 | my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db); |
799 | 1390 | 1875 | my @params; | |
800 | 1391 | if ( ($tbl_struct->{engine} || '') =~ m/InnoDB/i ) { | 1876 | if ( $like ) { |
801 | 1392 | my $clustered_key = $tbl_struct->{clustered_key}; | 1877 | $sql .= ' LIKE ?'; |
802 | 1393 | $clustered_key ||= ''; | 1878 | push @params, $like; |
803 | 1394 | 1879 | } | |
804 | 1395 | my @sec_indexes = map { | 1880 | PTDEBUG && _d($sql, @params); |
805 | 1396 | my $key_def = $_->{ddl}; | 1881 | my $sth = $dbh->prepare($sql); |
806 | 1397 | $key_def =~ s/([\(\)])/\\$1/g; | 1882 | eval { $sth->execute(@params); }; |
807 | 1398 | $ddl =~ s/\s+$key_def//i; | 1883 | if ($EVAL_ERROR) { |
808 | 1399 | 1884 | PTDEBUG && _d($EVAL_ERROR); | |
809 | 1400 | my $key_ddl = "ADD $_->{ddl}"; | 1885 | return; |
810 | 1401 | $key_ddl .= ',' unless $key_ddl =~ m/,$/; | 1886 | } |
811 | 1402 | $key_ddl; | 1887 | my @tables = @{$sth->fetchall_arrayref({})}; |
812 | 1403 | } | 1888 | @tables = map { |
813 | 1404 | grep { $_->{name} ne $clustered_key } | 1889 | my %tbl; # Make a copy with lowercased keys |
814 | 1405 | values %{$tbl_struct->{keys}}; | 1890 | @tbl{ map { lc $_ } keys %$_ } = values %$_; |
815 | 1406 | PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); | 1891 | $tbl{engine} ||= $tbl{type} || $tbl{comment}; |
816 | 1407 | 1892 | delete $tbl{type}; | |
817 | 1408 | if ( @sec_indexes ) { | 1893 | \%tbl; |
818 | 1409 | $sec_indexes_ddl = join(' ', @sec_indexes); | 1894 | } @tables; |
819 | 1410 | $sec_indexes_ddl =~ s/,$//; | 1895 | return @tables; |
820 | 1411 | } | 1896 | } |
821 | 1412 | 1897 | ||
822 | 1413 | $ddl =~ s/,(\n\) )/$1/s; | 1898 | my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx; |
823 | 1414 | } | 1899 | sub ansi_to_legacy { |
824 | 1415 | else { | 1900 | my ($self, $ddl) = @_; |
825 | 1416 | PTDEBUG && _d('Not removing secondary indexes from', | 1901 | $ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge; |
826 | 1417 | $tbl_struct->{engine}, 'table'); | 1902 | return $ddl; |
827 | 1418 | } | 1903 | } |
828 | 1419 | 1904 | ||
829 | 1420 | return $ddl, $sec_indexes_ddl, $tbl_struct; | 1905 | sub ansi_quote_replace { |
830 | 1906 | my ($val) = @_; | ||
831 | 1907 | $val =~ s/^"|"$//g; | ||
832 | 1908 | $val =~ s/`/``/g; | ||
833 | 1909 | $val =~ s/""/"/g; | ||
834 | 1910 | return "`$val`"; | ||
835 | 1421 | } | 1911 | } |
836 | 1422 | 1912 | ||
837 | 1423 | sub _d { | 1913 | sub _d { |
838 | @@ -1663,51 +2153,10 @@ | |||
839 | 1663 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, | 2153 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, |
840 | 1664 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); | 2154 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); |
841 | 1665 | 2155 | ||
880 | 1666 | eval { | 2156 | $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) }; |
881 | 1667 | $dbh = DBI->connect($cxn_string, $user, $pass, $defaults); | 2157 | |
844 | 1668 | |||
845 | 1669 | if ( $cxn_string =~ m/mysql/i ) { | ||
846 | 1670 | my $sql; | ||
847 | 1671 | |||
848 | 1672 | $sql = 'SELECT @@SQL_MODE'; | ||
849 | 1673 | PTDEBUG && _d($dbh, $sql); | ||
850 | 1674 | my ($sql_mode) = $dbh->selectrow_array($sql); | ||
851 | 1675 | |||
852 | 1676 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
853 | 1677 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
854 | 1678 | . ($sql_mode ? ",$sql_mode" : '') | ||
855 | 1679 | . '\'*/'; | ||
856 | 1680 | PTDEBUG && _d($dbh, $sql); | ||
857 | 1681 | $dbh->do($sql); | ||
858 | 1682 | |||
859 | 1683 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
860 | 1684 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
861 | 1685 | PTDEBUG && _d($dbh, ':', $sql); | ||
862 | 1686 | $dbh->do($sql); | ||
863 | 1687 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
864 | 1688 | if ( $charset eq 'utf8' ) { | ||
865 | 1689 | binmode(STDOUT, ':utf8') | ||
866 | 1690 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
867 | 1691 | } | ||
868 | 1692 | else { | ||
869 | 1693 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
870 | 1694 | } | ||
871 | 1695 | } | ||
872 | 1696 | |||
873 | 1697 | if ( $self->prop('set-vars') ) { | ||
874 | 1698 | $sql = "SET " . $self->prop('set-vars'); | ||
875 | 1699 | PTDEBUG && _d($dbh, ':', $sql); | ||
876 | 1700 | $dbh->do($sql); | ||
877 | 1701 | } | ||
878 | 1702 | } | ||
879 | 1703 | }; | ||
882 | 1704 | if ( !$dbh && $EVAL_ERROR ) { | 2158 | if ( !$dbh && $EVAL_ERROR ) { |
889 | 1705 | PTDEBUG && _d($EVAL_ERROR); | 2159 | if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { |
884 | 1706 | if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
885 | 1707 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
886 | 1708 | delete $defaults->{mysql_enable_utf8}; | ||
887 | 1709 | } | ||
888 | 1710 | elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { | ||
890 | 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 " |
891 | 1712 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " | 2161 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " |
892 | 1713 | . "the directories that Perl searches for DBD::mysql. If " | 2162 | . "the directories that Perl searches for DBD::mysql. If " |
893 | @@ -1716,19 +2165,70 @@ | |||
894 | 1716 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" | 2165 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" |
895 | 1717 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; | 2166 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; |
896 | 1718 | } | 2167 | } |
897 | 2168 | elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
898 | 2169 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
899 | 2170 | delete $defaults->{mysql_enable_utf8}; | ||
900 | 2171 | } | ||
901 | 1719 | if ( !$tries ) { | 2172 | if ( !$tries ) { |
902 | 1720 | die $EVAL_ERROR; | 2173 | die $EVAL_ERROR; |
903 | 1721 | } | 2174 | } |
904 | 1722 | } | 2175 | } |
905 | 1723 | } | 2176 | } |
906 | 1724 | 2177 | ||
907 | 2178 | if ( $cxn_string =~ m/mysql/i ) { | ||
908 | 2179 | my $sql; | ||
909 | 2180 | |||
910 | 2181 | $sql = 'SELECT @@SQL_MODE'; | ||
911 | 2182 | PTDEBUG && _d($dbh, $sql); | ||
912 | 2183 | my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; | ||
913 | 2184 | if ( $EVAL_ERROR ) { | ||
914 | 2185 | die $EVAL_ERROR; | ||
915 | 2186 | } | ||
916 | 2187 | |||
917 | 2188 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
918 | 2189 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
919 | 2190 | . ($sql_mode ? ",$sql_mode" : '') | ||
920 | 2191 | . '\'*/'; | ||
921 | 2192 | PTDEBUG && _d($dbh, $sql); | ||
922 | 2193 | eval { $dbh->do($sql) }; | ||
923 | 2194 | if ( $EVAL_ERROR ) { | ||
924 | 2195 | die $EVAL_ERROR; | ||
925 | 2196 | } | ||
926 | 2197 | |||
927 | 2198 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
928 | 2199 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
929 | 2200 | PTDEBUG && _d($dbh, ':', $sql); | ||
930 | 2201 | eval { $dbh->do($sql) }; | ||
931 | 2202 | if ( $EVAL_ERROR ) { | ||
932 | 2203 | die $EVAL_ERROR; | ||
933 | 2204 | } | ||
934 | 2205 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
935 | 2206 | if ( $charset eq 'utf8' ) { | ||
936 | 2207 | binmode(STDOUT, ':utf8') | ||
937 | 2208 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
938 | 2209 | } | ||
939 | 2210 | else { | ||
940 | 2211 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
941 | 2212 | } | ||
942 | 2213 | } | ||
943 | 2214 | |||
944 | 2215 | if ( $self->prop('set-vars') ) { | ||
945 | 2216 | $sql = "SET " . $self->prop('set-vars'); | ||
946 | 2217 | PTDEBUG && _d($dbh, ':', $sql); | ||
947 | 2218 | eval { $dbh->do($sql) }; | ||
948 | 2219 | if ( $EVAL_ERROR ) { | ||
949 | 2220 | die $EVAL_ERROR; | ||
950 | 2221 | } | ||
951 | 2222 | } | ||
952 | 2223 | } | ||
953 | 2224 | |||
954 | 1725 | PTDEBUG && _d('DBH info: ', | 2225 | PTDEBUG && _d('DBH info: ', |
955 | 1726 | $dbh, | 2226 | $dbh, |
956 | 1727 | Dumper($dbh->selectrow_hashref( | 2227 | Dumper($dbh->selectrow_hashref( |
957 | 1728 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), | 2228 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), |
958 | 1729 | 'Connection info:', $dbh->{mysql_hostinfo}, | 2229 | 'Connection info:', $dbh->{mysql_hostinfo}, |
959 | 1730 | 'Character set info:', Dumper($dbh->selectall_arrayref( | 2230 | 'Character set info:', Dumper($dbh->selectall_arrayref( |
961 | 1731 | 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})), | 2231 | "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})), |
962 | 1732 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, | 2232 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, |
963 | 1733 | '$DBI::VERSION:', $DBI::VERSION, | 2233 | '$DBI::VERSION:', $DBI::VERSION, |
964 | 1734 | ); | 2234 | ); |
965 | @@ -1806,35 +2306,145 @@ | |||
966 | 1806 | { | 2306 | { |
967 | 1807 | package VersionParser; | 2307 | package VersionParser; |
968 | 1808 | 2308 | ||
971 | 1809 | use strict; | 2309 | use Mo; |
972 | 1810 | use warnings FATAL => 'all'; | 2310 | use Scalar::Util qw(blessed); |
973 | 1811 | use English qw(-no_match_vars); | 2311 | use English qw(-no_match_vars); |
974 | 1812 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | 2312 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
975 | 1813 | 2313 | ||
1000 | 1814 | sub new { | 2314 | use overload ( |
1001 | 1815 | my ( $class ) = @_; | 2315 | '""' => "version", |
1002 | 1816 | bless {}, $class; | 2316 | '<=>' => "cmp", |
1003 | 1817 | } | 2317 | 'cmp' => "cmp", |
1004 | 1818 | 2318 | fallback => 1, | |
1005 | 1819 | sub parse { | 2319 | ); |
1006 | 1820 | my ( $self, $str ) = @_; | 2320 | |
1007 | 1821 | my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); | 2321 | use Carp (); |
1008 | 1822 | PTDEBUG && _d($str, 'parses to', $result); | 2322 | |
1009 | 1823 | return $result; | 2323 | our $VERSION = 0.01; |
1010 | 1824 | } | 2324 | |
1011 | 1825 | 2325 | has major => ( | |
1012 | 1826 | sub version_ge { | 2326 | is => 'ro', |
1013 | 1827 | my ( $self, $dbh, $target ) = @_; | 2327 | isa => 'Int', |
1014 | 1828 | if ( !$self->{$dbh} ) { | 2328 | required => 1, |
1015 | 1829 | $self->{$dbh} = $self->parse( | 2329 | ); |
1016 | 1830 | $dbh->selectrow_array('SELECT VERSION()')); | 2330 | |
1017 | 1831 | } | 2331 | has [qw( minor revision )] => ( |
1018 | 1832 | my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; | 2332 | is => 'ro', |
1019 | 1833 | PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); | 2333 | isa => 'Num', |
1020 | 1834 | return $result; | 2334 | ); |
1021 | 1835 | } | 2335 | |
1022 | 1836 | 2336 | has flavor => ( | |
1023 | 1837 | sub innodb_version { | 2337 | is => 'ro', |
1024 | 2338 | isa => 'Str', | ||
1025 | 2339 | default => sub { 'Unknown' }, | ||
1026 | 2340 | ); | ||
1027 | 2341 | |||
1028 | 2342 | has innodb_version => ( | ||
1029 | 2343 | is => 'ro', | ||
1030 | 2344 | isa => 'Str', | ||
1031 | 2345 | default => sub { 'NO' }, | ||
1032 | 2346 | ); | ||
1033 | 2347 | |||
1034 | 2348 | sub series { | ||
1035 | 2349 | my $self = shift; | ||
1036 | 2350 | return $self->_join_version($self->major, $self->minor); | ||
1037 | 2351 | } | ||
1038 | 2352 | |||
1039 | 2353 | sub version { | ||
1040 | 2354 | my $self = shift; | ||
1041 | 2355 | return $self->_join_version($self->major, $self->minor, $self->revision); | ||
1042 | 2356 | } | ||
1043 | 2357 | |||
1044 | 2358 | sub is_in { | ||
1045 | 2359 | my ($self, $target) = @_; | ||
1046 | 2360 | |||
1047 | 2361 | return $self eq $target; | ||
1048 | 2362 | } | ||
1049 | 2363 | |||
1050 | 2364 | sub _join_version { | ||
1051 | 2365 | my ($self, @parts) = @_; | ||
1052 | 2366 | |||
1053 | 2367 | return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts; | ||
1054 | 2368 | } | ||
1055 | 2369 | sub _split_version { | ||
1056 | 2370 | my ($self, $str) = @_; | ||
1057 | 2371 | my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g; | ||
1058 | 2372 | return @version_parts[0..2]; | ||
1059 | 2373 | } | ||
1060 | 2374 | |||
1061 | 2375 | sub normalized_version { | ||
1062 | 2376 | my ( $self ) = @_; | ||
1063 | 2377 | my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major, | ||
1064 | 2378 | $self->minor, | ||
1065 | 2379 | $self->revision); | ||
1066 | 2380 | PTDEBUG && _d($self->version, 'normalizes to', $result); | ||
1067 | 2381 | return $result; | ||
1068 | 2382 | } | ||
1069 | 2383 | |||
1070 | 2384 | sub comment { | ||
1071 | 2385 | my ( $self, $cmd ) = @_; | ||
1072 | 2386 | my $v = $self->normalized_version(); | ||
1073 | 2387 | |||
1074 | 2388 | return "/*!$v $cmd */" | ||
1075 | 2389 | } | ||
1076 | 2390 | |||
1077 | 2391 | my @methods = qw(major minor revision); | ||
1078 | 2392 | sub cmp { | ||
1079 | 2393 | my ($left, $right) = @_; | ||
1080 | 2394 | my $right_obj = (blessed($right) && $right->isa(ref($left))) | ||
1081 | 2395 | ? $right | ||
1082 | 2396 | : ref($left)->new($right); | ||
1083 | 2397 | |||
1084 | 2398 | my $retval = 0; | ||
1085 | 2399 | for my $m ( @methods ) { | ||
1086 | 2400 | last unless defined($left->$m) && defined($right_obj->$m); | ||
1087 | 2401 | $retval = $left->$m <=> $right_obj->$m; | ||
1088 | 2402 | last if $retval; | ||
1089 | 2403 | } | ||
1090 | 2404 | return $retval; | ||
1091 | 2405 | } | ||
1092 | 2406 | |||
1093 | 2407 | sub BUILDARGS { | ||
1094 | 2408 | my $self = shift; | ||
1095 | 2409 | |||
1096 | 2410 | if ( @_ == 1 ) { | ||
1097 | 2411 | my %args; | ||
1098 | 2412 | if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) { | ||
1099 | 2413 | PTDEBUG && _d("VersionParser got a dbh, trying to get the version"); | ||
1100 | 2414 | my $dbh = $_[0]; | ||
1101 | 2415 | local $dbh->{FetchHashKeyName} = 'NAME_lc'; | ||
1102 | 2416 | my $query = eval { | ||
1103 | 2417 | $dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} }) | ||
1104 | 2418 | }; | ||
1105 | 2419 | if ( $query ) { | ||
1106 | 2420 | $query = { map { $_->{variable_name} => $_->{value} } @$query }; | ||
1107 | 2421 | @args{@methods} = $self->_split_version($query->{version}); | ||
1108 | 2422 | $args{flavor} = delete $query->{version_comment} | ||
1109 | 2423 | if $query->{version_comment}; | ||
1110 | 2424 | } | ||
1111 | 2425 | elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) { | ||
1112 | 2426 | @args{@methods} = $self->_split_version($query); | ||
1113 | 2427 | } | ||
1114 | 2428 | else { | ||
1115 | 2429 | Carp::confess("Couldn't get the version from the dbh while " | ||
1116 | 2430 | . "creating a VersionParser object: $@"); | ||
1117 | 2431 | } | ||
1118 | 2432 | $args{innodb_version} = eval { $self->_innodb_version($dbh) }; | ||
1119 | 2433 | } | ||
1120 | 2434 | elsif ( !ref($_[0]) ) { | ||
1121 | 2435 | @args{@methods} = $self->_split_version($_[0]); | ||
1122 | 2436 | } | ||
1123 | 2437 | |||
1124 | 2438 | for my $method (@methods) { | ||
1125 | 2439 | delete $args{$method} unless defined $args{$method}; | ||
1126 | 2440 | } | ||
1127 | 2441 | @_ = %args if %args; | ||
1128 | 2442 | } | ||
1129 | 2443 | |||
1130 | 2444 | return $self->SUPER::BUILDARGS(@_); | ||
1131 | 2445 | } | ||
1132 | 2446 | |||
1133 | 2447 | sub _innodb_version { | ||
1134 | 1838 | my ( $self, $dbh ) = @_; | 2448 | my ( $self, $dbh ) = @_; |
1135 | 1839 | return unless $dbh; | 2449 | return unless $dbh; |
1136 | 1840 | my $innodb_version = "NO"; | 2450 | my $innodb_version = "NO"; |
1137 | @@ -1872,6 +2482,7 @@ | |||
1138 | 1872 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | 2482 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; |
1139 | 1873 | } | 2483 | } |
1140 | 1874 | 2484 | ||
1141 | 2485 | no Mo; | ||
1142 | 1875 | 1; | 2486 | 1; |
1143 | 1876 | } | 2487 | } |
1144 | 1877 | # ########################################################################### | 2488 | # ########################################################################### |
1145 | @@ -1949,6 +2560,48 @@ | |||
1146 | 1949 | return $db ? "$db.$tbl" : $tbl; | 2560 | return $db ? "$db.$tbl" : $tbl; |
1147 | 1950 | } | 2561 | } |
1148 | 1951 | 2562 | ||
1149 | 2563 | sub serialize_list { | ||
1150 | 2564 | my ( $self, @args ) = @_; | ||
1151 | 2565 | return unless @args; | ||
1152 | 2566 | |||
1153 | 2567 | return $args[0] if @args == 1 && !defined $args[0]; | ||
1154 | 2568 | |||
1155 | 2569 | die "Cannot serialize multiple values with undef/NULL" | ||
1156 | 2570 | if grep { !defined $_ } @args; | ||
1157 | 2571 | |||
1158 | 2572 | return join ',', map { quotemeta } @args; | ||
1159 | 2573 | } | ||
1160 | 2574 | |||
1161 | 2575 | sub deserialize_list { | ||
1162 | 2576 | my ( $self, $string ) = @_; | ||
1163 | 2577 | return $string unless defined $string; | ||
1164 | 2578 | my @escaped_parts = $string =~ / | ||
1165 | 2579 | \G # Start of string, or end of previous match. | ||
1166 | 2580 | ( # Each of these is an element in the original list. | ||
1167 | 2581 | [^\\,]* # Anything not a backslash or a comma | ||
1168 | 2582 | (?: # When we get here, we found one of the above. | ||
1169 | 2583 | \\. # A backslash followed by something so we can continue | ||
1170 | 2584 | [^\\,]* # Same as above. | ||
1171 | 2585 | )* # Repeat zero of more times. | ||
1172 | 2586 | ) | ||
1173 | 2587 | , # Comma dividing elements | ||
1174 | 2588 | /sxgc; | ||
1175 | 2589 | |||
1176 | 2590 | push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string; | ||
1177 | 2591 | |||
1178 | 2592 | my @unescaped_parts = map { | ||
1179 | 2593 | my $part = $_; | ||
1180 | 2594 | |||
1181 | 2595 | my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string, | ||
1182 | 2596 | ? qr/(?=\p{ASCII})\W/ # We only care about non-word | ||
1183 | 2597 | : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise, | ||
1184 | 2598 | $part =~ s/\\($char_class)/$1/g; | ||
1185 | 2599 | $part; | ||
1186 | 2600 | } @escaped_parts; | ||
1187 | 2601 | |||
1188 | 2602 | return @unescaped_parts; | ||
1189 | 2603 | } | ||
1190 | 2604 | |||
1191 | 1952 | 1; | 2605 | 1; |
1192 | 1953 | } | 2606 | } |
1193 | 1954 | # ########################################################################### | 2607 | # ########################################################################### |
1194 | @@ -1988,23 +2641,26 @@ | |||
1195 | 1988 | die "I need a $arg argument" unless defined $args{$arg}; | 2641 | die "I need a $arg argument" unless defined $args{$arg}; |
1196 | 1989 | } | 2642 | } |
1197 | 1990 | my ($tbl_struct, $index) = @args{@required_args}; | 2643 | my ($tbl_struct, $index) = @args{@required_args}; |
1199 | 1991 | my @cols = $args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}}; | 2644 | my @cols = $args{cols} ? @{$args{cols}} : @{$tbl_struct->{cols}}; |
1200 | 1992 | my $q = $self->{Quoter}; | 2645 | my $q = $self->{Quoter}; |
1201 | 1993 | 2646 | ||
1202 | 1994 | die "Index '$index' does not exist in table" | 2647 | die "Index '$index' does not exist in table" |
1203 | 1995 | unless exists $tbl_struct->{keys}->{$index}; | 2648 | unless exists $tbl_struct->{keys}->{$index}; |
1204 | 2649 | PTDEBUG && _d('Will ascend index', $index); | ||
1205 | 1996 | 2650 | ||
1206 | 1997 | my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; | 2651 | my @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; |
1207 | 1998 | my @asc_slice; | ||
1208 | 1999 | |||
1209 | 2000 | @asc_cols = @{$tbl_struct->{keys}->{$index}->{cols}}; | ||
1210 | 2001 | PTDEBUG && _d('Will ascend index', $index); | ||
1211 | 2002 | PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); | ||
1212 | 2003 | if ( $args{asc_first} ) { | 2652 | if ( $args{asc_first} ) { |
1213 | 2653 | PTDEBUG && _d('Ascending only first column'); | ||
1214 | 2004 | @asc_cols = $asc_cols[0]; | 2654 | @asc_cols = $asc_cols[0]; |
1217 | 2005 | PTDEBUG && _d('Ascending only first column'); | 2655 | } |
1218 | 2006 | } | 2656 | elsif ( my $n = $args{n_index_cols} ) { |
1219 | 2657 | $n = scalar @asc_cols if $n > @asc_cols; | ||
1220 | 2658 | PTDEBUG && _d('Ascending only first', $n, 'columns'); | ||
1221 | 2659 | @asc_cols = @asc_cols[0..($n-1)]; | ||
1222 | 2660 | } | ||
1223 | 2661 | PTDEBUG && _d('Will ascend columns', join(', ', @asc_cols)); | ||
1224 | 2007 | 2662 | ||
1225 | 2663 | my @asc_slice; | ||
1226 | 2008 | my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; | 2664 | my %col_posn = do { my $i = 0; map { $_ => $i++ } @cols }; |
1227 | 2009 | foreach my $col ( @asc_cols ) { | 2665 | foreach my $col ( @asc_cols ) { |
1228 | 2010 | if ( !exists $col_posn{$col} ) { | 2666 | if ( !exists $col_posn{$col} ) { |
1229 | @@ -2215,311 +2871,6 @@ | |||
1230 | 2215 | # ########################################################################### | 2871 | # ########################################################################### |
1231 | 2216 | 2872 | ||
1232 | 2217 | # ########################################################################### | 2873 | # ########################################################################### |
1233 | 2218 | # MySQLDump package | ||
1234 | 2219 | # This package is a copy without comments from the original. The original | ||
1235 | 2220 | # with comments and its test file can be found in the Bazaar repository at, | ||
1236 | 2221 | # lib/MySQLDump.pm | ||
1237 | 2222 | # t/lib/MySQLDump.t | ||
1238 | 2223 | # See https://launchpad.net/percona-toolkit for more information. | ||
1239 | 2224 | # ########################################################################### | ||
1240 | 2225 | { | ||
1241 | 2226 | package MySQLDump; | ||
1242 | 2227 | |||
1243 | 2228 | use strict; | ||
1244 | 2229 | use warnings FATAL => 'all'; | ||
1245 | 2230 | use English qw(-no_match_vars); | ||
1246 | 2231 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
1247 | 2232 | |||
1248 | 2233 | ( our $before = <<'EOF') =~ s/^ //gm; | ||
1249 | 2234 | /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; | ||
1250 | 2235 | /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */; | ||
1251 | 2236 | /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */; | ||
1252 | 2237 | /*!40101 SET NAMES utf8 */; | ||
1253 | 2238 | /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */; | ||
1254 | 2239 | /*!40103 SET TIME_ZONE='+00:00' */; | ||
1255 | 2240 | /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */; | ||
1256 | 2241 | /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */; | ||
1257 | 2242 | /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */; | ||
1258 | 2243 | /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */; | ||
1259 | 2244 | EOF | ||
1260 | 2245 | |||
1261 | 2246 | ( our $after = <<'EOF') =~ s/^ //gm; | ||
1262 | 2247 | /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; | ||
1263 | 2248 | /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; | ||
1264 | 2249 | /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; | ||
1265 | 2250 | /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */; | ||
1266 | 2251 | /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */; | ||
1267 | 2252 | /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */; | ||
1268 | 2253 | /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */; | ||
1269 | 2254 | /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */; | ||
1270 | 2255 | EOF | ||
1271 | 2256 | |||
1272 | 2257 | sub new { | ||
1273 | 2258 | my ( $class, %args ) = @_; | ||
1274 | 2259 | my $self = { | ||
1275 | 2260 | cache => 0, # Afaik no script uses this cache any longer because | ||
1276 | 2261 | }; | ||
1277 | 2262 | return bless $self, $class; | ||
1278 | 2263 | } | ||
1279 | 2264 | |||
1280 | 2265 | sub dump { | ||
1281 | 2266 | my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_; | ||
1282 | 2267 | |||
1283 | 2268 | if ( $what eq 'table' ) { | ||
1284 | 2269 | my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); | ||
1285 | 2270 | return unless $ddl; | ||
1286 | 2271 | if ( $ddl->[0] eq 'table' ) { | ||
1287 | 2272 | return $before | ||
1288 | 2273 | . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" | ||
1289 | 2274 | . $ddl->[1] . ";\n"; | ||
1290 | 2275 | } | ||
1291 | 2276 | else { | ||
1292 | 2277 | return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" | ||
1293 | 2278 | . '/*!50001 DROP VIEW IF EXISTS ' | ||
1294 | 2279 | . $quoter->quote($tbl) . "*/;\n/*!50001 " | ||
1295 | 2280 | . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n"; | ||
1296 | 2281 | } | ||
1297 | 2282 | } | ||
1298 | 2283 | elsif ( $what eq 'triggers' ) { | ||
1299 | 2284 | my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl); | ||
1300 | 2285 | if ( $trgs && @$trgs ) { | ||
1301 | 2286 | my $result = $before . "\nDELIMITER ;;\n"; | ||
1302 | 2287 | foreach my $trg ( @$trgs ) { | ||
1303 | 2288 | if ( $trg->{sql_mode} ) { | ||
1304 | 2289 | $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n}; | ||
1305 | 2290 | } | ||
1306 | 2291 | $result .= "/*!50003 CREATE */ "; | ||
1307 | 2292 | if ( $trg->{definer} ) { | ||
1308 | 2293 | my ( $user, $host ) | ||
1309 | 2294 | = map { s/'/''/g; "'$_'"; } | ||
1310 | 2295 | split('@', $trg->{definer}, 2); | ||
1311 | 2296 | $result .= "/*!50017 DEFINER=$user\@$host */ "; | ||
1312 | 2297 | } | ||
1313 | 2298 | $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n", | ||
1314 | 2299 | $quoter->quote($trg->{trigger}), | ||
1315 | 2300 | @{$trg}{qw(timing event)}, | ||
1316 | 2301 | $quoter->quote($trg->{table}), | ||
1317 | 2302 | $trg->{statement}); | ||
1318 | 2303 | } | ||
1319 | 2304 | $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n"; | ||
1320 | 2305 | return $result; | ||
1321 | 2306 | } | ||
1322 | 2307 | else { | ||
1323 | 2308 | return undef; | ||
1324 | 2309 | } | ||
1325 | 2310 | } | ||
1326 | 2311 | elsif ( $what eq 'view' ) { | ||
1327 | 2312 | my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); | ||
1328 | 2313 | return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" | ||
1329 | 2314 | . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" | ||
1330 | 2315 | . '/*!50001 ' . $ddl->[1] . "*/;\n"; | ||
1331 | 2316 | } | ||
1332 | 2317 | else { | ||
1333 | 2318 | die "You didn't say what to dump."; | ||
1334 | 2319 | } | ||
1335 | 2320 | } | ||
1336 | 2321 | |||
1337 | 2322 | sub _use_db { | ||
1338 | 2323 | my ( $self, $dbh, $quoter, $new ) = @_; | ||
1339 | 2324 | if ( !$new ) { | ||
1340 | 2325 | PTDEBUG && _d('No new DB to use'); | ||
1341 | 2326 | return; | ||
1342 | 2327 | } | ||
1343 | 2328 | my $sql = 'USE ' . $quoter->quote($new); | ||
1344 | 2329 | PTDEBUG && _d($dbh, $sql); | ||
1345 | 2330 | $dbh->do($sql); | ||
1346 | 2331 | return; | ||
1347 | 2332 | } | ||
1348 | 2333 | |||
1349 | 2334 | sub get_create_table { | ||
1350 | 2335 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
1351 | 2336 | if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) { | ||
1352 | 2337 | my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
1353 | 2338 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
1354 | 2339 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
1355 | 2340 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
1356 | 2341 | PTDEBUG && _d($sql); | ||
1357 | 2342 | eval { $dbh->do($sql); }; | ||
1358 | 2343 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
1359 | 2344 | $self->_use_db($dbh, $quoter, $db); | ||
1360 | 2345 | $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); | ||
1361 | 2346 | PTDEBUG && _d($sql); | ||
1362 | 2347 | my $href; | ||
1363 | 2348 | eval { $href = $dbh->selectrow_hashref($sql); }; | ||
1364 | 2349 | if ( $EVAL_ERROR ) { | ||
1365 | 2350 | warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR"; | ||
1366 | 2351 | return; | ||
1367 | 2352 | } | ||
1368 | 2353 | |||
1369 | 2354 | $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
1370 | 2355 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
1371 | 2356 | PTDEBUG && _d($sql); | ||
1372 | 2357 | $dbh->do($sql); | ||
1373 | 2358 | my ($key) = grep { m/create table/i } keys %$href; | ||
1374 | 2359 | if ( $key ) { | ||
1375 | 2360 | PTDEBUG && _d('This table is a base table'); | ||
1376 | 2361 | $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; | ||
1377 | 2362 | } | ||
1378 | 2363 | else { | ||
1379 | 2364 | PTDEBUG && _d('This table is a view'); | ||
1380 | 2365 | ($key) = grep { m/create view/i } keys %$href; | ||
1381 | 2366 | $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; | ||
1382 | 2367 | } | ||
1383 | 2368 | } | ||
1384 | 2369 | return $self->{tables}->{$db}->{$tbl}; | ||
1385 | 2370 | } | ||
1386 | 2371 | |||
1387 | 2372 | sub get_columns { | ||
1388 | 2373 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
1389 | 2374 | PTDEBUG && _d('Get columns for', $db, $tbl); | ||
1390 | 2375 | if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { | ||
1391 | 2376 | $self->_use_db($dbh, $quoter, $db); | ||
1392 | 2377 | my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); | ||
1393 | 2378 | PTDEBUG && _d($sql); | ||
1394 | 2379 | my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); | ||
1395 | 2380 | |||
1396 | 2381 | $self->{columns}->{$db}->{$tbl} = [ | ||
1397 | 2382 | map { | ||
1398 | 2383 | my %row; | ||
1399 | 2384 | @row{ map { lc $_ } keys %$_ } = values %$_; | ||
1400 | 2385 | \%row; | ||
1401 | 2386 | } @$cols | ||
1402 | 2387 | ]; | ||
1403 | 2388 | } | ||
1404 | 2389 | return $self->{columns}->{$db}->{$tbl}; | ||
1405 | 2390 | } | ||
1406 | 2391 | |||
1407 | 2392 | sub get_tmp_table { | ||
1408 | 2393 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
1409 | 2394 | my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n"; | ||
1410 | 2395 | $result .= join(",\n", | ||
1411 | 2396 | map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } | ||
1412 | 2397 | @{$self->get_columns($dbh, $quoter, $db, $tbl)}); | ||
1413 | 2398 | $result .= "\n)"; | ||
1414 | 2399 | PTDEBUG && _d($result); | ||
1415 | 2400 | return $result; | ||
1416 | 2401 | } | ||
1417 | 2402 | |||
1418 | 2403 | sub get_triggers { | ||
1419 | 2404 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
1420 | 2405 | if ( !$self->{cache} || !$self->{triggers}->{$db} ) { | ||
1421 | 2406 | $self->{triggers}->{$db} = {}; | ||
1422 | 2407 | my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
1423 | 2408 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
1424 | 2409 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
1425 | 2410 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
1426 | 2411 | PTDEBUG && _d($sql); | ||
1427 | 2412 | eval { $dbh->do($sql); }; | ||
1428 | 2413 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
1429 | 2414 | $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); | ||
1430 | 2415 | PTDEBUG && _d($sql); | ||
1431 | 2416 | my $sth = $dbh->prepare($sql); | ||
1432 | 2417 | $sth->execute(); | ||
1433 | 2418 | if ( $sth->rows ) { | ||
1434 | 2419 | my $trgs = $sth->fetchall_arrayref({}); | ||
1435 | 2420 | foreach my $trg (@$trgs) { | ||
1436 | 2421 | my %trg; | ||
1437 | 2422 | @trg{ map { lc $_ } keys %$trg } = values %$trg; | ||
1438 | 2423 | push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg; | ||
1439 | 2424 | } | ||
1440 | 2425 | } | ||
1441 | 2426 | $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
1442 | 2427 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
1443 | 2428 | PTDEBUG && _d($sql); | ||
1444 | 2429 | $dbh->do($sql); | ||
1445 | 2430 | } | ||
1446 | 2431 | if ( $tbl ) { | ||
1447 | 2432 | return $self->{triggers}->{$db}->{$tbl}; | ||
1448 | 2433 | } | ||
1449 | 2434 | return values %{$self->{triggers}->{$db}}; | ||
1450 | 2435 | } | ||
1451 | 2436 | |||
1452 | 2437 | sub get_databases { | ||
1453 | 2438 | my ( $self, $dbh, $quoter, $like ) = @_; | ||
1454 | 2439 | if ( !$self->{cache} || !$self->{databases} || $like ) { | ||
1455 | 2440 | my $sql = 'SHOW DATABASES'; | ||
1456 | 2441 | my @params; | ||
1457 | 2442 | if ( $like ) { | ||
1458 | 2443 | $sql .= ' LIKE ?'; | ||
1459 | 2444 | push @params, $like; | ||
1460 | 2445 | } | ||
1461 | 2446 | my $sth = $dbh->prepare($sql); | ||
1462 | 2447 | PTDEBUG && _d($sql, @params); | ||
1463 | 2448 | $sth->execute( @params ); | ||
1464 | 2449 | my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; | ||
1465 | 2450 | $self->{databases} = \@dbs unless $like; | ||
1466 | 2451 | return @dbs; | ||
1467 | 2452 | } | ||
1468 | 2453 | return @{$self->{databases}}; | ||
1469 | 2454 | } | ||
1470 | 2455 | |||
1471 | 2456 | sub get_table_status { | ||
1472 | 2457 | my ( $self, $dbh, $quoter, $db, $like ) = @_; | ||
1473 | 2458 | if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) { | ||
1474 | 2459 | my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db); | ||
1475 | 2460 | my @params; | ||
1476 | 2461 | if ( $like ) { | ||
1477 | 2462 | $sql .= ' LIKE ?'; | ||
1478 | 2463 | push @params, $like; | ||
1479 | 2464 | } | ||
1480 | 2465 | PTDEBUG && _d($sql, @params); | ||
1481 | 2466 | my $sth = $dbh->prepare($sql); | ||
1482 | 2467 | $sth->execute(@params); | ||
1483 | 2468 | my @tables = @{$sth->fetchall_arrayref({})}; | ||
1484 | 2469 | @tables = map { | ||
1485 | 2470 | my %tbl; # Make a copy with lowercased keys | ||
1486 | 2471 | @tbl{ map { lc $_ } keys %$_ } = values %$_; | ||
1487 | 2472 | $tbl{engine} ||= $tbl{type} || $tbl{comment}; | ||
1488 | 2473 | delete $tbl{type}; | ||
1489 | 2474 | \%tbl; | ||
1490 | 2475 | } @tables; | ||
1491 | 2476 | $self->{table_status}->{$db} = \@tables unless $like; | ||
1492 | 2477 | return @tables; | ||
1493 | 2478 | } | ||
1494 | 2479 | return @{$self->{table_status}->{$db}}; | ||
1495 | 2480 | } | ||
1496 | 2481 | |||
1497 | 2482 | sub get_table_list { | ||
1498 | 2483 | my ( $self, $dbh, $quoter, $db, $like ) = @_; | ||
1499 | 2484 | if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) { | ||
1500 | 2485 | my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db); | ||
1501 | 2486 | my @params; | ||
1502 | 2487 | if ( $like ) { | ||
1503 | 2488 | $sql .= ' LIKE ?'; | ||
1504 | 2489 | push @params, $like; | ||
1505 | 2490 | } | ||
1506 | 2491 | PTDEBUG && _d($sql, @params); | ||
1507 | 2492 | my $sth = $dbh->prepare($sql); | ||
1508 | 2493 | $sth->execute(@params); | ||
1509 | 2494 | my @tables = @{$sth->fetchall_arrayref()}; | ||
1510 | 2495 | @tables = map { | ||
1511 | 2496 | my %tbl = ( | ||
1512 | 2497 | name => $_->[0], | ||
1513 | 2498 | engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '', | ||
1514 | 2499 | ); | ||
1515 | 2500 | \%tbl; | ||
1516 | 2501 | } @tables; | ||
1517 | 2502 | $self->{table_list}->{$db} = \@tables unless $like; | ||
1518 | 2503 | return @tables; | ||
1519 | 2504 | } | ||
1520 | 2505 | return @{$self->{table_list}->{$db}}; | ||
1521 | 2506 | } | ||
1522 | 2507 | |||
1523 | 2508 | sub _d { | ||
1524 | 2509 | my ($package, undef, $line) = caller 0; | ||
1525 | 2510 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
1526 | 2511 | map { defined $_ ? $_ : 'undef' } | ||
1527 | 2512 | @_; | ||
1528 | 2513 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
1529 | 2514 | } | ||
1530 | 2515 | |||
1531 | 2516 | 1; | ||
1532 | 2517 | } | ||
1533 | 2518 | # ########################################################################### | ||
1534 | 2519 | # End MySQLDump package | ||
1535 | 2520 | # ########################################################################### | ||
1536 | 2521 | |||
1537 | 2522 | # ########################################################################### | ||
1538 | 2523 | # Daemon package | 2874 | # Daemon package |
1539 | 2524 | # This package is a copy without comments from the original. The original | 2875 | # This package is a copy without comments from the original. The original |
1540 | 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, |
1541 | @@ -2774,6 +3125,9 @@ | |||
1542 | 2774 | dsn_table_dsn => $dsn_table_dsn, | 3125 | dsn_table_dsn => $dsn_table_dsn, |
1543 | 2775 | ); | 3126 | ); |
1544 | 2776 | } | 3127 | } |
1545 | 3128 | elsif ( $method =~ m/none/i ) { | ||
1546 | 3129 | PTDEBUG && _d('Not getting to slaves'); | ||
1547 | 3130 | } | ||
1548 | 2777 | else { | 3131 | else { |
1549 | 2778 | die "Invalid --recursion-method: $method. Valid values are: " | 3132 | die "Invalid --recursion-method: $method. Valid values are: " |
1550 | 2779 | . "dsn=DSN, hosts, or processlist.\n"; | 3133 | . "dsn=DSN, hosts, or processlist.\n"; |
1551 | @@ -2788,6 +3142,11 @@ | |||
1552 | 2788 | my $dp = $args->{dsn_parser}; | 3142 | my $dp = $args->{dsn_parser}; |
1553 | 2789 | my $dsn = $args->{dsn}; | 3143 | my $dsn = $args->{dsn}; |
1554 | 2790 | 3144 | ||
1555 | 3145 | if ( lc($args->{method} || '') eq 'none' ) { | ||
1556 | 3146 | PTDEBUG && _d('Not recursing to slaves'); | ||
1557 | 3147 | return; | ||
1558 | 3148 | } | ||
1559 | 3149 | |||
1560 | 2791 | my $dbh; | 3150 | my $dbh; |
1561 | 2792 | eval { | 3151 | eval { |
1562 | 2793 | $dbh = $args->{dbh} || $dp->get_dbh( | 3152 | $dbh = $args->{dbh} || $dp->get_dbh( |
1563 | @@ -2915,11 +3274,6 @@ | |||
1564 | 2915 | 3274 | ||
1565 | 2916 | my $show = "SHOW GRANTS FOR "; | 3275 | my $show = "SHOW GRANTS FOR "; |
1566 | 2917 | my $user = 'CURRENT_USER()'; | 3276 | my $user = 'CURRENT_USER()'; |
1567 | 2918 | my $vp = $self->{VersionParser}; | ||
1568 | 2919 | if ( $vp && !$vp->version_ge($dbh, '4.1.2') ) { | ||
1569 | 2920 | $user = $dbh->selectrow_arrayref('SELECT USER()')->[0]; | ||
1570 | 2921 | $user =~ s/([^@]+)@(.+)/'$1'\@'$2'/; | ||
1571 | 2922 | } | ||
1572 | 2923 | my $sql = $show . $user; | 3277 | my $sql = $show . $user; |
1573 | 2924 | PTDEBUG && _d($dbh, $sql); | 3278 | PTDEBUG && _d($dbh, $sql); |
1574 | 2925 | 3279 | ||
1575 | @@ -2969,7 +3323,7 @@ | |||
1576 | 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"; |
1577 | 2970 | my @connected = $self->get_connected_slaves($master) | 3324 | my @connected = $self->get_connected_slaves($master) |
1578 | 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"; |
1580 | 2972 | my (undef, $port) = $master->selectrow_array('SHOW VARIABLES LIKE "port"'); | 3326 | my (undef, $port) = $master->selectrow_array("SHOW VARIABLES LIKE 'port'"); |
1581 | 2973 | 3327 | ||
1582 | 2974 | if ( $port != $slave_status->{master_port} ) { | 3328 | if ( $port != $slave_status->{master_port} ) { |
1583 | 2975 | die "The slave is connected to $slave_status->{master_port} " | 3329 | die "The slave is connected to $slave_status->{master_port} " |
1584 | @@ -3443,7 +3797,6 @@ | |||
1585 | 3443 | # Holds the arguments for the $sth's bind variables, so it can be re-tried | 3797 | # Holds the arguments for the $sth's bind variables, so it can be re-tried |
1586 | 3444 | # easily. | 3798 | # easily. |
1587 | 3445 | my @beginning_of_txn; | 3799 | my @beginning_of_txn; |
1588 | 3446 | my $vp = new VersionParser; | ||
1589 | 3447 | my $q = new Quoter; | 3800 | my $q = new Quoter; |
1590 | 3448 | 3801 | ||
1591 | 3449 | sub main { | 3802 | sub main { |
1592 | @@ -3591,7 +3944,6 @@ | |||
1593 | 3591 | # ######################################################################## | 3944 | # ######################################################################## |
1594 | 3592 | 3945 | ||
1595 | 3593 | my $tp = new TableParser(Quoter => $q); | 3946 | my $tp = new TableParser(Quoter => $q); |
1596 | 3594 | my $du = new MySQLDump(); | ||
1597 | 3595 | foreach my $table ( grep { $_ } ($src, $dst) ) { | 3947 | foreach my $table ( grep { $_ } ($src, $dst) ) { |
1598 | 3596 | my $ac = !$txnsize && !$commit_each; | 3948 | my $ac = !$txnsize && !$commit_each; |
1599 | 3597 | if ( !defined $table->{p} && $o->get('ask-pass') ) { | 3949 | if ( !defined $table->{p} && $o->get('ask-pass') ) { |
1600 | @@ -3641,7 +3993,7 @@ | |||
1601 | 3641 | } | 3993 | } |
1602 | 3642 | 3994 | ||
1603 | 3643 | $table->{info} = $tp->parse( | 3995 | $table->{info} = $tp->parse( |
1605 | 3644 | $du->get_create_table($dbh, $q, $table->{D}, $table->{t})); | 3996 | $tp->get_create_table( $dbh, $table->{D}, $table->{t} )); |
1606 | 3645 | 3997 | ||
1607 | 3646 | if ( $o->get('check-charset') ) { | 3998 | if ( $o->get('check-charset') ) { |
1608 | 3647 | my $sql = 'SELECT CONCAT(/*!40100 @@session.character_set_connection, */ "")'; | 3999 | my $sql = 'SELECT CONCAT(/*!40100 @@session.character_set_connection, */ "")'; |
1609 | @@ -3700,7 +4052,7 @@ | |||
1610 | 3700 | my $dsn_defaults = $dp->parse_options($o); | 4052 | my $dsn_defaults = $dp->parse_options($o); |
1611 | 3701 | my $dsn = $dp->parse($o->get('check-slave-lag'), $dsn_defaults); | 4053 | my $dsn = $dp->parse($o->get('check-slave-lag'), $dsn_defaults); |
1612 | 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 }); |
1614 | 3703 | $ms = new MasterSlave(VersionParser => $vp); | 4055 | $ms = new MasterSlave(); |
1615 | 3704 | } | 4056 | } |
1616 | 3705 | 4057 | ||
1617 | 3706 | # ######################################################################## | 4058 | # ######################################################################## |
1618 | @@ -3773,7 +4125,7 @@ | |||
1619 | 3773 | . join(',', map { $q->quote($_) } @{$sel_stmt->{cols}} ) | 4125 | . join(',', map { $q->quote($_) } @{$sel_stmt->{cols}} ) |
1620 | 3774 | . " FROM $src->{db_tbl}" | 4126 | . " FROM $src->{db_tbl}" |
1621 | 3775 | . ( $sel_stmt->{index} | 4127 | . ( $sel_stmt->{index} |
1623 | 3776 | ? (($vp->version_ge($dbh, '4.0.9') ? " FORCE" : " USE") | 4128 | ? ((VersionParser->new($dbh) >= '4.0.9' ? " FORCE" : " USE") |
1624 | 3777 | . " INDEX(`$sel_stmt->{index}`)") | 4129 | . " INDEX(`$sel_stmt->{index}`)") |
1625 | 3778 | : '') | 4130 | : '') |
1626 | 3779 | . " WHERE (".$o->get('where').")"; | 4131 | . " WHERE (".$o->get('where').")"; |
1627 | @@ -4473,7 +4825,7 @@ | |||
1628 | 4473 | 4825 | ||
1629 | 4474 | sub get_irot { | 4826 | sub get_irot { |
1630 | 4475 | my ( $dbh ) = @_; | 4827 | my ( $dbh ) = @_; |
1632 | 4476 | return 1 unless $vp->version_ge($dbh, '5.0.13'); | 4828 | return 1 unless VersionParser->new($dbh) >= '5.0.13'; |
1633 | 4477 | my $rows = $dbh->selectall_arrayref( | 4829 | my $rows = $dbh->selectall_arrayref( |
1634 | 4478 | "show variables like 'innodb_rollback_on_timeout'", | 4830 | "show variables like 'innodb_rollback_on_timeout'", |
1635 | 4479 | { Slice => {} }); | 4831 | { Slice => {} }); |
1636 | @@ -4576,8 +4928,8 @@ | |||
1637 | 4576 | rows. Specifying the index with the 'i' part of the L<"--source"> argument can | 4928 | rows. Specifying the index with the 'i' part of the L<"--source"> argument can |
1638 | 4577 | be crucial for this; use L<"--dry-run"> to examine the generated queries and be | 4929 | be crucial for this; use L<"--dry-run"> to examine the generated queries and be |
1639 | 4578 | sure to EXPLAIN them to see if they are efficient (most of the time you probably | 4930 | sure to EXPLAIN them to see if they are efficient (most of the time you probably |
1642 | 4579 | want to scan the PRIMARY key, which is the default). Even better, profile | 4931 | want to scan the PRIMARY key, which is the default). Even better, examine the |
1643 | 4580 | pt-archiver with mk-query-profiler (L<http://maatkit.org/get/mk-query-profiler>) | 4932 | difference in the Handler status counters before and after running the query, |
1644 | 4581 | and make sure it is not scanning the whole table every query. | 4933 | and make sure it is not scanning the whole table every query. |
1645 | 4582 | 4934 | ||
1646 | 4583 | You can disable the seek-then-scan optimizations partially or wholly with | 4935 | You can disable the seek-then-scan optimizations partially or wholly with |
1647 | @@ -5743,6 +6095,10 @@ | |||
1648 | 5743 | 6095 | ||
1649 | 5744 | =head1 VERSION | 6096 | =head1 VERSION |
1650 | 5745 | 6097 | ||
1651 | 6098 | <<<<<<< TREE | ||
1652 | 5746 | pt-archiver 2.0.5 | 6099 | pt-archiver 2.0.5 |
1653 | 6100 | ======= | ||
1654 | 6101 | pt-archiver 2.1.2 | ||
1655 | 6102 | >>>>>>> MERGE-SOURCE | ||
1656 | 5747 | 6103 | ||
1657 | 5748 | =cut | 6104 | =cut |
1658 | 5749 | 6105 | ||
1659 | === modified file 'bin/pt-config-diff' | |||
1660 | --- bin/pt-config-diff 2012-06-09 21:53:04 +0000 | |||
1661 | +++ bin/pt-config-diff 2012-07-20 22:10:28 +0000 | |||
1662 | @@ -1262,51 +1262,10 @@ | |||
1663 | 1262 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, | 1262 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, |
1664 | 1263 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); | 1263 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); |
1665 | 1264 | 1264 | ||
1704 | 1265 | eval { | 1265 | $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) }; |
1705 | 1266 | $dbh = DBI->connect($cxn_string, $user, $pass, $defaults); | 1266 | |
1668 | 1267 | |||
1669 | 1268 | if ( $cxn_string =~ m/mysql/i ) { | ||
1670 | 1269 | my $sql; | ||
1671 | 1270 | |||
1672 | 1271 | $sql = 'SELECT @@SQL_MODE'; | ||
1673 | 1272 | PTDEBUG && _d($dbh, $sql); | ||
1674 | 1273 | my ($sql_mode) = $dbh->selectrow_array($sql); | ||
1675 | 1274 | |||
1676 | 1275 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
1677 | 1276 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
1678 | 1277 | . ($sql_mode ? ",$sql_mode" : '') | ||
1679 | 1278 | . '\'*/'; | ||
1680 | 1279 | PTDEBUG && _d($dbh, $sql); | ||
1681 | 1280 | $dbh->do($sql); | ||
1682 | 1281 | |||
1683 | 1282 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
1684 | 1283 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
1685 | 1284 | PTDEBUG && _d($dbh, ':', $sql); | ||
1686 | 1285 | $dbh->do($sql); | ||
1687 | 1286 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
1688 | 1287 | if ( $charset eq 'utf8' ) { | ||
1689 | 1288 | binmode(STDOUT, ':utf8') | ||
1690 | 1289 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
1691 | 1290 | } | ||
1692 | 1291 | else { | ||
1693 | 1292 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
1694 | 1293 | } | ||
1695 | 1294 | } | ||
1696 | 1295 | |||
1697 | 1296 | if ( $self->prop('set-vars') ) { | ||
1698 | 1297 | $sql = "SET " . $self->prop('set-vars'); | ||
1699 | 1298 | PTDEBUG && _d($dbh, ':', $sql); | ||
1700 | 1299 | $dbh->do($sql); | ||
1701 | 1300 | } | ||
1702 | 1301 | } | ||
1703 | 1302 | }; | ||
1706 | 1303 | if ( !$dbh && $EVAL_ERROR ) { | 1267 | if ( !$dbh && $EVAL_ERROR ) { |
1713 | 1304 | PTDEBUG && _d($EVAL_ERROR); | 1268 | if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { |
1708 | 1305 | if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
1709 | 1306 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
1710 | 1307 | delete $defaults->{mysql_enable_utf8}; | ||
1711 | 1308 | } | ||
1712 | 1309 | elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { | ||
1714 | 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 " |
1715 | 1311 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " | 1270 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " |
1716 | 1312 | . "the directories that Perl searches for DBD::mysql. If " | 1271 | . "the directories that Perl searches for DBD::mysql. If " |
1717 | @@ -1315,19 +1274,70 @@ | |||
1718 | 1315 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" | 1274 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" |
1719 | 1316 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; | 1275 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; |
1720 | 1317 | } | 1276 | } |
1721 | 1277 | elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
1722 | 1278 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
1723 | 1279 | delete $defaults->{mysql_enable_utf8}; | ||
1724 | 1280 | } | ||
1725 | 1318 | if ( !$tries ) { | 1281 | if ( !$tries ) { |
1726 | 1319 | die $EVAL_ERROR; | 1282 | die $EVAL_ERROR; |
1727 | 1320 | } | 1283 | } |
1728 | 1321 | } | 1284 | } |
1729 | 1322 | } | 1285 | } |
1730 | 1323 | 1286 | ||
1731 | 1287 | if ( $cxn_string =~ m/mysql/i ) { | ||
1732 | 1288 | my $sql; | ||
1733 | 1289 | |||
1734 | 1290 | $sql = 'SELECT @@SQL_MODE'; | ||
1735 | 1291 | PTDEBUG && _d($dbh, $sql); | ||
1736 | 1292 | my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; | ||
1737 | 1293 | if ( $EVAL_ERROR ) { | ||
1738 | 1294 | die $EVAL_ERROR; | ||
1739 | 1295 | } | ||
1740 | 1296 | |||
1741 | 1297 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
1742 | 1298 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
1743 | 1299 | . ($sql_mode ? ",$sql_mode" : '') | ||
1744 | 1300 | . '\'*/'; | ||
1745 | 1301 | PTDEBUG && _d($dbh, $sql); | ||
1746 | 1302 | eval { $dbh->do($sql) }; | ||
1747 | 1303 | if ( $EVAL_ERROR ) { | ||
1748 | 1304 | die $EVAL_ERROR; | ||
1749 | 1305 | } | ||
1750 | 1306 | |||
1751 | 1307 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
1752 | 1308 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
1753 | 1309 | PTDEBUG && _d($dbh, ':', $sql); | ||
1754 | 1310 | eval { $dbh->do($sql) }; | ||
1755 | 1311 | if ( $EVAL_ERROR ) { | ||
1756 | 1312 | die $EVAL_ERROR; | ||
1757 | 1313 | } | ||
1758 | 1314 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
1759 | 1315 | if ( $charset eq 'utf8' ) { | ||
1760 | 1316 | binmode(STDOUT, ':utf8') | ||
1761 | 1317 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
1762 | 1318 | } | ||
1763 | 1319 | else { | ||
1764 | 1320 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
1765 | 1321 | } | ||
1766 | 1322 | } | ||
1767 | 1323 | |||
1768 | 1324 | if ( $self->prop('set-vars') ) { | ||
1769 | 1325 | $sql = "SET " . $self->prop('set-vars'); | ||
1770 | 1326 | PTDEBUG && _d($dbh, ':', $sql); | ||
1771 | 1327 | eval { $dbh->do($sql) }; | ||
1772 | 1328 | if ( $EVAL_ERROR ) { | ||
1773 | 1329 | die $EVAL_ERROR; | ||
1774 | 1330 | } | ||
1775 | 1331 | } | ||
1776 | 1332 | } | ||
1777 | 1333 | |||
1778 | 1324 | PTDEBUG && _d('DBH info: ', | 1334 | PTDEBUG && _d('DBH info: ', |
1779 | 1325 | $dbh, | 1335 | $dbh, |
1780 | 1326 | Dumper($dbh->selectrow_hashref( | 1336 | Dumper($dbh->selectrow_hashref( |
1781 | 1327 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), | 1337 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), |
1782 | 1328 | 'Connection info:', $dbh->{mysql_hostinfo}, | 1338 | 'Connection info:', $dbh->{mysql_hostinfo}, |
1783 | 1329 | 'Character set info:', Dumper($dbh->selectall_arrayref( | 1339 | 'Character set info:', Dumper($dbh->selectall_arrayref( |
1785 | 1330 | 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})), | 1340 | "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})), |
1786 | 1331 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, | 1341 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, |
1787 | 1332 | '$DBI::VERSION:', $DBI::VERSION, | 1342 | '$DBI::VERSION:', $DBI::VERSION, |
1788 | 1333 | ); | 1343 | ); |
1789 | @@ -1408,9 +1418,11 @@ | |||
1790 | 1408 | use strict; | 1418 | use strict; |
1791 | 1409 | use warnings FATAL => 'all'; | 1419 | use warnings FATAL => 'all'; |
1792 | 1410 | use English qw(-no_match_vars); | 1420 | use English qw(-no_match_vars); |
1796 | 1411 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | 1421 | use Scalar::Util qw(blessed); |
1797 | 1412 | 1422 | use constant { | |
1798 | 1413 | use constant PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0; | 1423 | PTDEBUG => $ENV{PTDEBUG} || 0, |
1799 | 1424 | PERCONA_TOOLKIT_TEST_USE_DSN_NAMES => $ENV{PERCONA_TOOLKIT_TEST_USE_DSN_NAMES} || 0, | ||
1800 | 1425 | }; | ||
1801 | 1414 | 1426 | ||
1802 | 1415 | sub new { | 1427 | sub new { |
1803 | 1416 | my ( $class, %args ) = @_; | 1428 | my ( $class, %args ) = @_; |
1804 | @@ -1513,7 +1525,9 @@ | |||
1805 | 1513 | 1525 | ||
1806 | 1514 | sub DESTROY { | 1526 | sub DESTROY { |
1807 | 1515 | my ($self) = @_; | 1527 | my ($self) = @_; |
1809 | 1516 | if ( $self->{dbh} ) { | 1528 | if ( $self->{dbh} |
1810 | 1529 | && blessed($self->{dbh}) | ||
1811 | 1530 | && $self->{dbh}->can("disconnect") ) { | ||
1812 | 1517 | PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name}); | 1531 | PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name}); |
1813 | 1518 | $self->{dbh}->disconnect(); | 1532 | $self->{dbh}->disconnect(); |
1814 | 1519 | } | 1533 | } |
1815 | @@ -3408,6 +3422,10 @@ | |||
1816 | 3408 | 3422 | ||
1817 | 3409 | =head1 VERSION | 3423 | =head1 VERSION |
1818 | 3410 | 3424 | ||
1819 | 3425 | <<<<<<< TREE | ||
1820 | 3411 | pt-config-diff 2.0.5 | 3426 | pt-config-diff 2.0.5 |
1821 | 3427 | ======= | ||
1822 | 3428 | pt-config-diff 2.1.2 | ||
1823 | 3429 | >>>>>>> MERGE-SOURCE | ||
1824 | 3412 | 3430 | ||
1825 | 3413 | =cut | 3431 | =cut |
1826 | 3414 | 3432 | ||
1827 | === modified file 'bin/pt-deadlock-logger' | |||
1828 | --- bin/pt-deadlock-logger 2012-06-09 21:53:04 +0000 | |||
1829 | +++ bin/pt-deadlock-logger 2012-07-20 22:10:28 +0000 | |||
1830 | @@ -959,7 +959,7 @@ | |||
1831 | 959 | $opt->{value} = ($pre || '') . $num; | 959 | $opt->{value} = ($pre || '') . $num; |
1832 | 960 | } | 960 | } |
1833 | 961 | else { | 961 | else { |
1835 | 962 | $self->save_error("Invalid size for --$opt->{long}"); | 962 | $self->save_error("Invalid size for --$opt->{long}: $val"); |
1836 | 963 | } | 963 | } |
1837 | 964 | return; | 964 | return; |
1838 | 965 | } | 965 | } |
1839 | @@ -1034,6 +1034,455 @@ | |||
1840 | 1034 | # ########################################################################### | 1034 | # ########################################################################### |
1841 | 1035 | 1035 | ||
1842 | 1036 | # ########################################################################### | 1036 | # ########################################################################### |
1843 | 1037 | # Mo package | ||
1844 | 1038 | # This package is a copy without comments from the original. The original | ||
1845 | 1039 | # with comments and its test file can be found in the Bazaar repository at, | ||
1846 | 1040 | # lib/Mo.pm | ||
1847 | 1041 | # t/lib/Mo.t | ||
1848 | 1042 | # See https://launchpad.net/percona-toolkit for more information. | ||
1849 | 1043 | # ########################################################################### | ||
1850 | 1044 | { | ||
1851 | 1045 | BEGIN { | ||
1852 | 1046 | $INC{"Mo.pm"} = __FILE__; | ||
1853 | 1047 | package Mo; | ||
1854 | 1048 | our $VERSION = '0.30_Percona'; # Forked from 0.30 of Mo. | ||
1855 | 1049 | |||
1856 | 1050 | { | ||
1857 | 1051 | no strict 'refs'; | ||
1858 | 1052 | sub _glob_for { | ||
1859 | 1053 | return \*{shift()} | ||
1860 | 1054 | } | ||
1861 | 1055 | |||
1862 | 1056 | sub _stash_for { | ||
1863 | 1057 | return \%{ shift() . "::" }; | ||
1864 | 1058 | } | ||
1865 | 1059 | } | ||
1866 | 1060 | |||
1867 | 1061 | use strict; | ||
1868 | 1062 | use warnings qw( FATAL all ); | ||
1869 | 1063 | |||
1870 | 1064 | use Carp (); | ||
1871 | 1065 | use Scalar::Util (); | ||
1872 | 1066 | |||
1873 | 1067 | our %TYPES = ( | ||
1874 | 1068 | Bool => sub { !$_[0] || (defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == 1) }, | ||
1875 | 1069 | Num => sub { defined $_[0] && &Scalar::Util::looks_like_number }, | ||
1876 | 1070 | Int => sub { defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == int $_[0] }, | ||
1877 | 1071 | Str => sub { defined $_[0] }, | ||
1878 | 1072 | Object => sub { defined $_[0] && &Scalar::Util::blessed }, | ||
1879 | 1073 | FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened }, | ||
1880 | 1074 | |||
1881 | 1075 | map { | ||
1882 | 1076 | my $type = /R/ ? $_ : uc $_; | ||
1883 | 1077 | $_ . "Ref" => sub { ref $_[0] eq $type } | ||
1884 | 1078 | } qw(Array Code Hash Regexp Glob Scalar) | ||
1885 | 1079 | ); | ||
1886 | 1080 | |||
1887 | 1081 | our %metadata_for; | ||
1888 | 1082 | { | ||
1889 | 1083 | package Mo::Object; | ||
1890 | 1084 | |||
1891 | 1085 | sub new { | ||
1892 | 1086 | my $class = shift; | ||
1893 | 1087 | my $args = $class->BUILDARGS(@_); | ||
1894 | 1088 | |||
1895 | 1089 | my @args_to_delete; | ||
1896 | 1090 | while ( my ($attr, $meta) = each %{$metadata_for{$class}} ) { | ||
1897 | 1091 | next unless exists $meta->{init_arg}; | ||
1898 | 1092 | my $init_arg = $meta->{init_arg}; | ||
1899 | 1093 | |||
1900 | 1094 | if ( defined $init_arg ) { | ||
1901 | 1095 | $args->{$attr} = delete $args->{$init_arg}; | ||
1902 | 1096 | } | ||
1903 | 1097 | else { | ||
1904 | 1098 | push @args_to_delete, $attr; | ||
1905 | 1099 | } | ||
1906 | 1100 | } | ||
1907 | 1101 | |||
1908 | 1102 | delete $args->{$_} for @args_to_delete; | ||
1909 | 1103 | |||
1910 | 1104 | for my $attribute ( keys %$args ) { | ||
1911 | 1105 | if ( my $coerce = $metadata_for{$class}{$attribute}{coerce} ) { | ||
1912 | 1106 | $args->{$attribute} = $coerce->($args->{$attribute}); | ||
1913 | 1107 | } | ||
1914 | 1108 | if ( my $I = $metadata_for{$class}{$attribute}{isa} ) { | ||
1915 | 1109 | ( (my $I_name), $I ) = @{$I}; | ||
1916 | 1110 | Mo::_check_type_constaints($attribute, $I, $I_name, $args->{$attribute}); | ||
1917 | 1111 | } | ||
1918 | 1112 | } | ||
1919 | 1113 | |||
1920 | 1114 | while ( my ($attribute, $meta) = each %{$metadata_for{$class}} ) { | ||
1921 | 1115 | next unless $meta->{required}; | ||
1922 | 1116 | Carp::confess("Attribute ($attribute) is required for $class") | ||
1923 | 1117 | if ! exists $args->{$attribute} | ||
1924 | 1118 | } | ||
1925 | 1119 | |||
1926 | 1120 | @_ = %$args; | ||
1927 | 1121 | my $self = bless $args, $class; | ||
1928 | 1122 | |||
1929 | 1123 | my @build_subs; | ||
1930 | 1124 | my $linearized_isa = mro::get_linear_isa($class); | ||
1931 | 1125 | |||
1932 | 1126 | for my $isa_class ( @$linearized_isa ) { | ||
1933 | 1127 | unshift @build_subs, *{ Mo::_glob_for "${isa_class}::BUILD" }{CODE}; | ||
1934 | 1128 | } | ||
1935 | 1129 | exists &$_ && $_->( $self, @_ ) for grep { defined } @build_subs; | ||
1936 | 1130 | return $self; | ||
1937 | 1131 | } | ||
1938 | 1132 | |||
1939 | 1133 | sub BUILDARGS { | ||
1940 | 1134 | shift; | ||
1941 | 1135 | my $ref; | ||
1942 | 1136 | if ( @_ == 1 && ref($_[0]) ) { | ||
1943 | 1137 | Carp::confess("Single parameters to new() must be a HASH ref") | ||
1944 | 1138 | unless ref($_[0]) eq ref({}); | ||
1945 | 1139 | $ref = {%{$_[0]}} # We want a new reference, always | ||
1946 | 1140 | } | ||
1947 | 1141 | else { | ||
1948 | 1142 | $ref = { @_ }; | ||
1949 | 1143 | } | ||
1950 | 1144 | return $ref; | ||
1951 | 1145 | } | ||
1952 | 1146 | } | ||
1953 | 1147 | |||
1954 | 1148 | my %export_for; | ||
1955 | 1149 | sub Mo::import { | ||
1956 | 1150 | warnings->import(qw(FATAL all)); | ||
1957 | 1151 | strict->import(); | ||
1958 | 1152 | |||
1959 | 1153 | my $caller = scalar caller(); # Caller's package | ||
1960 | 1154 | my $caller_pkg = $caller . "::"; # Caller's package with :: at the end | ||
1961 | 1155 | my (%exports, %options); | ||
1962 | 1156 | |||
1963 | 1157 | my (undef, @features) = @_; | ||
1964 | 1158 | my %ignore = ( map { $_ => 1 } qw( is isa init_arg builder buildargs clearer predicate build handles default required ) ); | ||
1965 | 1159 | for my $feature (grep { !$ignore{$_} } @features) { | ||
1966 | 1160 | { local $@; require "Mo/$feature.pm"; } | ||
1967 | 1161 | { | ||
1968 | 1162 | no strict 'refs'; | ||
1969 | 1163 | &{"Mo::${feature}::e"}( | ||
1970 | 1164 | $caller_pkg, | ||
1971 | 1165 | \%exports, | ||
1972 | 1166 | \%options, | ||
1973 | 1167 | \@_ | ||
1974 | 1168 | ); | ||
1975 | 1169 | } | ||
1976 | 1170 | } | ||
1977 | 1171 | |||
1978 | 1172 | return if $exports{M}; | ||
1979 | 1173 | |||
1980 | 1174 | %exports = ( | ||
1981 | 1175 | extends => sub { | ||
1982 | 1176 | for my $class ( map { "$_" } @_ ) { | ||
1983 | 1177 | $class =~ s{::|'}{/}g; | ||
1984 | 1178 | { local $@; eval { require "$class.pm" } } # or warn $@; | ||
1985 | 1179 | } | ||
1986 | 1180 | _set_package_isa($caller, @_); | ||
1987 | 1181 | _set_inherited_metadata($caller); | ||
1988 | 1182 | }, | ||
1989 | 1183 | has => sub { | ||
1990 | 1184 | my $names = shift; | ||
1991 | 1185 | for my $attribute ( ref $names ? @$names : $names ) { | ||
1992 | 1186 | my %args = @_; | ||
1993 | 1187 | my $method = ($args{is} || '') eq 'ro' | ||
1994 | 1188 | ? sub { | ||
1995 | 1189 | Carp::confess("Cannot assign a value to a read-only accessor at reader ${caller_pkg}${attribute}") | ||
1996 | 1190 | if $#_; | ||
1997 | 1191 | return $_[0]{$attribute}; | ||
1998 | 1192 | } | ||
1999 | 1193 | : sub { | ||
2000 | 1194 | return $#_ | ||
2001 | 1195 | ? $_[0]{$attribute} = $_[1] | ||
2002 | 1196 | : $_[0]{$attribute}; | ||
2003 | 1197 | }; | ||
2004 | 1198 | |||
2005 | 1199 | $metadata_for{$caller}{$attribute} = (); | ||
2006 | 1200 | |||
2007 | 1201 | if ( my $I = $args{isa} ) { | ||
2008 | 1202 | my $orig_I = $I; | ||
2009 | 1203 | my $type; | ||
2010 | 1204 | if ( $I =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) { | ||
2011 | 1205 | $I = _nested_constraints($attribute, $1, $2); | ||
2012 | 1206 | } | ||
2013 | 1207 | $metadata_for{$caller}{$attribute}{isa} = [$orig_I, $I]; | ||
2014 | 1208 | my $orig_method = $method; | ||
2015 | 1209 | $method = sub { | ||
2016 | 1210 | if ( $#_ ) { | ||
2017 | 1211 | Mo::_check_type_constaints($attribute, $I, $orig_I, $_[1]); | ||
2018 | 1212 | } | ||
2019 | 1213 | goto &$orig_method; | ||
2020 | 1214 | }; | ||
2021 | 1215 | } | ||
2022 | 1216 | |||
2023 | 1217 | if ( my $builder = $args{builder} ) { | ||
2024 | 1218 | my $original_method = $method; | ||
2025 | 1219 | $method = sub { | ||
2026 | 1220 | $#_ | ||
2027 | 1221 | ? goto &$original_method | ||
2028 | 1222 | : ! exists $_[0]{$attribute} | ||
2029 | 1223 | ? $_[0]{$attribute} = $_[0]->$builder | ||
2030 | 1224 | : goto &$original_method | ||
2031 | 1225 | }; | ||
2032 | 1226 | } | ||
2033 | 1227 | |||
2034 | 1228 | if ( my $code = $args{default} ) { | ||
2035 | 1229 | Carp::confess("${caller}::${attribute}'s default is $code, but should be a coderef") | ||
2036 | 1230 | unless ref($code) eq 'CODE'; | ||
2037 | 1231 | my $original_method = $method; | ||
2038 | 1232 | $method = sub { | ||
2039 | 1233 | $#_ | ||
2040 | 1234 | ? goto &$original_method | ||
2041 | 1235 | : ! exists $_[0]{$attribute} | ||
2042 | 1236 | ? $_[0]{$attribute} = $_[0]->$code | ||
2043 | 1237 | : goto &$original_method | ||
2044 | 1238 | }; | ||
2045 | 1239 | } | ||
2046 | 1240 | |||
2047 | 1241 | if ( my $role = $args{does} ) { | ||
2048 | 1242 | my $original_method = $method; | ||
2049 | 1243 | $method = sub { | ||
2050 | 1244 | if ( $#_ ) { | ||
2051 | 1245 | Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">) | ||
2052 | 1246 | unless blessed($_[1]) && $_[1]->does($role) | ||
2053 | 1247 | } | ||
2054 | 1248 | goto &$original_method | ||
2055 | 1249 | }; | ||
2056 | 1250 | } | ||
2057 | 1251 | |||
2058 | 1252 | if ( my $coercion = $args{coerce} ) { | ||
2059 | 1253 | $metadata_for{$caller}{$attribute}{coerce} = $coercion; | ||
2060 | 1254 | my $original_method = $method; | ||
2061 | 1255 | $method = sub { | ||
2062 | 1256 | if ( $#_ ) { | ||
2063 | 1257 | return $original_method->($_[0], $coercion->($_[1])) | ||
2064 | 1258 | } | ||
2065 | 1259 | goto &$original_method; | ||
2066 | 1260 | } | ||
2067 | 1261 | } | ||
2068 | 1262 | |||
2069 | 1263 | $method = $options{$_}->($method, $attribute, @_) | ||
2070 | 1264 | for sort keys %options; | ||
2071 | 1265 | |||
2072 | 1266 | *{ _glob_for "${caller}::$attribute" } = $method; | ||
2073 | 1267 | |||
2074 | 1268 | if ( $args{required} ) { | ||
2075 | 1269 | $metadata_for{$caller}{$attribute}{required} = 1; | ||
2076 | 1270 | } | ||
2077 | 1271 | |||
2078 | 1272 | if ($args{clearer}) { | ||
2079 | 1273 | *{ _glob_for "${caller}::$args{clearer}" } | ||
2080 | 1274 | = sub { delete shift->{$attribute} } | ||
2081 | 1275 | } | ||
2082 | 1276 | |||
2083 | 1277 | if ($args{predicate}) { | ||
2084 | 1278 | *{ _glob_for "${caller}::$args{predicate}" } | ||
2085 | 1279 | = sub { exists shift->{$attribute} } | ||
2086 | 1280 | } | ||
2087 | 1281 | |||
2088 | 1282 | if ($args{handles}) { | ||
2089 | 1283 | _has_handles($caller, $attribute, \%args); | ||
2090 | 1284 | } | ||
2091 | 1285 | |||
2092 | 1286 | if (exists $args{init_arg}) { | ||
2093 | 1287 | $metadata_for{$caller}{$attribute}{init_arg} = $args{init_arg}; | ||
2094 | 1288 | } | ||
2095 | 1289 | } | ||
2096 | 1290 | }, | ||
2097 | 1291 | %exports, | ||
2098 | 1292 | ); | ||
2099 | 1293 | |||
2100 | 1294 | $export_for{$caller} = [ keys %exports ]; | ||
2101 | 1295 | |||
2102 | 1296 | for my $keyword ( keys %exports ) { | ||
2103 | 1297 | *{ _glob_for "${caller}::$keyword" } = $exports{$keyword} | ||
2104 | 1298 | } | ||
2105 | 1299 | *{ _glob_for "${caller}::extends" }{CODE}->( "Mo::Object" ) | ||
2106 | 1300 | unless @{ *{ _glob_for "${caller}::ISA" }{ARRAY} || [] }; | ||
2107 | 1301 | }; | ||
2108 | 1302 | |||
2109 | 1303 | sub _check_type_constaints { | ||
2110 | 1304 | my ($attribute, $I, $I_name, $val) = @_; | ||
2111 | 1305 | ( ref($I) eq 'CODE' | ||
2112 | 1306 | ? $I->($val) | ||
2113 | 1307 | : (ref $val eq $I | ||
2114 | 1308 | || ($val && $val eq $I) | ||
2115 | 1309 | || (exists $TYPES{$I} && $TYPES{$I}->($val))) | ||
2116 | 1310 | ) | ||
2117 | 1311 | || Carp::confess( | ||
2118 | 1312 | qq<Attribute ($attribute) does not pass the type constraint because: > | ||
2119 | 1313 | . qq<Validation failed for '$I_name' with value > | ||
2120 | 1314 | . (defined $val ? Mo::Dumper($val) : 'undef') ) | ||
2121 | 1315 | } | ||
2122 | 1316 | |||
2123 | 1317 | sub _has_handles { | ||
2124 | 1318 | my ($caller, $attribute, $args) = @_; | ||
2125 | 1319 | my $handles = $args->{handles}; | ||
2126 | 1320 | |||
2127 | 1321 | my $ref = ref $handles; | ||
2128 | 1322 | my $kv; | ||
2129 | 1323 | if ( $ref eq ref [] ) { | ||
2130 | 1324 | $kv = { map { $_,$_ } @{$handles} }; | ||
2131 | 1325 | } | ||
2132 | 1326 | elsif ( $ref eq ref {} ) { | ||
2133 | 1327 | $kv = $handles; | ||
2134 | 1328 | } | ||
2135 | 1329 | elsif ( $ref eq ref qr// ) { | ||
2136 | 1330 | Carp::confess("Cannot delegate methods based on a Regexp without a type constraint (isa)") | ||
2137 | 1331 | unless $args->{isa}; | ||
2138 | 1332 | my $target_class = $args->{isa}; | ||
2139 | 1333 | $kv = { | ||
2140 | 1334 | map { $_, $_ } | ||
2141 | 1335 | grep { $_ =~ $handles } | ||
2142 | 1336 | grep { !exists $Mo::Object::{$_} && $target_class->can($_) } | ||
2143 | 1337 | grep { $_ ne 'has' && $_ ne 'extends' } | ||
2144 | 1338 | keys %{ _stash_for $target_class } | ||
2145 | 1339 | }; | ||
2146 | 1340 | } | ||
2147 | 1341 | else { | ||
2148 | 1342 | Carp::confess("handles for $ref not yet implemented"); | ||
2149 | 1343 | } | ||
2150 | 1344 | |||
2151 | 1345 | while ( my ($method, $target) = each %{$kv} ) { | ||
2152 | 1346 | my $name = _glob_for "${caller}::$method"; | ||
2153 | 1347 | Carp::confess("You cannot overwrite a locally defined method ($method) with a delegation") | ||
2154 | 1348 | if defined &$name; | ||
2155 | 1349 | |||
2156 | 1350 | my ($target, @curried_args) = ref($target) ? @$target : $target; | ||
2157 | 1351 | *$name = sub { | ||
2158 | 1352 | my $self = shift; | ||
2159 | 1353 | my $delegate_to = $self->$attribute(); | ||
2160 | 1354 | my $error = "Cannot delegate $method to $target because the value of $attribute"; | ||
2161 | 1355 | Carp::confess("$error is not defined") unless $delegate_to; | ||
2162 | 1356 | Carp::confess("$error is not an object (got '$delegate_to')") | ||
2163 | 1357 | unless Scalar::Util::blessed($delegate_to) || (!ref($delegate_to) && $delegate_to->can($target)); | ||
2164 | 1358 | return $delegate_to->$target(@curried_args, @_); | ||
2165 | 1359 | } | ||
2166 | 1360 | } | ||
2167 | 1361 | } | ||
2168 | 1362 | |||
2169 | 1363 | sub _nested_constraints { | ||
2170 | 1364 | my ($attribute, $aggregate_type, $type) = @_; | ||
2171 | 1365 | |||
2172 | 1366 | my $inner_types; | ||
2173 | 1367 | if ( $type =~ /\A(ArrayRef|Maybe)\[(.*)\]\z/ ) { | ||
2174 | 1368 | $inner_types = _nested_constraints($1, $2); | ||
2175 | 1369 | } | ||
2176 | 1370 | else { | ||
2177 | 1371 | $inner_types = $TYPES{$type}; | ||
2178 | 1372 | } | ||
2179 | 1373 | |||
2180 | 1374 | if ( $aggregate_type eq 'ArrayRef' ) { | ||
2181 | 1375 | return sub { | ||
2182 | 1376 | my ($val) = @_; | ||
2183 | 1377 | return unless ref($val) eq ref([]); | ||
2184 | 1378 | |||
2185 | 1379 | if ($inner_types) { | ||
2186 | 1380 | for my $value ( @{$val} ) { | ||
2187 | 1381 | return unless $inner_types->($value) | ||
2188 | 1382 | } | ||
2189 | 1383 | } | ||
2190 | 1384 | else { | ||
2191 | 1385 | for my $value ( @{$val} ) { | ||
2192 | 1386 | return unless $value && ($value eq $type | ||
2193 | 1387 | || (Scalar::Util::blessed($value) && $value->isa($type))); | ||
2194 | 1388 | } | ||
2195 | 1389 | } | ||
2196 | 1390 | return 1; | ||
2197 | 1391 | }; | ||
2198 | 1392 | } | ||
2199 | 1393 | elsif ( $aggregate_type eq 'Maybe' ) { | ||
2200 | 1394 | return sub { | ||
2201 | 1395 | my ($value) = @_; | ||
2202 | 1396 | return 1 if ! defined($value); | ||
2203 | 1397 | if ($inner_types) { | ||
2204 | 1398 | return unless $inner_types->($value) | ||
2205 | 1399 | } | ||
2206 | 1400 | else { | ||
2207 | 1401 | return unless $value eq $type | ||
2208 | 1402 | || (Scalar::Util::blessed($value) && $value->isa($type)); | ||
2209 | 1403 | } | ||
2210 | 1404 | return 1; | ||
2211 | 1405 | } | ||
2212 | 1406 | } | ||
2213 | 1407 | else { | ||
2214 | 1408 | Carp::confess("Nested aggregate types are only implemented for ArrayRefs and Maybe"); | ||
2215 | 1409 | } | ||
2216 | 1410 | } | ||
2217 | 1411 | |||
2218 | 1412 | sub _set_package_isa { | ||
2219 | 1413 | my ($package, @new_isa) = @_; | ||
2220 | 1414 | |||
2221 | 1415 | *{ _glob_for "${package}::ISA" } = [@new_isa]; | ||
2222 | 1416 | } | ||
2223 | 1417 | |||
2224 | 1418 | sub _set_inherited_metadata { | ||
2225 | 1419 | my $class = shift; | ||
2226 | 1420 | my $linearized_isa = mro::get_linear_isa($class); | ||
2227 | 1421 | my %new_metadata; | ||
2228 | 1422 | |||
2229 | 1423 | for my $isa_class (reverse @$linearized_isa) { | ||
2230 | 1424 | %new_metadata = ( | ||
2231 | 1425 | %new_metadata, | ||
2232 | 1426 | %{ $metadata_for{$isa_class} || {} }, | ||
2233 | 1427 | ); | ||
2234 | 1428 | } | ||
2235 | 1429 | $metadata_for{$class} = \%new_metadata; | ||
2236 | 1430 | } | ||
2237 | 1431 | |||
2238 | 1432 | sub unimport { | ||
2239 | 1433 | my $caller = scalar caller(); | ||
2240 | 1434 | my $stash = _stash_for( $caller ); | ||
2241 | 1435 | |||
2242 | 1436 | delete $stash->{$_} for @{$export_for{$caller}}; | ||
2243 | 1437 | } | ||
2244 | 1438 | |||
2245 | 1439 | sub Dumper { | ||
2246 | 1440 | require Data::Dumper; | ||
2247 | 1441 | local $Data::Dumper::Indent = 0; | ||
2248 | 1442 | local $Data::Dumper::Sortkeys = 0; | ||
2249 | 1443 | local $Data::Dumper::Quotekeys = 0; | ||
2250 | 1444 | local $Data::Dumper::Terse = 1; | ||
2251 | 1445 | |||
2252 | 1446 | Data::Dumper::Dumper(@_) | ||
2253 | 1447 | } | ||
2254 | 1448 | |||
2255 | 1449 | BEGIN { | ||
2256 | 1450 | if ($] >= 5.010) { | ||
2257 | 1451 | { local $@; require mro; } | ||
2258 | 1452 | } | ||
2259 | 1453 | else { | ||
2260 | 1454 | local $@; | ||
2261 | 1455 | eval { | ||
2262 | 1456 | require MRO::Compat; | ||
2263 | 1457 | } or do { | ||
2264 | 1458 | *mro::get_linear_isa = *mro::get_linear_isa_dfs = sub { | ||
2265 | 1459 | no strict 'refs'; | ||
2266 | 1460 | |||
2267 | 1461 | my $classname = shift; | ||
2268 | 1462 | |||
2269 | 1463 | my @lin = ($classname); | ||
2270 | 1464 | my %stored; | ||
2271 | 1465 | foreach my $parent (@{"$classname\::ISA"}) { | ||
2272 | 1466 | my $plin = mro::get_linear_isa_dfs($parent); | ||
2273 | 1467 | foreach (@$plin) { | ||
2274 | 1468 | next if exists $stored{$_}; | ||
2275 | 1469 | push(@lin, $_); | ||
2276 | 1470 | $stored{$_} = 1; | ||
2277 | 1471 | } | ||
2278 | 1472 | } | ||
2279 | 1473 | return \@lin; | ||
2280 | 1474 | }; | ||
2281 | 1475 | } | ||
2282 | 1476 | } | ||
2283 | 1477 | } | ||
2284 | 1478 | |||
2285 | 1479 | } | ||
2286 | 1480 | 1; | ||
2287 | 1481 | } | ||
2288 | 1482 | # ########################################################################### | ||
2289 | 1483 | # End Mo package | ||
2290 | 1484 | # ########################################################################### | ||
2291 | 1485 | # ########################################################################### | ||
2292 | 1037 | # VersionParser package | 1486 | # VersionParser package |
2293 | 1038 | # This package is a copy without comments from the original. The original | 1487 | # This package is a copy without comments from the original. The original |
2294 | 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, |
2295 | @@ -1044,35 +1493,145 @@ | |||
2296 | 1044 | { | 1493 | { |
2297 | 1045 | package VersionParser; | 1494 | package VersionParser; |
2298 | 1046 | 1495 | ||
2301 | 1047 | use strict; | 1496 | use Mo; |
2302 | 1048 | use warnings FATAL => 'all'; | 1497 | use Scalar::Util qw(blessed); |
2303 | 1049 | use English qw(-no_match_vars); | 1498 | use English qw(-no_match_vars); |
2304 | 1050 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | 1499 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
2305 | 1051 | 1500 | ||
2330 | 1052 | sub new { | 1501 | use overload ( |
2331 | 1053 | my ( $class ) = @_; | 1502 | '""' => "version", |
2332 | 1054 | bless {}, $class; | 1503 | '<=>' => "cmp", |
2333 | 1055 | } | 1504 | 'cmp' => "cmp", |
2334 | 1056 | 1505 | fallback => 1, | |
2335 | 1057 | sub parse { | 1506 | ); |
2336 | 1058 | my ( $self, $str ) = @_; | 1507 | |
2337 | 1059 | my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); | 1508 | use Carp (); |
2338 | 1060 | PTDEBUG && _d($str, 'parses to', $result); | 1509 | |
2339 | 1061 | return $result; | 1510 | our $VERSION = 0.01; |
2340 | 1062 | } | 1511 | |
2341 | 1063 | 1512 | has major => ( | |
2342 | 1064 | sub version_ge { | 1513 | is => 'ro', |
2343 | 1065 | my ( $self, $dbh, $target ) = @_; | 1514 | isa => 'Int', |
2344 | 1066 | if ( !$self->{$dbh} ) { | 1515 | required => 1, |
2345 | 1067 | $self->{$dbh} = $self->parse( | 1516 | ); |
2346 | 1068 | $dbh->selectrow_array('SELECT VERSION()')); | 1517 | |
2347 | 1069 | } | 1518 | has [qw( minor revision )] => ( |
2348 | 1070 | my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; | 1519 | is => 'ro', |
2349 | 1071 | PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); | 1520 | isa => 'Num', |
2350 | 1072 | return $result; | 1521 | ); |
2351 | 1073 | } | 1522 | |
2352 | 1074 | 1523 | has flavor => ( | |
2353 | 1075 | sub innodb_version { | 1524 | is => 'ro', |
2354 | 1525 | isa => 'Str', | ||
2355 | 1526 | default => sub { 'Unknown' }, | ||
2356 | 1527 | ); | ||
2357 | 1528 | |||
2358 | 1529 | has innodb_version => ( | ||
2359 | 1530 | is => 'ro', | ||
2360 | 1531 | isa => 'Str', | ||
2361 | 1532 | default => sub { 'NO' }, | ||
2362 | 1533 | ); | ||
2363 | 1534 | |||
2364 | 1535 | sub series { | ||
2365 | 1536 | my $self = shift; | ||
2366 | 1537 | return $self->_join_version($self->major, $self->minor); | ||
2367 | 1538 | } | ||
2368 | 1539 | |||
2369 | 1540 | sub version { | ||
2370 | 1541 | my $self = shift; | ||
2371 | 1542 | return $self->_join_version($self->major, $self->minor, $self->revision); | ||
2372 | 1543 | } | ||
2373 | 1544 | |||
2374 | 1545 | sub is_in { | ||
2375 | 1546 | my ($self, $target) = @_; | ||
2376 | 1547 | |||
2377 | 1548 | return $self eq $target; | ||
2378 | 1549 | } | ||
2379 | 1550 | |||
2380 | 1551 | sub _join_version { | ||
2381 | 1552 | my ($self, @parts) = @_; | ||
2382 | 1553 | |||
2383 | 1554 | return join ".", map { my $c = $_; $c =~ s/^0\./0/; $c } grep defined, @parts; | ||
2384 | 1555 | } | ||
2385 | 1556 | sub _split_version { | ||
2386 | 1557 | my ($self, $str) = @_; | ||
2387 | 1558 | my @version_parts = map { s/^0(?=\d)/0./; $_ } $str =~ m/(\d+)/g; | ||
2388 | 1559 | return @version_parts[0..2]; | ||
2389 | 1560 | } | ||
2390 | 1561 | |||
2391 | 1562 | sub normalized_version { | ||
2392 | 1563 | my ( $self ) = @_; | ||
2393 | 1564 | my $result = sprintf('%d%02d%02d', map { $_ || 0 } $self->major, | ||
2394 | 1565 | $self->minor, | ||
2395 | 1566 | $self->revision); | ||
2396 | 1567 | PTDEBUG && _d($self->version, 'normalizes to', $result); | ||
2397 | 1568 | return $result; | ||
2398 | 1569 | } | ||
2399 | 1570 | |||
2400 | 1571 | sub comment { | ||
2401 | 1572 | my ( $self, $cmd ) = @_; | ||
2402 | 1573 | my $v = $self->normalized_version(); | ||
2403 | 1574 | |||
2404 | 1575 | return "/*!$v $cmd */" | ||
2405 | 1576 | } | ||
2406 | 1577 | |||
2407 | 1578 | my @methods = qw(major minor revision); | ||
2408 | 1579 | sub cmp { | ||
2409 | 1580 | my ($left, $right) = @_; | ||
2410 | 1581 | my $right_obj = (blessed($right) && $right->isa(ref($left))) | ||
2411 | 1582 | ? $right | ||
2412 | 1583 | : ref($left)->new($right); | ||
2413 | 1584 | |||
2414 | 1585 | my $retval = 0; | ||
2415 | 1586 | for my $m ( @methods ) { | ||
2416 | 1587 | last unless defined($left->$m) && defined($right_obj->$m); | ||
2417 | 1588 | $retval = $left->$m <=> $right_obj->$m; | ||
2418 | 1589 | last if $retval; | ||
2419 | 1590 | } | ||
2420 | 1591 | return $retval; | ||
2421 | 1592 | } | ||
2422 | 1593 | |||
2423 | 1594 | sub BUILDARGS { | ||
2424 | 1595 | my $self = shift; | ||
2425 | 1596 | |||
2426 | 1597 | if ( @_ == 1 ) { | ||
2427 | 1598 | my %args; | ||
2428 | 1599 | if ( blessed($_[0]) && $_[0]->can("selectrow_hashref") ) { | ||
2429 | 1600 | PTDEBUG && _d("VersionParser got a dbh, trying to get the version"); | ||
2430 | 1601 | my $dbh = $_[0]; | ||
2431 | 1602 | local $dbh->{FetchHashKeyName} = 'NAME_lc'; | ||
2432 | 1603 | my $query = eval { | ||
2433 | 1604 | $dbh->selectall_arrayref(q/SHOW VARIABLES LIKE 'version%'/, { Slice => {} }) | ||
2434 | 1605 | }; | ||
2435 | 1606 | if ( $query ) { | ||
2436 | 1607 | $query = { map { $_->{variable_name} => $_->{value} } @$query }; | ||
2437 | 1608 | @args{@methods} = $self->_split_version($query->{version}); | ||
2438 | 1609 | $args{flavor} = delete $query->{version_comment} | ||
2439 | 1610 | if $query->{version_comment}; | ||
2440 | 1611 | } | ||
2441 | 1612 | elsif ( eval { ($query) = $dbh->selectrow_array(q/SELECT VERSION()/) } ) { | ||
2442 | 1613 | @args{@methods} = $self->_split_version($query); | ||
2443 | 1614 | } | ||
2444 | 1615 | else { | ||
2445 | 1616 | Carp::confess("Couldn't get the version from the dbh while " | ||
2446 | 1617 | . "creating a VersionParser object: $@"); | ||
2447 | 1618 | } | ||
2448 | 1619 | $args{innodb_version} = eval { $self->_innodb_version($dbh) }; | ||
2449 | 1620 | } | ||
2450 | 1621 | elsif ( !ref($_[0]) ) { | ||
2451 | 1622 | @args{@methods} = $self->_split_version($_[0]); | ||
2452 | 1623 | } | ||
2453 | 1624 | |||
2454 | 1625 | for my $method (@methods) { | ||
2455 | 1626 | delete $args{$method} unless defined $args{$method}; | ||
2456 | 1627 | } | ||
2457 | 1628 | @_ = %args if %args; | ||
2458 | 1629 | } | ||
2459 | 1630 | |||
2460 | 1631 | return $self->SUPER::BUILDARGS(@_); | ||
2461 | 1632 | } | ||
2462 | 1633 | |||
2463 | 1634 | sub _innodb_version { | ||
2464 | 1076 | my ( $self, $dbh ) = @_; | 1635 | my ( $self, $dbh ) = @_; |
2465 | 1077 | return unless $dbh; | 1636 | return unless $dbh; |
2466 | 1078 | my $innodb_version = "NO"; | 1637 | my $innodb_version = "NO"; |
2467 | @@ -1110,6 +1669,7 @@ | |||
2468 | 1110 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | 1669 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; |
2469 | 1111 | } | 1670 | } |
2470 | 1112 | 1671 | ||
2471 | 1672 | no Mo; | ||
2472 | 1113 | 1; | 1673 | 1; |
2473 | 1114 | } | 1674 | } |
2474 | 1115 | # ########################################################################### | 1675 | # ########################################################################### |
2475 | @@ -1187,6 +1747,48 @@ | |||
2476 | 1187 | return $db ? "$db.$tbl" : $tbl; | 1747 | return $db ? "$db.$tbl" : $tbl; |
2477 | 1188 | } | 1748 | } |
2478 | 1189 | 1749 | ||
2479 | 1750 | sub serialize_list { | ||
2480 | 1751 | my ( $self, @args ) = @_; | ||
2481 | 1752 | return unless @args; | ||
2482 | 1753 | |||
2483 | 1754 | return $args[0] if @args == 1 && !defined $args[0]; | ||
2484 | 1755 | |||
2485 | 1756 | die "Cannot serialize multiple values with undef/NULL" | ||
2486 | 1757 | if grep { !defined $_ } @args; | ||
2487 | 1758 | |||
2488 | 1759 | return join ',', map { quotemeta } @args; | ||
2489 | 1760 | } | ||
2490 | 1761 | |||
2491 | 1762 | sub deserialize_list { | ||
2492 | 1763 | my ( $self, $string ) = @_; | ||
2493 | 1764 | return $string unless defined $string; | ||
2494 | 1765 | my @escaped_parts = $string =~ / | ||
2495 | 1766 | \G # Start of string, or end of previous match. | ||
2496 | 1767 | ( # Each of these is an element in the original list. | ||
2497 | 1768 | [^\\,]* # Anything not a backslash or a comma | ||
2498 | 1769 | (?: # When we get here, we found one of the above. | ||
2499 | 1770 | \\. # A backslash followed by something so we can continue | ||
2500 | 1771 | [^\\,]* # Same as above. | ||
2501 | 1772 | )* # Repeat zero of more times. | ||
2502 | 1773 | ) | ||
2503 | 1774 | , # Comma dividing elements | ||
2504 | 1775 | /sxgc; | ||
2505 | 1776 | |||
2506 | 1777 | push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string; | ||
2507 | 1778 | |||
2508 | 1779 | my @unescaped_parts = map { | ||
2509 | 1780 | my $part = $_; | ||
2510 | 1781 | |||
2511 | 1782 | my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string, | ||
2512 | 1783 | ? qr/(?=\p{ASCII})\W/ # We only care about non-word | ||
2513 | 1784 | : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise, | ||
2514 | 1785 | $part =~ s/\\($char_class)/$1/g; | ||
2515 | 1786 | $part; | ||
2516 | 1787 | } @escaped_parts; | ||
2517 | 1788 | |||
2518 | 1789 | return @unescaped_parts; | ||
2519 | 1790 | } | ||
2520 | 1791 | |||
2521 | 1190 | 1; | 1792 | 1; |
2522 | 1191 | } | 1793 | } |
2523 | 1192 | # ########################################################################### | 1794 | # ########################################################################### |
2524 | @@ -1422,51 +2024,10 @@ | |||
2525 | 1422 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, | 2024 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, |
2526 | 1423 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); | 2025 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); |
2527 | 1424 | 2026 | ||
2566 | 1425 | eval { | 2027 | $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) }; |
2567 | 1426 | $dbh = DBI->connect($cxn_string, $user, $pass, $defaults); | 2028 | |
2530 | 1427 | |||
2531 | 1428 | if ( $cxn_string =~ m/mysql/i ) { | ||
2532 | 1429 | my $sql; | ||
2533 | 1430 | |||
2534 | 1431 | $sql = 'SELECT @@SQL_MODE'; | ||
2535 | 1432 | PTDEBUG && _d($dbh, $sql); | ||
2536 | 1433 | my ($sql_mode) = $dbh->selectrow_array($sql); | ||
2537 | 1434 | |||
2538 | 1435 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
2539 | 1436 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
2540 | 1437 | . ($sql_mode ? ",$sql_mode" : '') | ||
2541 | 1438 | . '\'*/'; | ||
2542 | 1439 | PTDEBUG && _d($dbh, $sql); | ||
2543 | 1440 | $dbh->do($sql); | ||
2544 | 1441 | |||
2545 | 1442 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
2546 | 1443 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
2547 | 1444 | PTDEBUG && _d($dbh, ':', $sql); | ||
2548 | 1445 | $dbh->do($sql); | ||
2549 | 1446 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
2550 | 1447 | if ( $charset eq 'utf8' ) { | ||
2551 | 1448 | binmode(STDOUT, ':utf8') | ||
2552 | 1449 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
2553 | 1450 | } | ||
2554 | 1451 | else { | ||
2555 | 1452 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
2556 | 1453 | } | ||
2557 | 1454 | } | ||
2558 | 1455 | |||
2559 | 1456 | if ( $self->prop('set-vars') ) { | ||
2560 | 1457 | $sql = "SET " . $self->prop('set-vars'); | ||
2561 | 1458 | PTDEBUG && _d($dbh, ':', $sql); | ||
2562 | 1459 | $dbh->do($sql); | ||
2563 | 1460 | } | ||
2564 | 1461 | } | ||
2565 | 1462 | }; | ||
2568 | 1463 | if ( !$dbh && $EVAL_ERROR ) { | 2029 | if ( !$dbh && $EVAL_ERROR ) { |
2575 | 1464 | PTDEBUG && _d($EVAL_ERROR); | 2030 | if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { |
2570 | 1465 | if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
2571 | 1466 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
2572 | 1467 | delete $defaults->{mysql_enable_utf8}; | ||
2573 | 1468 | } | ||
2574 | 1469 | elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { | ||
2576 | 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 " |
2577 | 1471 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " | 2032 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " |
2578 | 1472 | . "the directories that Perl searches for DBD::mysql. If " | 2033 | . "the directories that Perl searches for DBD::mysql. If " |
2579 | @@ -1475,19 +2036,70 @@ | |||
2580 | 1475 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" | 2036 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" |
2581 | 1476 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; | 2037 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; |
2582 | 1477 | } | 2038 | } |
2583 | 2039 | elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
2584 | 2040 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
2585 | 2041 | delete $defaults->{mysql_enable_utf8}; | ||
2586 | 2042 | } | ||
2587 | 1478 | if ( !$tries ) { | 2043 | if ( !$tries ) { |
2588 | 1479 | die $EVAL_ERROR; | 2044 | die $EVAL_ERROR; |
2589 | 1480 | } | 2045 | } |
2590 | 1481 | } | 2046 | } |
2591 | 1482 | } | 2047 | } |
2592 | 1483 | 2048 | ||
2593 | 2049 | if ( $cxn_string =~ m/mysql/i ) { | ||
2594 | 2050 | my $sql; | ||
2595 | 2051 | |||
2596 | 2052 | $sql = 'SELECT @@SQL_MODE'; | ||
2597 | 2053 | PTDEBUG && _d($dbh, $sql); | ||
2598 | 2054 | my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; | ||
2599 | 2055 | if ( $EVAL_ERROR ) { | ||
2600 | 2056 | die $EVAL_ERROR; | ||
2601 | 2057 | } | ||
2602 | 2058 | |||
2603 | 2059 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
2604 | 2060 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
2605 | 2061 | . ($sql_mode ? ",$sql_mode" : '') | ||
2606 | 2062 | . '\'*/'; | ||
2607 | 2063 | PTDEBUG && _d($dbh, $sql); | ||
2608 | 2064 | eval { $dbh->do($sql) }; | ||
2609 | 2065 | if ( $EVAL_ERROR ) { | ||
2610 | 2066 | die $EVAL_ERROR; | ||
2611 | 2067 | } | ||
2612 | 2068 | |||
2613 | 2069 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
2614 | 2070 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
2615 | 2071 | PTDEBUG && _d($dbh, ':', $sql); | ||
2616 | 2072 | eval { $dbh->do($sql) }; | ||
2617 | 2073 | if ( $EVAL_ERROR ) { | ||
2618 | 2074 | die $EVAL_ERROR; | ||
2619 | 2075 | } | ||
2620 | 2076 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
2621 | 2077 | if ( $charset eq 'utf8' ) { | ||
2622 | 2078 | binmode(STDOUT, ':utf8') | ||
2623 | 2079 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
2624 | 2080 | } | ||
2625 | 2081 | else { | ||
2626 | 2082 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
2627 | 2083 | } | ||
2628 | 2084 | } | ||
2629 | 2085 | |||
2630 | 2086 | if ( $self->prop('set-vars') ) { | ||
2631 | 2087 | $sql = "SET " . $self->prop('set-vars'); | ||
2632 | 2088 | PTDEBUG && _d($dbh, ':', $sql); | ||
2633 | 2089 | eval { $dbh->do($sql) }; | ||
2634 | 2090 | if ( $EVAL_ERROR ) { | ||
2635 | 2091 | die $EVAL_ERROR; | ||
2636 | 2092 | } | ||
2637 | 2093 | } | ||
2638 | 2094 | } | ||
2639 | 2095 | |||
2640 | 1484 | PTDEBUG && _d('DBH info: ', | 2096 | PTDEBUG && _d('DBH info: ', |
2641 | 1485 | $dbh, | 2097 | $dbh, |
2642 | 1486 | Dumper($dbh->selectrow_hashref( | 2098 | Dumper($dbh->selectrow_hashref( |
2643 | 1487 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), | 2099 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), |
2644 | 1488 | 'Connection info:', $dbh->{mysql_hostinfo}, | 2100 | 'Connection info:', $dbh->{mysql_hostinfo}, |
2645 | 1489 | 'Character set info:', Dumper($dbh->selectall_arrayref( | 2101 | 'Character set info:', Dumper($dbh->selectall_arrayref( |
2647 | 1490 | 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})), | 2102 | "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})), |
2648 | 1491 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, | 2103 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, |
2649 | 1492 | '$DBI::VERSION:', $DBI::VERSION, | 2104 | '$DBI::VERSION:', $DBI::VERSION, |
2650 | 1493 | ); | 2105 | ); |
2651 | @@ -1773,7 +2385,7 @@ | |||
2652 | 1773 | 2385 | ||
2653 | 1774 | # Some common patterns and variables | 2386 | # Some common patterns and variables |
2654 | 1775 | my $d = qr/(\d+)/; # Digit | 2387 | my $d = qr/(\d+)/; # Digit |
2656 | 1776 | my $t = qr/(\d+ \d+)/; # Transaction ID | 2388 | my $t = qr/((?:\d+ \d+)|(?:[A-Fa-f0-9]+))/; # Transaction ID |
2657 | 1777 | my $i = qr/((?:\d{1,3}\.){3}\d+)/; # IP address | 2389 | my $i = qr/((?:\d{1,3}\.){3}\d+)/; # IP address |
2658 | 1778 | my $n = qr/([^`\s]+)/; # MySQL object name | 2390 | my $n = qr/([^`\s]+)/; # MySQL object name |
2659 | 1779 | my $w = qr/(\w+)/; # Words | 2391 | my $w = qr/(\w+)/; # Words |
2660 | @@ -1816,7 +2428,6 @@ | |||
2661 | 1816 | @ARGV = @_; # set global ARGV for this package | 2428 | @ARGV = @_; # set global ARGV for this package |
2662 | 1817 | 2429 | ||
2663 | 1818 | my $q = new Quoter(); | 2430 | my $q = new Quoter(); |
2664 | 1819 | my $vp = new VersionParser(); | ||
2665 | 1820 | 2431 | ||
2666 | 1821 | # ######################################################################## | 2432 | # ######################################################################## |
2667 | 1822 | # Get configuration information. | 2433 | # Get configuration information. |
2668 | @@ -1969,7 +2580,7 @@ | |||
2669 | 1969 | $dbh->{AutoCommit} = 0; | 2580 | $dbh->{AutoCommit} = 0; |
2670 | 1970 | my $sql = $o->read_para_after(__FILE__, qr/MAGIC_clear_deadlocks/); | 2581 | my $sql = $o->read_para_after(__FILE__, qr/MAGIC_clear_deadlocks/); |
2671 | 1971 | 2582 | ||
2673 | 1972 | if ( !$vp->version_ge($dbh, '4.1.2') ) { | 2583 | if ( VersionParser->new($dbh) < '4.1.2') { |
2674 | 1973 | $sql =~ s/ENGINE=/TYPE=/; | 2584 | $sql =~ s/ENGINE=/TYPE=/; |
2675 | 1974 | } | 2585 | } |
2676 | 1975 | $sql =~ s/test.deadlock_maker/$db_tbl/; | 2586 | $sql =~ s/test.deadlock_maker/$db_tbl/; |
2677 | @@ -1987,7 +2598,7 @@ | |||
2678 | 1987 | PTDEBUG && _d($sql); | 2598 | PTDEBUG && _d($sql); |
2679 | 1988 | eval { $dbh_child->do($sql); }; # Should block against parent. | 2599 | eval { $dbh_child->do($sql); }; # Should block against parent. |
2680 | 1989 | PTDEBUG && _d($EVAL_ERROR); # Parent inserted value 0. | 2600 | PTDEBUG && _d($EVAL_ERROR); # Parent inserted value 0. |
2682 | 1990 | $sql = "DROP TABLE $db_tbl"; | 2601 | $sql = "COMMIT"; |
2683 | 1991 | PTDEBUG && _d($sql); | 2602 | PTDEBUG && _d($sql); |
2684 | 1992 | $dbh_child->do($sql); | 2603 | $dbh_child->do($sql); |
2685 | 1993 | exit; | 2604 | exit; |
2686 | @@ -2001,6 +2612,9 @@ | |||
2687 | 2001 | eval { $dbh->do($sql); }; | 2612 | eval { $dbh->do($sql); }; |
2688 | 2002 | PTDEBUG && _d($EVAL_ERROR); | 2613 | PTDEBUG && _d($EVAL_ERROR); |
2689 | 2003 | waitpid($pid, 0); | 2614 | waitpid($pid, 0); |
2690 | 2615 | $sql = "DROP TABLE $db_tbl"; | ||
2691 | 2616 | PTDEBUG && _d($sql); | ||
2692 | 2617 | $dbh->do($sql); | ||
2693 | 2004 | } | 2618 | } |
2694 | 2005 | 2619 | ||
2695 | 2006 | # If there's an --interval argument, run forever or till specified. | 2620 | # If there's an --interval argument, run forever or till specified. |
2696 | @@ -2030,6 +2644,7 @@ | |||
2697 | 2030 | while ( my ( $start, $name, $text, $end ) = splice(@matches, 0, 4) ) { | 2644 | while ( my ( $start, $name, $text, $end ) = splice(@matches, 0, 4) ) { |
2698 | 2031 | next unless $name eq 'LATEST DETECTED DEADLOCK'; | 2645 | next unless $name eq 'LATEST DETECTED DEADLOCK'; |
2699 | 2032 | $dl_text = $text; | 2646 | $dl_text = $text; |
2700 | 2647 | last; | ||
2701 | 2033 | } | 2648 | } |
2702 | 2034 | 2649 | ||
2703 | 2035 | return {} unless $dl_text; | 2650 | return {} unless $dl_text; |
2704 | @@ -2748,6 +3363,10 @@ | |||
2705 | 2748 | 3363 | ||
2706 | 2749 | =head1 VERSION | 3364 | =head1 VERSION |
2707 | 2750 | 3365 | ||
2708 | 3366 | <<<<<<< TREE | ||
2709 | 2751 | pt-deadlock-logger 2.0.5 | 3367 | pt-deadlock-logger 2.0.5 |
2710 | 3368 | ======= | ||
2711 | 3369 | pt-deadlock-logger 2.1.2 | ||
2712 | 3370 | >>>>>>> MERGE-SOURCE | ||
2713 | 2752 | 3371 | ||
2714 | 2753 | =cut | 3372 | =cut |
2715 | 2754 | 3373 | ||
2716 | === modified file 'bin/pt-diskstats' | |||
2717 | --- bin/pt-diskstats 2012-06-09 21:53:04 +0000 | |||
2718 | +++ bin/pt-diskstats 2012-07-20 22:10:28 +0000 | |||
2719 | @@ -6,7 +6,7 @@ | |||
2720 | 6 | 6 | ||
2721 | 7 | use strict; | 7 | use strict; |
2722 | 8 | use warnings FATAL => 'all'; | 8 | use warnings FATAL => 'all'; |
2724 | 9 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; | 9 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
2725 | 10 | 10 | ||
2726 | 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. |
2727 | 12 | BEGIN { | 12 | BEGIN { |
2728 | @@ -1058,6 +1058,7 @@ | |||
2729 | 1058 | 1058 | ||
2730 | 1059 | use Time::Local qw(timegm timelocal); | 1059 | use Time::Local qw(timegm timelocal); |
2731 | 1060 | use Digest::MD5 qw(md5_hex); | 1060 | use Digest::MD5 qw(md5_hex); |
2732 | 1061 | use B qw(); | ||
2733 | 1061 | 1062 | ||
2734 | 1062 | require Exporter; | 1063 | require Exporter; |
2735 | 1063 | our @ISA = qw(Exporter); | 1064 | our @ISA = qw(Exporter); |
2736 | @@ -1075,6 +1076,7 @@ | |||
2737 | 1075 | any_unix_timestamp | 1076 | any_unix_timestamp |
2738 | 1076 | make_checksum | 1077 | make_checksum |
2739 | 1077 | crc32 | 1078 | crc32 |
2740 | 1079 | encode_json | ||
2741 | 1078 | ); | 1080 | ); |
2742 | 1079 | 1081 | ||
2743 | 1080 | our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/; | 1082 | our $mysql_ts = qr/(\d\d)(\d\d)(\d\d) +(\d+):(\d+):(\d+)(\.\d+)?/; |
2744 | @@ -1282,6 +1284,96 @@ | |||
2745 | 1282 | return $crc ^ 0xFFFFFFFF; | 1284 | return $crc ^ 0xFFFFFFFF; |
2746 | 1283 | } | 1285 | } |
2747 | 1284 | 1286 | ||
2748 | 1287 | my $got_json = eval { require JSON }; | ||
2749 | 1288 | sub encode_json { | ||
2750 | 1289 | return JSON::encode_json(@_) if $got_json; | ||
2751 | 1290 | my ( $data ) = @_; | ||
2752 | 1291 | return (object_to_json($data) || ''); | ||
2753 | 1292 | } | ||
2754 | 1293 | |||
2755 | 1294 | |||
2756 | 1295 | sub object_to_json { | ||
2757 | 1296 | my ($obj) = @_; | ||
2758 | 1297 | my $type = ref($obj); | ||
2759 | 1298 | |||
2760 | 1299 | if($type eq 'HASH'){ | ||
2761 | 1300 | return hash_to_json($obj); | ||
2762 | 1301 | } | ||
2763 | 1302 | elsif($type eq 'ARRAY'){ | ||
2764 | 1303 | return array_to_json($obj); | ||
2765 | 1304 | } | ||
2766 | 1305 | else { | ||
2767 | 1306 | return value_to_json($obj); | ||
2768 | 1307 | } | ||
2769 | 1308 | } | ||
2770 | 1309 | |||
2771 | 1310 | sub hash_to_json { | ||
2772 | 1311 | my ($obj) = @_; | ||
2773 | 1312 | my @res; | ||
2774 | 1313 | for my $k ( sort { $a cmp $b } keys %$obj ) { | ||
2775 | 1314 | push @res, string_to_json( $k ) | ||
2776 | 1315 | . ":" | ||
2777 | 1316 | . ( object_to_json( $obj->{$k} ) || value_to_json( $obj->{$k} ) ); | ||
2778 | 1317 | } | ||
2779 | 1318 | return '{' . ( @res ? join( ",", @res ) : '' ) . '}'; | ||
2780 | 1319 | } | ||
2781 | 1320 | |||
2782 | 1321 | sub array_to_json { | ||
2783 | 1322 | my ($obj) = @_; | ||
2784 | 1323 | my @res; | ||
2785 | 1324 | |||
2786 | 1325 | for my $v (@$obj) { | ||
2787 | 1326 | push @res, object_to_json($v) || value_to_json($v); | ||
2788 | 1327 | } | ||
2789 | 1328 | |||
2790 | 1329 | return '[' . ( @res ? join( ",", @res ) : '' ) . ']'; | ||
2791 | 1330 | } | ||
2792 | 1331 | |||
2793 | 1332 | sub value_to_json { | ||
2794 | 1333 | my ($value) = @_; | ||
2795 | 1334 | |||
2796 | 1335 | return 'null' if(!defined $value); | ||
2797 | 1336 | |||
2798 | 1337 | my $b_obj = B::svref_2object(\$value); # for round trip problem | ||
2799 | 1338 | my $flags = $b_obj->FLAGS; | ||
2800 | 1339 | return $value # as is | ||
2801 | 1340 | if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? | ||
2802 | 1341 | |||
2803 | 1342 | my $type = ref($value); | ||
2804 | 1343 | |||
2805 | 1344 | if( !$type ) { | ||
2806 | 1345 | return string_to_json($value); | ||
2807 | 1346 | } | ||
2808 | 1347 | else { | ||
2809 | 1348 | return 'null'; | ||
2810 | 1349 | } | ||
2811 | 1350 | |||
2812 | 1351 | } | ||
2813 | 1352 | |||
2814 | 1353 | my %esc = ( | ||
2815 | 1354 | "\n" => '\n', | ||
2816 | 1355 | "\r" => '\r', | ||
2817 | 1356 | "\t" => '\t', | ||
2818 | 1357 | "\f" => '\f', | ||
2819 | 1358 | "\b" => '\b', | ||
2820 | 1359 | "\"" => '\"', | ||
2821 | 1360 | "\\" => '\\\\', | ||
2822 | 1361 | "\'" => '\\\'', | ||
2823 | 1362 | ); | ||
2824 | 1363 | |||
2825 | 1364 | sub string_to_json { | ||
2826 | 1365 | my ($arg) = @_; | ||
2827 | 1366 | |||
2828 | 1367 | $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g; | ||
2829 | 1368 | $arg =~ s/\//\\\//g; | ||
2830 | 1369 | $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg; | ||
2831 | 1370 | |||
2832 | 1371 | utf8::upgrade($arg); | ||
2833 | 1372 | utf8::encode($arg); | ||
2834 | 1373 | |||
2835 | 1374 | return '"' . $arg . '"'; | ||
2836 | 1375 | } | ||
2837 | 1376 | |||
2838 | 1285 | sub _d { | 1377 | sub _d { |
2839 | 1286 | my ($package, undef, $line) = caller 0; | 1378 | my ($package, undef, $line) = caller 0; |
2840 | 1287 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 1379 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
2841 | @@ -1319,9 +1411,10 @@ | |||
2842 | 1319 | use warnings; | 1411 | use warnings; |
2843 | 1320 | use strict; | 1412 | use strict; |
2844 | 1321 | use English qw(-no_match_vars); | 1413 | use English qw(-no_match_vars); |
2846 | 1322 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; | 1414 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
2847 | 1323 | 1415 | ||
2848 | 1324 | use POSIX qw( :termios_h ); | 1416 | use POSIX qw( :termios_h ); |
2849 | 1417 | use Fcntl qw( F_SETFL F_GETFL ); | ||
2850 | 1325 | 1418 | ||
2851 | 1326 | use base qw( Exporter ); | 1419 | use base qw( Exporter ); |
2852 | 1327 | 1420 | ||
2853 | @@ -1344,8 +1437,12 @@ | |||
2854 | 1344 | # This primarily comes from the Perl Cookbook, recipe 15.8 | 1437 | # This primarily comes from the Perl Cookbook, recipe 15.8 |
2855 | 1345 | 1438 | ||
2856 | 1346 | { | 1439 | { |
2857 | 1347 | |||
2858 | 1348 | my $fd_stdin = fileno(STDIN); | 1440 | my $fd_stdin = fileno(STDIN); |
2859 | 1441 | my $flags; | ||
2860 | 1442 | unless ( $PerconaTest::DONT_RESTORE_STDIN ) { | ||
2861 | 1443 | $flags = fcntl(STDIN, F_GETFL, 0) | ||
2862 | 1444 | or die "can't fcntl F_GETFL: $!"; | ||
2863 | 1445 | } | ||
2864 | 1349 | my $term = POSIX::Termios->new(); | 1446 | my $term = POSIX::Termios->new(); |
2865 | 1350 | $term->getattr($fd_stdin); | 1447 | $term->getattr($fd_stdin); |
2866 | 1351 | my $oterm = $term->getlflag(); | 1448 | my $oterm = $term->getlflag(); |
2867 | @@ -1376,6 +1473,10 @@ | |||
2868 | 1376 | $term->setlflag($oterm); | 1473 | $term->setlflag($oterm); |
2869 | 1377 | $term->setcc( VTIME, 0 ); | 1474 | $term->setcc( VTIME, 0 ); |
2870 | 1378 | $term->setattr( $fd_stdin, TCSANOW ); | 1475 | $term->setattr( $fd_stdin, TCSANOW ); |
2871 | 1476 | unless ( $PerconaTest::DONT_RESTORE_STDIN ) { | ||
2872 | 1477 | fcntl(STDIN, F_SETFL, $flags) | ||
2873 | 1478 | or die "can't fcntl F_SETFL: $!"; | ||
2874 | 1479 | } | ||
2875 | 1379 | } | 1480 | } |
2876 | 1380 | 1481 | ||
2877 | 1381 | END { cooked() } | 1482 | END { cooked() } |
2878 | @@ -2480,7 +2581,7 @@ | |||
2879 | 2480 | use warnings; | 2581 | use warnings; |
2880 | 2481 | use strict; | 2582 | use strict; |
2881 | 2482 | use English qw(-no_match_vars); | 2583 | use English qw(-no_match_vars); |
2883 | 2483 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; | 2584 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
2884 | 2484 | 2585 | ||
2885 | 2485 | use base qw( Diskstats ); | 2586 | use base qw( Diskstats ); |
2886 | 2486 | 2587 | ||
2887 | @@ -2553,7 +2654,7 @@ | |||
2888 | 2553 | use warnings; | 2654 | use warnings; |
2889 | 2554 | use strict; | 2655 | use strict; |
2890 | 2555 | use English qw(-no_match_vars); | 2656 | use English qw(-no_match_vars); |
2892 | 2556 | use constant MKDEBUG => $ENV{MKDEBUG} || 0; | 2657 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
2893 | 2557 | 2658 | ||
2894 | 2558 | use base qw( Diskstats ); | 2659 | use base qw( Diskstats ); |
2895 | 2559 | 2660 | ||
2896 | @@ -3407,7 +3508,7 @@ | |||
2897 | 3407 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | 3508 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
2898 | 3408 | 3509 | ||
2899 | 3409 | sub main { | 3510 | sub main { |
2901 | 3410 | @ARGV = @_; # set global ARGV for this package | 3511 | local @ARGV = @_; # set global ARGV for this package |
2902 | 3411 | 3512 | ||
2903 | 3412 | # ######################################################################## | 3513 | # ######################################################################## |
2904 | 3413 | # Get configuration information. | 3514 | # Get configuration information. |
2905 | @@ -4106,6 +4207,10 @@ | |||
2906 | 4106 | 4207 | ||
2907 | 4107 | =head1 VERSION | 4208 | =head1 VERSION |
2908 | 4108 | 4209 | ||
2909 | 4210 | <<<<<<< TREE | ||
2910 | 4109 | pt-diskstats 2.0.5 | 4211 | pt-diskstats 2.0.5 |
2911 | 4212 | ======= | ||
2912 | 4213 | pt-diskstats 2.1.2 | ||
2913 | 4214 | >>>>>>> MERGE-SOURCE | ||
2914 | 4110 | 4215 | ||
2915 | 4111 | =cut | 4216 | =cut |
2916 | 4112 | 4217 | ||
2917 | === modified file 'bin/pt-duplicate-key-checker' | |||
2918 | --- bin/pt-duplicate-key-checker 2012-06-09 21:53:04 +0000 | |||
2919 | +++ bin/pt-duplicate-key-checker 2012-07-20 22:10:28 +0000 | |||
2920 | @@ -9,89 +9,6 @@ | |||
2921 | 9 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | 9 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; |
2922 | 10 | 10 | ||
2923 | 11 | # ########################################################################### | 11 | # ########################################################################### |
2924 | 12 | # VersionParser package | ||
2925 | 13 | # This package is a copy without comments from the original. The original | ||
2926 | 14 | # with comments and its test file can be found in the Bazaar repository at, | ||
2927 | 15 | # lib/VersionParser.pm | ||
2928 | 16 | # t/lib/VersionParser.t | ||
2929 | 17 | # See https://launchpad.net/percona-toolkit for more information. | ||
2930 | 18 | # ########################################################################### | ||
2931 | 19 | { | ||
2932 | 20 | package VersionParser; | ||
2933 | 21 | |||
2934 | 22 | use strict; | ||
2935 | 23 | use warnings FATAL => 'all'; | ||
2936 | 24 | use English qw(-no_match_vars); | ||
2937 | 25 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
2938 | 26 | |||
2939 | 27 | sub new { | ||
2940 | 28 | my ( $class ) = @_; | ||
2941 | 29 | bless {}, $class; | ||
2942 | 30 | } | ||
2943 | 31 | |||
2944 | 32 | sub parse { | ||
2945 | 33 | my ( $self, $str ) = @_; | ||
2946 | 34 | my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); | ||
2947 | 35 | PTDEBUG && _d($str, 'parses to', $result); | ||
2948 | 36 | return $result; | ||
2949 | 37 | } | ||
2950 | 38 | |||
2951 | 39 | sub version_ge { | ||
2952 | 40 | my ( $self, $dbh, $target ) = @_; | ||
2953 | 41 | if ( !$self->{$dbh} ) { | ||
2954 | 42 | $self->{$dbh} = $self->parse( | ||
2955 | 43 | $dbh->selectrow_array('SELECT VERSION()')); | ||
2956 | 44 | } | ||
2957 | 45 | my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; | ||
2958 | 46 | PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); | ||
2959 | 47 | return $result; | ||
2960 | 48 | } | ||
2961 | 49 | |||
2962 | 50 | sub innodb_version { | ||
2963 | 51 | my ( $self, $dbh ) = @_; | ||
2964 | 52 | return unless $dbh; | ||
2965 | 53 | my $innodb_version = "NO"; | ||
2966 | 54 | |||
2967 | 55 | my ($innodb) = | ||
2968 | 56 | grep { $_->{engine} =~ m/InnoDB/i } | ||
2969 | 57 | map { | ||
2970 | 58 | my %hash; | ||
2971 | 59 | @hash{ map { lc $_ } keys %$_ } = values %$_; | ||
2972 | 60 | \%hash; | ||
2973 | 61 | } | ||
2974 | 62 | @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; | ||
2975 | 63 | if ( $innodb ) { | ||
2976 | 64 | PTDEBUG && _d("InnoDB support:", $innodb->{support}); | ||
2977 | 65 | if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { | ||
2978 | 66 | my $vars = $dbh->selectrow_hashref( | ||
2979 | 67 | "SHOW VARIABLES LIKE 'innodb_version'"); | ||
2980 | 68 | $innodb_version = !$vars ? "BUILTIN" | ||
2981 | 69 | : ($vars->{Value} || $vars->{value}); | ||
2982 | 70 | } | ||
2983 | 71 | else { | ||
2984 | 72 | $innodb_version = $innodb->{support}; # probably DISABLED or NO | ||
2985 | 73 | } | ||
2986 | 74 | } | ||
2987 | 75 | |||
2988 | 76 | PTDEBUG && _d("InnoDB version:", $innodb_version); | ||
2989 | 77 | return $innodb_version; | ||
2990 | 78 | } | ||
2991 | 79 | |||
2992 | 80 | sub _d { | ||
2993 | 81 | my ($package, undef, $line) = caller 0; | ||
2994 | 82 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
2995 | 83 | map { defined $_ ? $_ : 'undef' } | ||
2996 | 84 | @_; | ||
2997 | 85 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
2998 | 86 | } | ||
2999 | 87 | |||
3000 | 88 | 1; | ||
3001 | 89 | } | ||
3002 | 90 | # ########################################################################### | ||
3003 | 91 | # End VersionParser package | ||
3004 | 92 | # ########################################################################### | ||
3005 | 93 | |||
3006 | 94 | # ########################################################################### | ||
3007 | 95 | # Quoter package | 12 | # Quoter package |
3008 | 96 | # This package is a copy without comments from the original. The original | 13 | # This package is a copy without comments from the original. The original |
3009 | 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, |
3010 | @@ -162,6 +79,48 @@ | |||
3011 | 162 | return $db ? "$db.$tbl" : $tbl; | 79 | return $db ? "$db.$tbl" : $tbl; |
3012 | 163 | } | 80 | } |
3013 | 164 | 81 | ||
3014 | 82 | sub serialize_list { | ||
3015 | 83 | my ( $self, @args ) = @_; | ||
3016 | 84 | return unless @args; | ||
3017 | 85 | |||
3018 | 86 | return $args[0] if @args == 1 && !defined $args[0]; | ||
3019 | 87 | |||
3020 | 88 | die "Cannot serialize multiple values with undef/NULL" | ||
3021 | 89 | if grep { !defined $_ } @args; | ||
3022 | 90 | |||
3023 | 91 | return join ',', map { quotemeta } @args; | ||
3024 | 92 | } | ||
3025 | 93 | |||
3026 | 94 | sub deserialize_list { | ||
3027 | 95 | my ( $self, $string ) = @_; | ||
3028 | 96 | return $string unless defined $string; | ||
3029 | 97 | my @escaped_parts = $string =~ / | ||
3030 | 98 | \G # Start of string, or end of previous match. | ||
3031 | 99 | ( # Each of these is an element in the original list. | ||
3032 | 100 | [^\\,]* # Anything not a backslash or a comma | ||
3033 | 101 | (?: # When we get here, we found one of the above. | ||
3034 | 102 | \\. # A backslash followed by something so we can continue | ||
3035 | 103 | [^\\,]* # Same as above. | ||
3036 | 104 | )* # Repeat zero of more times. | ||
3037 | 105 | ) | ||
3038 | 106 | , # Comma dividing elements | ||
3039 | 107 | /sxgc; | ||
3040 | 108 | |||
3041 | 109 | push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string; | ||
3042 | 110 | |||
3043 | 111 | my @unescaped_parts = map { | ||
3044 | 112 | my $part = $_; | ||
3045 | 113 | |||
3046 | 114 | my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string, | ||
3047 | 115 | ? qr/(?=\p{ASCII})\W/ # We only care about non-word | ||
3048 | 116 | : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise, | ||
3049 | 117 | $part =~ s/\\($char_class)/$1/g; | ||
3050 | 118 | $part; | ||
3051 | 119 | } @escaped_parts; | ||
3052 | 120 | |||
3053 | 121 | return @unescaped_parts; | ||
3054 | 122 | } | ||
3055 | 123 | |||
3056 | 165 | 1; | 124 | 1; |
3057 | 166 | } | 125 | } |
3058 | 167 | # ########################################################################### | 126 | # ########################################################################### |
3059 | @@ -199,23 +158,64 @@ | |||
3060 | 199 | return bless $self, $class; | 158 | return bless $self, $class; |
3061 | 200 | } | 159 | } |
3062 | 201 | 160 | ||
3063 | 161 | sub get_create_table { | ||
3064 | 162 | my ( $self, $dbh, $db, $tbl ) = @_; | ||
3065 | 163 | die "I need a dbh parameter" unless $dbh; | ||
3066 | 164 | die "I need a db parameter" unless $db; | ||
3067 | 165 | die "I need a tbl parameter" unless $tbl; | ||
3068 | 166 | my $q = $self->{Quoter}; | ||
3069 | 167 | |||
3070 | 168 | my $new_sql_mode | ||
3071 | 169 | = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
3072 | 170 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
3073 | 171 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
3074 | 172 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
3075 | 173 | |||
3076 | 174 | my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
3077 | 175 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
3078 | 176 | |||
3079 | 177 | PTDEBUG && _d($new_sql_mode); | ||
3080 | 178 | eval { $dbh->do($new_sql_mode); }; | ||
3081 | 179 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
3082 | 180 | |||
3083 | 181 | my $use_sql = 'USE ' . $q->quote($db); | ||
3084 | 182 | PTDEBUG && _d($dbh, $use_sql); | ||
3085 | 183 | $dbh->do($use_sql); | ||
3086 | 184 | |||
3087 | 185 | my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl); | ||
3088 | 186 | PTDEBUG && _d($show_sql); | ||
3089 | 187 | my $href; | ||
3090 | 188 | eval { $href = $dbh->selectrow_hashref($show_sql); }; | ||
3091 | 189 | if ( $EVAL_ERROR ) { | ||
3092 | 190 | PTDEBUG && _d($EVAL_ERROR); | ||
3093 | 191 | |||
3094 | 192 | PTDEBUG && _d($old_sql_mode); | ||
3095 | 193 | $dbh->do($old_sql_mode); | ||
3096 | 194 | |||
3097 | 195 | return; | ||
3098 | 196 | } | ||
3099 | 197 | |||
3100 | 198 | PTDEBUG && _d($old_sql_mode); | ||
3101 | 199 | $dbh->do($old_sql_mode); | ||
3102 | 200 | |||
3103 | 201 | my ($key) = grep { m/create (?:table|view)/i } keys %$href; | ||
3104 | 202 | if ( !$key ) { | ||
3105 | 203 | die "Error: no 'Create Table' or 'Create View' in result set from " | ||
3106 | 204 | . "$show_sql: " . Dumper($href); | ||
3107 | 205 | } | ||
3108 | 206 | |||
3109 | 207 | return $href->{$key}; | ||
3110 | 208 | } | ||
3111 | 209 | |||
3112 | 202 | sub parse { | 210 | sub parse { |
3113 | 203 | my ( $self, $ddl, $opts ) = @_; | 211 | my ( $self, $ddl, $opts ) = @_; |
3114 | 204 | return unless $ddl; | 212 | return unless $ddl; |
3124 | 205 | if ( ref $ddl eq 'ARRAY' ) { | 213 | |
3125 | 206 | if ( lc $ddl->[0] eq 'table' ) { | 214 | if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) { |
3126 | 207 | $ddl = $ddl->[1]; | 215 | $ddl = $self->ansi_to_legacy($ddl); |
3118 | 208 | } | ||
3119 | 209 | else { | ||
3120 | 210 | return { | ||
3121 | 211 | engine => 'VIEW', | ||
3122 | 212 | }; | ||
3123 | 213 | } | ||
3127 | 214 | } | 216 | } |
3132 | 215 | 217 | elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { | |
3133 | 216 | if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { | 218 | die "TableParser doesn't handle CREATE TABLE without quoting."; |
3130 | 217 | die "Cannot parse table definition; is ANSI quoting " | ||
3131 | 218 | . "enabled or SQL_QUOTE_SHOW_CREATE disabled?"; | ||
3134 | 219 | } | 219 | } |
3135 | 220 | 220 | ||
3136 | 221 | my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; | 221 | my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; |
3137 | @@ -424,19 +424,13 @@ | |||
3138 | 424 | my $key_ddl = $key; | 424 | my $key_ddl = $key; |
3139 | 425 | PTDEBUG && _d('Parsed key:', $key_ddl); | 425 | PTDEBUG && _d('Parsed key:', $key_ddl); |
3140 | 426 | 426 | ||
3142 | 427 | if ( $engine !~ m/MEMORY|HEAP/ ) { | 427 | if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) { |
3143 | 428 | $key =~ s/USING HASH/USING BTREE/; | 428 | $key =~ s/USING HASH/USING BTREE/; |
3144 | 429 | } | 429 | } |
3145 | 430 | 430 | ||
3146 | 431 | my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; | 431 | my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; |
3147 | 432 | my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; | 432 | my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; |
3148 | 433 | $type = $type || $special || 'BTREE'; | 433 | $type = $type || $special || 'BTREE'; |
3149 | 434 | if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000' | ||
3150 | 435 | && $engine =~ m/HEAP|MEMORY/i ) | ||
3151 | 436 | { | ||
3152 | 437 | $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP | ||
3153 | 438 | } | ||
3154 | 439 | |||
3155 | 440 | my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; | 434 | my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; |
3156 | 441 | my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; | 435 | my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; |
3157 | 442 | my @cols; | 436 | my @cols; |
3158 | @@ -462,7 +456,7 @@ | |||
3159 | 462 | ddl => $key_ddl, | 456 | ddl => $key_ddl, |
3160 | 463 | }; | 457 | }; |
3161 | 464 | 458 | ||
3163 | 465 | if ( $engine =~ m/InnoDB/i && !$clustered_key ) { | 459 | if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) { |
3164 | 466 | my $this_key = $keys->{$name}; | 460 | my $this_key = $keys->{$name}; |
3165 | 467 | if ( $this_key->{name} eq 'PRIMARY' ) { | 461 | if ( $this_key->{name} eq 'PRIMARY' ) { |
3166 | 468 | $clustered_key = 'PRIMARY'; | 462 | $clustered_key = 'PRIMARY'; |
3167 | @@ -518,41 +512,46 @@ | |||
3168 | 518 | return $ddl; | 512 | return $ddl; |
3169 | 519 | } | 513 | } |
3170 | 520 | 514 | ||
3206 | 521 | sub remove_secondary_indexes { | 515 | sub get_table_status { |
3207 | 522 | my ( $self, $ddl ) = @_; | 516 | my ( $self, $dbh, $db, $like ) = @_; |
3208 | 523 | my $sec_indexes_ddl; | 517 | my $q = $self->{Quoter}; |
3209 | 524 | my $tbl_struct = $self->parse($ddl); | 518 | my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db); |
3210 | 525 | 519 | my @params; | |
3211 | 526 | if ( ($tbl_struct->{engine} || '') =~ m/InnoDB/i ) { | 520 | if ( $like ) { |
3212 | 527 | my $clustered_key = $tbl_struct->{clustered_key}; | 521 | $sql .= ' LIKE ?'; |
3213 | 528 | $clustered_key ||= ''; | 522 | push @params, $like; |
3214 | 529 | 523 | } | |
3215 | 530 | my @sec_indexes = map { | 524 | PTDEBUG && _d($sql, @params); |
3216 | 531 | my $key_def = $_->{ddl}; | 525 | my $sth = $dbh->prepare($sql); |
3217 | 532 | $key_def =~ s/([\(\)])/\\$1/g; | 526 | eval { $sth->execute(@params); }; |
3218 | 533 | $ddl =~ s/\s+$key_def//i; | 527 | if ($EVAL_ERROR) { |
3219 | 534 | 528 | PTDEBUG && _d($EVAL_ERROR); | |
3220 | 535 | my $key_ddl = "ADD $_->{ddl}"; | 529 | return; |
3221 | 536 | $key_ddl .= ',' unless $key_ddl =~ m/,$/; | 530 | } |
3222 | 537 | $key_ddl; | 531 | my @tables = @{$sth->fetchall_arrayref({})}; |
3223 | 538 | } | 532 | @tables = map { |
3224 | 539 | grep { $_->{name} ne $clustered_key } | 533 | my %tbl; # Make a copy with lowercased keys |
3225 | 540 | values %{$tbl_struct->{keys}}; | 534 | @tbl{ map { lc $_ } keys %$_ } = values %$_; |
3226 | 541 | PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); | 535 | $tbl{engine} ||= $tbl{type} || $tbl{comment}; |
3227 | 542 | 536 | delete $tbl{type}; | |
3228 | 543 | if ( @sec_indexes ) { | 537 | \%tbl; |
3229 | 544 | $sec_indexes_ddl = join(' ', @sec_indexes); | 538 | } @tables; |
3230 | 545 | $sec_indexes_ddl =~ s/,$//; | 539 | return @tables; |
3231 | 546 | } | 540 | } |
3232 | 547 | 541 | ||
3233 | 548 | $ddl =~ s/,(\n\) )/$1/s; | 542 | my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx; |
3234 | 549 | } | 543 | sub ansi_to_legacy { |
3235 | 550 | else { | 544 | my ($self, $ddl) = @_; |
3236 | 551 | PTDEBUG && _d('Not removing secondary indexes from', | 545 | $ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge; |
3237 | 552 | $tbl_struct->{engine}, 'table'); | 546 | return $ddl; |
3238 | 553 | } | 547 | } |
3239 | 554 | 548 | ||
3240 | 555 | return $ddl, $sec_indexes_ddl, $tbl_struct; | 549 | sub ansi_quote_replace { |
3241 | 550 | my ($val) = @_; | ||
3242 | 551 | $val =~ s/^"|"$//g; | ||
3243 | 552 | $val =~ s/`/``/g; | ||
3244 | 553 | $val =~ s/""/"/g; | ||
3245 | 554 | return "`$val`"; | ||
3246 | 556 | } | 555 | } |
3247 | 557 | 556 | ||
3248 | 558 | sub _d { | 557 | sub _d { |
3249 | @@ -570,311 +569,6 @@ | |||
3250 | 570 | # ########################################################################### | 569 | # ########################################################################### |
3251 | 571 | 570 | ||
3252 | 572 | # ########################################################################### | 571 | # ########################################################################### |
3253 | 573 | # MySQLDump package | ||
3254 | 574 | # This package is a copy without comments from the original. The original | ||
3255 | 575 | # with comments and its test file can be found in the Bazaar repository at, | ||
3256 | 576 | # lib/MySQLDump.pm | ||
3257 | 577 | # t/lib/MySQLDump.t | ||
3258 | 578 | # See https://launchpad.net/percona-toolkit for more information. | ||
3259 | 579 | # ########################################################################### | ||
3260 | 580 | { | ||
3261 | 581 | package MySQLDump; | ||
3262 | 582 | |||
3263 | 583 | use strict; | ||
3264 | 584 | use warnings FATAL => 'all'; | ||
3265 | 585 | use English qw(-no_match_vars); | ||
3266 | 586 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
3267 | 587 | |||
3268 | 588 | ( our $before = <<'EOF') =~ s/^ //gm; | ||
3269 | 589 | /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; | ||
3270 | 590 | /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */; | ||
3271 | 591 | /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */; | ||
3272 | 592 | /*!40101 SET NAMES utf8 */; | ||
3273 | 593 | /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */; | ||
3274 | 594 | /*!40103 SET TIME_ZONE='+00:00' */; | ||
3275 | 595 | /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */; | ||
3276 | 596 | /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */; | ||
3277 | 597 | /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */; | ||
3278 | 598 | /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */; | ||
3279 | 599 | EOF | ||
3280 | 600 | |||
3281 | 601 | ( our $after = <<'EOF') =~ s/^ //gm; | ||
3282 | 602 | /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; | ||
3283 | 603 | /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; | ||
3284 | 604 | /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; | ||
3285 | 605 | /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */; | ||
3286 | 606 | /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */; | ||
3287 | 607 | /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */; | ||
3288 | 608 | /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */; | ||
3289 | 609 | /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */; | ||
3290 | 610 | EOF | ||
3291 | 611 | |||
3292 | 612 | sub new { | ||
3293 | 613 | my ( $class, %args ) = @_; | ||
3294 | 614 | my $self = { | ||
3295 | 615 | cache => 0, # Afaik no script uses this cache any longer because | ||
3296 | 616 | }; | ||
3297 | 617 | return bless $self, $class; | ||
3298 | 618 | } | ||
3299 | 619 | |||
3300 | 620 | sub dump { | ||
3301 | 621 | my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_; | ||
3302 | 622 | |||
3303 | 623 | if ( $what eq 'table' ) { | ||
3304 | 624 | my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); | ||
3305 | 625 | return unless $ddl; | ||
3306 | 626 | if ( $ddl->[0] eq 'table' ) { | ||
3307 | 627 | return $before | ||
3308 | 628 | . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" | ||
3309 | 629 | . $ddl->[1] . ";\n"; | ||
3310 | 630 | } | ||
3311 | 631 | else { | ||
3312 | 632 | return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" | ||
3313 | 633 | . '/*!50001 DROP VIEW IF EXISTS ' | ||
3314 | 634 | . $quoter->quote($tbl) . "*/;\n/*!50001 " | ||
3315 | 635 | . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n"; | ||
3316 | 636 | } | ||
3317 | 637 | } | ||
3318 | 638 | elsif ( $what eq 'triggers' ) { | ||
3319 | 639 | my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl); | ||
3320 | 640 | if ( $trgs && @$trgs ) { | ||
3321 | 641 | my $result = $before . "\nDELIMITER ;;\n"; | ||
3322 | 642 | foreach my $trg ( @$trgs ) { | ||
3323 | 643 | if ( $trg->{sql_mode} ) { | ||
3324 | 644 | $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n}; | ||
3325 | 645 | } | ||
3326 | 646 | $result .= "/*!50003 CREATE */ "; | ||
3327 | 647 | if ( $trg->{definer} ) { | ||
3328 | 648 | my ( $user, $host ) | ||
3329 | 649 | = map { s/'/''/g; "'$_'"; } | ||
3330 | 650 | split('@', $trg->{definer}, 2); | ||
3331 | 651 | $result .= "/*!50017 DEFINER=$user\@$host */ "; | ||
3332 | 652 | } | ||
3333 | 653 | $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n", | ||
3334 | 654 | $quoter->quote($trg->{trigger}), | ||
3335 | 655 | @{$trg}{qw(timing event)}, | ||
3336 | 656 | $quoter->quote($trg->{table}), | ||
3337 | 657 | $trg->{statement}); | ||
3338 | 658 | } | ||
3339 | 659 | $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n"; | ||
3340 | 660 | return $result; | ||
3341 | 661 | } | ||
3342 | 662 | else { | ||
3343 | 663 | return undef; | ||
3344 | 664 | } | ||
3345 | 665 | } | ||
3346 | 666 | elsif ( $what eq 'view' ) { | ||
3347 | 667 | my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); | ||
3348 | 668 | return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" | ||
3349 | 669 | . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" | ||
3350 | 670 | . '/*!50001 ' . $ddl->[1] . "*/;\n"; | ||
3351 | 671 | } | ||
3352 | 672 | else { | ||
3353 | 673 | die "You didn't say what to dump."; | ||
3354 | 674 | } | ||
3355 | 675 | } | ||
3356 | 676 | |||
3357 | 677 | sub _use_db { | ||
3358 | 678 | my ( $self, $dbh, $quoter, $new ) = @_; | ||
3359 | 679 | if ( !$new ) { | ||
3360 | 680 | PTDEBUG && _d('No new DB to use'); | ||
3361 | 681 | return; | ||
3362 | 682 | } | ||
3363 | 683 | my $sql = 'USE ' . $quoter->quote($new); | ||
3364 | 684 | PTDEBUG && _d($dbh, $sql); | ||
3365 | 685 | $dbh->do($sql); | ||
3366 | 686 | return; | ||
3367 | 687 | } | ||
3368 | 688 | |||
3369 | 689 | sub get_create_table { | ||
3370 | 690 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
3371 | 691 | if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) { | ||
3372 | 692 | my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
3373 | 693 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
3374 | 694 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
3375 | 695 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
3376 | 696 | PTDEBUG && _d($sql); | ||
3377 | 697 | eval { $dbh->do($sql); }; | ||
3378 | 698 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
3379 | 699 | $self->_use_db($dbh, $quoter, $db); | ||
3380 | 700 | $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); | ||
3381 | 701 | PTDEBUG && _d($sql); | ||
3382 | 702 | my $href; | ||
3383 | 703 | eval { $href = $dbh->selectrow_hashref($sql); }; | ||
3384 | 704 | if ( $EVAL_ERROR ) { | ||
3385 | 705 | warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR"; | ||
3386 | 706 | return; | ||
3387 | 707 | } | ||
3388 | 708 | |||
3389 | 709 | $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
3390 | 710 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
3391 | 711 | PTDEBUG && _d($sql); | ||
3392 | 712 | $dbh->do($sql); | ||
3393 | 713 | my ($key) = grep { m/create table/i } keys %$href; | ||
3394 | 714 | if ( $key ) { | ||
3395 | 715 | PTDEBUG && _d('This table is a base table'); | ||
3396 | 716 | $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; | ||
3397 | 717 | } | ||
3398 | 718 | else { | ||
3399 | 719 | PTDEBUG && _d('This table is a view'); | ||
3400 | 720 | ($key) = grep { m/create view/i } keys %$href; | ||
3401 | 721 | $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; | ||
3402 | 722 | } | ||
3403 | 723 | } | ||
3404 | 724 | return $self->{tables}->{$db}->{$tbl}; | ||
3405 | 725 | } | ||
3406 | 726 | |||
3407 | 727 | sub get_columns { | ||
3408 | 728 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
3409 | 729 | PTDEBUG && _d('Get columns for', $db, $tbl); | ||
3410 | 730 | if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { | ||
3411 | 731 | $self->_use_db($dbh, $quoter, $db); | ||
3412 | 732 | my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); | ||
3413 | 733 | PTDEBUG && _d($sql); | ||
3414 | 734 | my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); | ||
3415 | 735 | |||
3416 | 736 | $self->{columns}->{$db}->{$tbl} = [ | ||
3417 | 737 | map { | ||
3418 | 738 | my %row; | ||
3419 | 739 | @row{ map { lc $_ } keys %$_ } = values %$_; | ||
3420 | 740 | \%row; | ||
3421 | 741 | } @$cols | ||
3422 | 742 | ]; | ||
3423 | 743 | } | ||
3424 | 744 | return $self->{columns}->{$db}->{$tbl}; | ||
3425 | 745 | } | ||
3426 | 746 | |||
3427 | 747 | sub get_tmp_table { | ||
3428 | 748 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
3429 | 749 | my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n"; | ||
3430 | 750 | $result .= join(",\n", | ||
3431 | 751 | map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } | ||
3432 | 752 | @{$self->get_columns($dbh, $quoter, $db, $tbl)}); | ||
3433 | 753 | $result .= "\n)"; | ||
3434 | 754 | PTDEBUG && _d($result); | ||
3435 | 755 | return $result; | ||
3436 | 756 | } | ||
3437 | 757 | |||
3438 | 758 | sub get_triggers { | ||
3439 | 759 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
3440 | 760 | if ( !$self->{cache} || !$self->{triggers}->{$db} ) { | ||
3441 | 761 | $self->{triggers}->{$db} = {}; | ||
3442 | 762 | my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
3443 | 763 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
3444 | 764 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
3445 | 765 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
3446 | 766 | PTDEBUG && _d($sql); | ||
3447 | 767 | eval { $dbh->do($sql); }; | ||
3448 | 768 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
3449 | 769 | $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); | ||
3450 | 770 | PTDEBUG && _d($sql); | ||
3451 | 771 | my $sth = $dbh->prepare($sql); | ||
3452 | 772 | $sth->execute(); | ||
3453 | 773 | if ( $sth->rows ) { | ||
3454 | 774 | my $trgs = $sth->fetchall_arrayref({}); | ||
3455 | 775 | foreach my $trg (@$trgs) { | ||
3456 | 776 | my %trg; | ||
3457 | 777 | @trg{ map { lc $_ } keys %$trg } = values %$trg; | ||
3458 | 778 | push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg; | ||
3459 | 779 | } | ||
3460 | 780 | } | ||
3461 | 781 | $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
3462 | 782 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
3463 | 783 | PTDEBUG && _d($sql); | ||
3464 | 784 | $dbh->do($sql); | ||
3465 | 785 | } | ||
3466 | 786 | if ( $tbl ) { | ||
3467 | 787 | return $self->{triggers}->{$db}->{$tbl}; | ||
3468 | 788 | } | ||
3469 | 789 | return values %{$self->{triggers}->{$db}}; | ||
3470 | 790 | } | ||
3471 | 791 | |||
3472 | 792 | sub get_databases { | ||
3473 | 793 | my ( $self, $dbh, $quoter, $like ) = @_; | ||
3474 | 794 | if ( !$self->{cache} || !$self->{databases} || $like ) { | ||
3475 | 795 | my $sql = 'SHOW DATABASES'; | ||
3476 | 796 | my @params; | ||
3477 | 797 | if ( $like ) { | ||
3478 | 798 | $sql .= ' LIKE ?'; | ||
3479 | 799 | push @params, $like; | ||
3480 | 800 | } | ||
3481 | 801 | my $sth = $dbh->prepare($sql); | ||
3482 | 802 | PTDEBUG && _d($sql, @params); | ||
3483 | 803 | $sth->execute( @params ); | ||
3484 | 804 | my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; | ||
3485 | 805 | $self->{databases} = \@dbs unless $like; | ||
3486 | 806 | return @dbs; | ||
3487 | 807 | } | ||
3488 | 808 | return @{$self->{databases}}; | ||
3489 | 809 | } | ||
3490 | 810 | |||
3491 | 811 | sub get_table_status { | ||
3492 | 812 | my ( $self, $dbh, $quoter, $db, $like ) = @_; | ||
3493 | 813 | if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) { | ||
3494 | 814 | my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db); | ||
3495 | 815 | my @params; | ||
3496 | 816 | if ( $like ) { | ||
3497 | 817 | $sql .= ' LIKE ?'; | ||
3498 | 818 | push @params, $like; | ||
3499 | 819 | } | ||
3500 | 820 | PTDEBUG && _d($sql, @params); | ||
3501 | 821 | my $sth = $dbh->prepare($sql); | ||
3502 | 822 | $sth->execute(@params); | ||
3503 | 823 | my @tables = @{$sth->fetchall_arrayref({})}; | ||
3504 | 824 | @tables = map { | ||
3505 | 825 | my %tbl; # Make a copy with lowercased keys | ||
3506 | 826 | @tbl{ map { lc $_ } keys %$_ } = values %$_; | ||
3507 | 827 | $tbl{engine} ||= $tbl{type} || $tbl{comment}; | ||
3508 | 828 | delete $tbl{type}; | ||
3509 | 829 | \%tbl; | ||
3510 | 830 | } @tables; | ||
3511 | 831 | $self->{table_status}->{$db} = \@tables unless $like; | ||
3512 | 832 | return @tables; | ||
3513 | 833 | } | ||
3514 | 834 | return @{$self->{table_status}->{$db}}; | ||
3515 | 835 | } | ||
3516 | 836 | |||
3517 | 837 | sub get_table_list { | ||
3518 | 838 | my ( $self, $dbh, $quoter, $db, $like ) = @_; | ||
3519 | 839 | if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) { | ||
3520 | 840 | my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db); | ||
3521 | 841 | my @params; | ||
3522 | 842 | if ( $like ) { | ||
3523 | 843 | $sql .= ' LIKE ?'; | ||
3524 | 844 | push @params, $like; | ||
3525 | 845 | } | ||
3526 | 846 | PTDEBUG && _d($sql, @params); | ||
3527 | 847 | my $sth = $dbh->prepare($sql); | ||
3528 | 848 | $sth->execute(@params); | ||
3529 | 849 | my @tables = @{$sth->fetchall_arrayref()}; | ||
3530 | 850 | @tables = map { | ||
3531 | 851 | my %tbl = ( | ||
3532 | 852 | name => $_->[0], | ||
3533 | 853 | engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '', | ||
3534 | 854 | ); | ||
3535 | 855 | \%tbl; | ||
3536 | 856 | } @tables; | ||
3537 | 857 | $self->{table_list}->{$db} = \@tables unless $like; | ||
3538 | 858 | return @tables; | ||
3539 | 859 | } | ||
3540 | 860 | return @{$self->{table_list}->{$db}}; | ||
3541 | 861 | } | ||
3542 | 862 | |||
3543 | 863 | sub _d { | ||
3544 | 864 | my ($package, undef, $line) = caller 0; | ||
3545 | 865 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
3546 | 866 | map { defined $_ ? $_ : 'undef' } | ||
3547 | 867 | @_; | ||
3548 | 868 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
3549 | 869 | } | ||
3550 | 870 | |||
3551 | 871 | 1; | ||
3552 | 872 | } | ||
3553 | 873 | # ########################################################################### | ||
3554 | 874 | # End MySQLDump package | ||
3555 | 875 | # ########################################################################### | ||
3556 | 876 | |||
3557 | 877 | # ########################################################################### | ||
3558 | 878 | # DSNParser package | 572 | # DSNParser package |
3559 | 879 | # This package is a copy without comments from the original. The original | 573 | # This package is a copy without comments from the original. The original |
3560 | 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, |
3561 | @@ -1103,51 +797,10 @@ | |||
3562 | 1103 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, | 797 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, |
3563 | 1104 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); | 798 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); |
3564 | 1105 | 799 | ||
3603 | 1106 | eval { | 800 | $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) }; |
3604 | 1107 | $dbh = DBI->connect($cxn_string, $user, $pass, $defaults); | 801 | |
3567 | 1108 | |||
3568 | 1109 | if ( $cxn_string =~ m/mysql/i ) { | ||
3569 | 1110 | my $sql; | ||
3570 | 1111 | |||
3571 | 1112 | $sql = 'SELECT @@SQL_MODE'; | ||
3572 | 1113 | PTDEBUG && _d($dbh, $sql); | ||
3573 | 1114 | my ($sql_mode) = $dbh->selectrow_array($sql); | ||
3574 | 1115 | |||
3575 | 1116 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
3576 | 1117 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
3577 | 1118 | . ($sql_mode ? ",$sql_mode" : '') | ||
3578 | 1119 | . '\'*/'; | ||
3579 | 1120 | PTDEBUG && _d($dbh, $sql); | ||
3580 | 1121 | $dbh->do($sql); | ||
3581 | 1122 | |||
3582 | 1123 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
3583 | 1124 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
3584 | 1125 | PTDEBUG && _d($dbh, ':', $sql); | ||
3585 | 1126 | $dbh->do($sql); | ||
3586 | 1127 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
3587 | 1128 | if ( $charset eq 'utf8' ) { | ||
3588 | 1129 | binmode(STDOUT, ':utf8') | ||
3589 | 1130 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
3590 | 1131 | } | ||
3591 | 1132 | else { | ||
3592 | 1133 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
3593 | 1134 | } | ||
3594 | 1135 | } | ||
3595 | 1136 | |||
3596 | 1137 | if ( $self->prop('set-vars') ) { | ||
3597 | 1138 | $sql = "SET " . $self->prop('set-vars'); | ||
3598 | 1139 | PTDEBUG && _d($dbh, ':', $sql); | ||
3599 | 1140 | $dbh->do($sql); | ||
3600 | 1141 | } | ||
3601 | 1142 | } | ||
3602 | 1143 | }; | ||
3605 | 1144 | if ( !$dbh && $EVAL_ERROR ) { | 802 | if ( !$dbh && $EVAL_ERROR ) { |
3612 | 1145 | PTDEBUG && _d($EVAL_ERROR); | 803 | if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { |
3607 | 1146 | if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
3608 | 1147 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
3609 | 1148 | delete $defaults->{mysql_enable_utf8}; | ||
3610 | 1149 | } | ||
3611 | 1150 | elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { | ||
3613 | 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 " |
3614 | 1152 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " | 805 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " |
3615 | 1153 | . "the directories that Perl searches for DBD::mysql. If " | 806 | . "the directories that Perl searches for DBD::mysql. If " |
3616 | @@ -1156,19 +809,70 @@ | |||
3617 | 1156 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" | 809 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" |
3618 | 1157 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; | 810 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; |
3619 | 1158 | } | 811 | } |
3620 | 812 | elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
3621 | 813 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
3622 | 814 | delete $defaults->{mysql_enable_utf8}; | ||
3623 | 815 | } | ||
3624 | 1159 | if ( !$tries ) { | 816 | if ( !$tries ) { |
3625 | 1160 | die $EVAL_ERROR; | 817 | die $EVAL_ERROR; |
3626 | 1161 | } | 818 | } |
3627 | 1162 | } | 819 | } |
3628 | 1163 | } | 820 | } |
3629 | 1164 | 821 | ||
3630 | 822 | if ( $cxn_string =~ m/mysql/i ) { | ||
3631 | 823 | my $sql; | ||
3632 | 824 | |||
3633 | 825 | $sql = 'SELECT @@SQL_MODE'; | ||
3634 | 826 | PTDEBUG && _d($dbh, $sql); | ||
3635 | 827 | my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; | ||
3636 | 828 | if ( $EVAL_ERROR ) { | ||
3637 | 829 | die $EVAL_ERROR; | ||
3638 | 830 | } | ||
3639 | 831 | |||
3640 | 832 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
3641 | 833 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
3642 | 834 | . ($sql_mode ? ",$sql_mode" : '') | ||
3643 | 835 | . '\'*/'; | ||
3644 | 836 | PTDEBUG && _d($dbh, $sql); | ||
3645 | 837 | eval { $dbh->do($sql) }; | ||
3646 | 838 | if ( $EVAL_ERROR ) { | ||
3647 | 839 | die $EVAL_ERROR; | ||
3648 | 840 | } | ||
3649 | 841 | |||
3650 | 842 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
3651 | 843 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
3652 | 844 | PTDEBUG && _d($dbh, ':', $sql); | ||
3653 | 845 | eval { $dbh->do($sql) }; | ||
3654 | 846 | if ( $EVAL_ERROR ) { | ||
3655 | 847 | die $EVAL_ERROR; | ||
3656 | 848 | } | ||
3657 | 849 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
3658 | 850 | if ( $charset eq 'utf8' ) { | ||
3659 | 851 | binmode(STDOUT, ':utf8') | ||
3660 | 852 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
3661 | 853 | } | ||
3662 | 854 | else { | ||
3663 | 855 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
3664 | 856 | } | ||
3665 | 857 | } | ||
3666 | 858 | |||
3667 | 859 | if ( $self->prop('set-vars') ) { | ||
3668 | 860 | $sql = "SET " . $self->prop('set-vars'); | ||
3669 | 861 | PTDEBUG && _d($dbh, ':', $sql); | ||
3670 | 862 | eval { $dbh->do($sql) }; | ||
3671 | 863 | if ( $EVAL_ERROR ) { | ||
3672 | 864 | die $EVAL_ERROR; | ||
3673 | 865 | } | ||
3674 | 866 | } | ||
3675 | 867 | } | ||
3676 | 868 | |||
3677 | 1165 | PTDEBUG && _d('DBH info: ', | 869 | PTDEBUG && _d('DBH info: ', |
3678 | 1166 | $dbh, | 870 | $dbh, |
3679 | 1167 | Dumper($dbh->selectrow_hashref( | 871 | Dumper($dbh->selectrow_hashref( |
3680 | 1168 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), | 872 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), |
3681 | 1169 | 'Connection info:', $dbh->{mysql_hostinfo}, | 873 | 'Connection info:', $dbh->{mysql_hostinfo}, |
3682 | 1170 | 'Character set info:', Dumper($dbh->selectall_arrayref( | 874 | 'Character set info:', Dumper($dbh->selectall_arrayref( |
3684 | 1171 | 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})), | 875 | "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})), |
3685 | 1172 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, | 876 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, |
3686 | 1173 | '$DBI::VERSION:', $DBI::VERSION, | 877 | '$DBI::VERSION:', $DBI::VERSION, |
3687 | 1174 | ); | 878 | ); |
3688 | @@ -2186,7 +1890,7 @@ | |||
3689 | 2186 | $opt->{value} = ($pre || '') . $num; | 1890 | $opt->{value} = ($pre || '') . $num; |
3690 | 2187 | } | 1891 | } |
3691 | 2188 | else { | 1892 | else { |
3693 | 2189 | $self->save_error("Invalid size for --$opt->{long}"); | 1893 | $self->save_error("Invalid size for --$opt->{long}: $val"); |
3694 | 2190 | } | 1894 | } |
3695 | 2191 | return; | 1895 | return; |
3696 | 2192 | } | 1896 | } |
3697 | @@ -3054,9 +2758,9 @@ | |||
3698 | 3054 | ($col, $tbl, $db) = @args{qw(col tbl db)}; | 2758 | ($col, $tbl, $db) = @args{qw(col tbl db)}; |
3699 | 3055 | } | 2759 | } |
3700 | 3056 | 2760 | ||
3704 | 3057 | $db = lc $db; | 2761 | $db = lc($db || ''); |
3705 | 3058 | $tbl = lc $tbl; | 2762 | $tbl = lc($tbl || ''); |
3706 | 3059 | $col = lc $col; | 2763 | $col = lc($col || ''); |
3707 | 3060 | 2764 | ||
3708 | 3061 | if ( !$col ) { | 2765 | if ( !$col ) { |
3709 | 3062 | PTDEBUG && _d('No column specified or parsed'); | 2766 | PTDEBUG && _d('No column specified or parsed'); |
3710 | @@ -3116,8 +2820,8 @@ | |||
3711 | 3116 | ($tbl, $db) = @args{qw(tbl db)}; | 2820 | ($tbl, $db) = @args{qw(tbl db)}; |
3712 | 3117 | } | 2821 | } |
3713 | 3118 | 2822 | ||
3716 | 3119 | $db = lc $db; | 2823 | $db = lc($db || ''); |
3717 | 3120 | $tbl = lc $tbl; | 2824 | $tbl = lc($tbl || ''); |
3718 | 3121 | 2825 | ||
3719 | 3122 | if ( !$tbl ) { | 2826 | if ( !$tbl ) { |
3720 | 3123 | PTDEBUG && _d('No table specified or parsed'); | 2827 | PTDEBUG && _d('No table specified or parsed'); |
3721 | @@ -3200,7 +2904,7 @@ | |||
3722 | 3200 | 2904 | ||
3723 | 3201 | sub new { | 2905 | sub new { |
3724 | 3202 | my ( $class, %args ) = @_; | 2906 | my ( $class, %args ) = @_; |
3726 | 3203 | my @required_args = qw(OptionParser Quoter); | 2907 | my @required_args = qw(OptionParser TableParser Quoter); |
3727 | 3204 | foreach my $arg ( @required_args ) { | 2908 | foreach my $arg ( @required_args ) { |
3728 | 3205 | die "I need a $arg argument" unless $args{$arg}; | 2909 | die "I need a $arg argument" unless $args{$arg}; |
3729 | 3206 | } | 2910 | } |
3730 | @@ -3209,8 +2913,19 @@ | |||
3731 | 3209 | die "I need either a dbh or file_itr argument" | 2913 | die "I need either a dbh or file_itr argument" |
3732 | 3210 | if (!$dbh && !$file_itr) || ($dbh && $file_itr); | 2914 | if (!$dbh && !$file_itr) || ($dbh && $file_itr); |
3733 | 3211 | 2915 | ||
3734 | 2916 | my %resume; | ||
3735 | 2917 | if ( my $table = $args{resume} ) { | ||
3736 | 2918 | PTDEBUG && _d('Will resume from or after', $table); | ||
3737 | 2919 | my ($db, $tbl) = $args{Quoter}->split_unquote($table); | ||
3738 | 2920 | die "Resume table must be database-qualified: $table" | ||
3739 | 2921 | unless $db && $tbl; | ||
3740 | 2922 | $resume{db} = $db; | ||
3741 | 2923 | $resume{tbl} = $tbl; | ||
3742 | 2924 | } | ||
3743 | 2925 | |||
3744 | 3212 | my $self = { | 2926 | my $self = { |
3745 | 3213 | %args, | 2927 | %args, |
3746 | 2928 | resume => \%resume, | ||
3747 | 3214 | filters => _make_filters(%args), | 2929 | filters => _make_filters(%args), |
3748 | 3215 | }; | 2930 | }; |
3749 | 3216 | 2931 | ||
3750 | @@ -3271,9 +2986,19 @@ | |||
3751 | 3271 | return \%filters; | 2986 | return \%filters; |
3752 | 3272 | } | 2987 | } |
3753 | 3273 | 2988 | ||
3755 | 3274 | sub next_schema_object { | 2989 | sub next { |
3756 | 3275 | my ( $self ) = @_; | 2990 | my ( $self ) = @_; |
3757 | 3276 | 2991 | ||
3758 | 2992 | if ( !$self->{initialized} ) { | ||
3759 | 2993 | $self->{initialized} = 1; | ||
3760 | 2994 | if ( $self->{resume}->{tbl} | ||
3761 | 2995 | && !$self->table_is_allowed(@{$self->{resume}}{qw(db tbl)}) ) { | ||
3762 | 2996 | PTDEBUG && _d('Will resume after', | ||
3763 | 2997 | join('.', @{$self->{resume}}{qw(db tbl)})); | ||
3764 | 2998 | $self->{resume}->{after} = 1; | ||
3765 | 2999 | } | ||
3766 | 3000 | } | ||
3767 | 3001 | |||
3768 | 3277 | my $schema_obj; | 3002 | my $schema_obj; |
3769 | 3278 | if ( $self->{file_itr} ) { | 3003 | if ( $self->{file_itr} ) { |
3770 | 3279 | $schema_obj= $self->_iterate_files(); | 3004 | $schema_obj= $self->_iterate_files(); |
3771 | @@ -3283,19 +3008,13 @@ | |||
3772 | 3283 | } | 3008 | } |
3773 | 3284 | 3009 | ||
3774 | 3285 | if ( $schema_obj ) { | 3010 | if ( $schema_obj ) { |
3775 | 3286 | if ( $schema_obj->{ddl} && $self->{TableParser} ) { | ||
3776 | 3287 | $schema_obj->{tbl_struct} | ||
3777 | 3288 | = $self->{TableParser}->parse($schema_obj->{ddl}); | ||
3778 | 3289 | } | ||
3779 | 3290 | |||
3780 | 3291 | delete $schema_obj->{ddl} unless $self->{keep_ddl}; | ||
3781 | 3292 | |||
3782 | 3293 | if ( my $schema = $self->{Schema} ) { | 3011 | if ( my $schema = $self->{Schema} ) { |
3783 | 3294 | $schema->add_schema_object($schema_obj); | 3012 | $schema->add_schema_object($schema_obj); |
3784 | 3295 | } | 3013 | } |
3785 | 3014 | PTDEBUG && _d('Next schema object:', | ||
3786 | 3015 | $schema_obj->{db}, $schema_obj->{tbl}); | ||
3787 | 3296 | } | 3016 | } |
3788 | 3297 | 3017 | ||
3789 | 3298 | PTDEBUG && _d('Next schema object:', $schema_obj->{db}, $schema_obj->{tbl}); | ||
3790 | 3299 | return $schema_obj; | 3018 | return $schema_obj; |
3791 | 3300 | } | 3019 | } |
3792 | 3301 | 3020 | ||
3793 | @@ -3321,7 +3040,8 @@ | |||
3794 | 3321 | my $db = $1; # XXX | 3040 | my $db = $1; # XXX |
3795 | 3322 | $db =~ s/^`//; # strip leading ` | 3041 | $db =~ s/^`//; # strip leading ` |
3796 | 3323 | $db =~ s/`$//; # and trailing ` | 3042 | $db =~ s/`$//; # and trailing ` |
3798 | 3324 | if ( $self->database_is_allowed($db) ) { | 3043 | if ( $self->database_is_allowed($db) |
3799 | 3044 | && $self->_resume_from_database($db) ) { | ||
3800 | 3325 | $self->{db} = $db; | 3045 | $self->{db} = $db; |
3801 | 3326 | } | 3046 | } |
3802 | 3327 | } | 3047 | } |
3803 | @@ -3334,21 +3054,22 @@ | |||
3804 | 3334 | my ($tbl) = $chunk =~ m/$tbl_name/; | 3054 | my ($tbl) = $chunk =~ m/$tbl_name/; |
3805 | 3335 | $tbl =~ s/^\s*`//; | 3055 | $tbl =~ s/^\s*`//; |
3806 | 3336 | $tbl =~ s/`\s*$//; | 3056 | $tbl =~ s/`\s*$//; |
3808 | 3337 | if ( $self->table_is_allowed($self->{db}, $tbl) ) { | 3057 | if ( $self->_resume_from_table($tbl) |
3809 | 3058 | && $self->table_is_allowed($self->{db}, $tbl) ) { | ||
3810 | 3338 | my ($ddl) = $chunk =~ m/^(?:$open_comment)?(CREATE TABLE.+?;)$/ms; | 3059 | my ($ddl) = $chunk =~ m/^(?:$open_comment)?(CREATE TABLE.+?;)$/ms; |
3811 | 3339 | if ( !$ddl ) { | 3060 | if ( !$ddl ) { |
3812 | 3340 | warn "Failed to parse CREATE TABLE from\n" . $chunk; | 3061 | warn "Failed to parse CREATE TABLE from\n" . $chunk; |
3813 | 3341 | next CHUNK; | 3062 | next CHUNK; |
3814 | 3342 | } | 3063 | } |
3815 | 3343 | $ddl =~ s/ \*\/;\Z/;/; # remove end of version comment | 3064 | $ddl =~ s/ \*\/;\Z/;/; # remove end of version comment |
3820 | 3344 | 3065 | my $tbl_struct = $self->{TableParser}->parse($ddl); | |
3821 | 3345 | my ($engine) = $ddl =~ m/\).*?(?:ENGINE|TYPE)=(\w+)/; | 3066 | if ( $self->engine_is_allowed($tbl_struct->{engine}) ) { |
3818 | 3346 | |||
3819 | 3347 | if ( !$engine || $self->engine_is_allowed($engine) ) { | ||
3822 | 3348 | return { | 3067 | return { |
3826 | 3349 | db => $self->{db}, | 3068 | db => $self->{db}, |
3827 | 3350 | tbl => $tbl, | 3069 | tbl => $tbl, |
3828 | 3351 | ddl => $ddl, | 3070 | name => $self->{Quoter}->quote($self->{db}, $tbl), |
3829 | 3071 | ddl => $ddl, | ||
3830 | 3072 | tbl_struct => $tbl_struct, | ||
3831 | 3352 | }; | 3073 | }; |
3832 | 3353 | } | 3074 | } |
3833 | 3354 | } | 3075 | } |
3834 | @@ -3365,6 +3086,7 @@ | |||
3835 | 3365 | sub _iterate_dbh { | 3086 | sub _iterate_dbh { |
3836 | 3366 | my ( $self ) = @_; | 3087 | my ( $self ) = @_; |
3837 | 3367 | my $q = $self->{Quoter}; | 3088 | my $q = $self->{Quoter}; |
3838 | 3089 | my $tp = $self->{TableParser}; | ||
3839 | 3368 | my $dbh = $self->{dbh}; | 3090 | my $dbh = $self->{dbh}; |
3840 | 3369 | PTDEBUG && _d('Getting next schema object from dbh', $dbh); | 3091 | PTDEBUG && _d('Getting next schema object from dbh', $dbh); |
3841 | 3370 | 3092 | ||
3842 | @@ -3378,7 +3100,9 @@ | |||
3843 | 3378 | } | 3100 | } |
3844 | 3379 | 3101 | ||
3845 | 3380 | if ( !$self->{db} ) { | 3102 | if ( !$self->{db} ) { |
3847 | 3381 | $self->{db} = shift @{$self->{dbs}}; | 3103 | do { |
3848 | 3104 | $self->{db} = shift @{$self->{dbs}}; | ||
3849 | 3105 | } until $self->_resume_from_database($self->{db}); | ||
3850 | 3382 | PTDEBUG && _d('Next database:', $self->{db}); | 3106 | PTDEBUG && _d('Next database:', $self->{db}); |
3851 | 3383 | return unless $self->{db}; | 3107 | return unless $self->{db}; |
3852 | 3384 | } | 3108 | } |
3853 | @@ -3391,8 +3115,9 @@ | |||
3854 | 3391 | } | 3115 | } |
3855 | 3392 | grep { | 3116 | grep { |
3856 | 3393 | my ($tbl, $type) = @$_; | 3117 | my ($tbl, $type) = @$_; |
3859 | 3394 | $self->table_is_allowed($self->{db}, $tbl) | 3118 | (!$type || ($type ne 'VIEW')) |
3860 | 3395 | && (!$type || ($type ne 'VIEW')); | 3119 | && $self->_resume_from_table($tbl) |
3861 | 3120 | && $self->table_is_allowed($self->{db}, $tbl); | ||
3862 | 3396 | } | 3121 | } |
3863 | 3397 | @{$dbh->selectall_arrayref($sql)}; | 3122 | @{$dbh->selectall_arrayref($sql)}; |
3864 | 3398 | PTDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); | 3123 | PTDEBUG && _d('Found', scalar @tbls, 'tables in database', $self->{db}); |
3865 | @@ -3400,27 +3125,15 @@ | |||
3866 | 3400 | } | 3125 | } |
3867 | 3401 | 3126 | ||
3868 | 3402 | while ( my $tbl = shift @{$self->{tbls}} ) { | 3127 | while ( my $tbl = shift @{$self->{tbls}} ) { |
3886 | 3403 | my $engine; | 3128 | my $ddl = $tp->get_create_table($dbh, $self->{db}, $tbl); |
3887 | 3404 | if ( $self->{filters}->{'engines'} | 3129 | my $tbl_struct = $tp->parse($ddl); |
3888 | 3405 | || $self->{filters}->{'ignore-engines'} ) { | 3130 | if ( $self->engine_is_allowed($tbl_struct->{engine}) ) { |
3872 | 3406 | my $sql = "SHOW TABLE STATUS FROM " . $q->quote($self->{db}) | ||
3873 | 3407 | . " LIKE \'$tbl\'"; | ||
3874 | 3408 | PTDEBUG && _d($sql); | ||
3875 | 3409 | $engine = $dbh->selectrow_hashref($sql)->{engine}; | ||
3876 | 3410 | PTDEBUG && _d($tbl, 'uses', $engine, 'engine'); | ||
3877 | 3411 | } | ||
3878 | 3412 | |||
3879 | 3413 | |||
3880 | 3414 | if ( !$engine || $self->engine_is_allowed($engine) ) { | ||
3881 | 3415 | my $ddl; | ||
3882 | 3416 | if ( my $du = $self->{MySQLDump} ) { | ||
3883 | 3417 | $ddl = $du->get_create_table($dbh, $q, $self->{db}, $tbl)->[1]; | ||
3884 | 3418 | } | ||
3885 | 3419 | |||
3889 | 3420 | return { | 3131 | return { |
3893 | 3421 | db => $self->{db}, | 3132 | db => $self->{db}, |
3894 | 3422 | tbl => $tbl, | 3133 | tbl => $tbl, |
3895 | 3423 | ddl => $ddl, | 3134 | name => $q->quote($self->{db}, $tbl), |
3896 | 3135 | ddl => $ddl, | ||
3897 | 3136 | tbl_struct => $tbl_struct, | ||
3898 | 3424 | }; | 3137 | }; |
3899 | 3425 | } | 3138 | } |
3900 | 3426 | } | 3139 | } |
3901 | @@ -3481,6 +3194,10 @@ | |||
3902 | 3481 | 3194 | ||
3903 | 3482 | my $filter = $self->{filters}; | 3195 | my $filter = $self->{filters}; |
3904 | 3483 | 3196 | ||
3905 | 3197 | if ( $db eq 'mysql' && ($tbl eq 'general_log' || $tbl eq 'slow_log') ) { | ||
3906 | 3198 | return 0; | ||
3907 | 3199 | } | ||
3908 | 3200 | |||
3909 | 3484 | if ( $filter->{'ignore-tables'}->{$tbl} | 3201 | if ( $filter->{'ignore-tables'}->{$tbl} |
3910 | 3485 | && ($filter->{'ignore-tables'}->{$tbl} eq '*' | 3202 | && ($filter->{'ignore-tables'}->{$tbl} eq '*' |
3911 | 3486 | || $filter->{'ignore-tables'}->{$tbl} eq $db) ) { | 3203 | || $filter->{'ignore-tables'}->{$tbl} eq $db) ) { |
3912 | @@ -3520,7 +3237,11 @@ | |||
3913 | 3520 | 3237 | ||
3914 | 3521 | sub engine_is_allowed { | 3238 | sub engine_is_allowed { |
3915 | 3522 | my ( $self, $engine ) = @_; | 3239 | my ( $self, $engine ) = @_; |
3917 | 3523 | die "I need an engine argument" unless $engine; | 3240 | |
3918 | 3241 | if ( !$engine ) { | ||
3919 | 3242 | PTDEBUG && _d('No engine specified; allowing the table'); | ||
3920 | 3243 | return 1; | ||
3921 | 3244 | } | ||
3922 | 3524 | 3245 | ||
3923 | 3525 | $engine = lc $engine; | 3246 | $engine = lc $engine; |
3924 | 3526 | 3247 | ||
3925 | @@ -3540,6 +3261,40 @@ | |||
3926 | 3540 | return 1; | 3261 | return 1; |
3927 | 3541 | } | 3262 | } |
3928 | 3542 | 3263 | ||
3929 | 3264 | sub _resume_from_database { | ||
3930 | 3265 | my ($self, $db) = @_; | ||
3931 | 3266 | |||
3932 | 3267 | return 1 unless $self->{resume}->{db}; | ||
3933 | 3268 | |||
3934 | 3269 | if ( $db eq $self->{resume}->{db} ) { | ||
3935 | 3270 | PTDEBUG && _d('At resume db', $db); | ||
3936 | 3271 | delete $self->{resume}->{db}; | ||
3937 | 3272 | return 1; | ||
3938 | 3273 | } | ||
3939 | 3274 | |||
3940 | 3275 | return 0; | ||
3941 | 3276 | } | ||
3942 | 3277 | |||
3943 | 3278 | sub _resume_from_table { | ||
3944 | 3279 | my ($self, $tbl) = @_; | ||
3945 | 3280 | |||
3946 | 3281 | return 1 unless $self->{resume}->{tbl}; | ||
3947 | 3282 | |||
3948 | 3283 | if ( $tbl eq $self->{resume}->{tbl} ) { | ||
3949 | 3284 | if ( !$self->{resume}->{after} ) { | ||
3950 | 3285 | PTDEBUG && _d('Resuming from table', $tbl); | ||
3951 | 3286 | delete $self->{resume}->{tbl}; | ||
3952 | 3287 | return 1; | ||
3953 | 3288 | } | ||
3954 | 3289 | else { | ||
3955 | 3290 | PTDEBUG && _d('Resuming after table', $tbl); | ||
3956 | 3291 | delete $self->{resume}->{tbl}; | ||
3957 | 3292 | } | ||
3958 | 3293 | } | ||
3959 | 3294 | |||
3960 | 3295 | return 0; | ||
3961 | 3296 | } | ||
3962 | 3297 | |||
3963 | 3543 | sub _d { | 3298 | sub _d { |
3964 | 3544 | my ($package, undef, $line) = caller 0; | 3299 | my ($package, undef, $line) = caller 0; |
3965 | 3545 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | 3300 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } |
3966 | @@ -3622,15 +3377,11 @@ | |||
3967 | 3622 | my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), | 3377 | my $dbh = $dp->get_dbh($dp->get_cxn_params($dsn), |
3968 | 3623 | { AutoCommit => 1, }); | 3378 | { AutoCommit => 1, }); |
3969 | 3624 | 3379 | ||
3970 | 3625 | my $vp = new VersionParser(); | ||
3971 | 3626 | my $version = $vp->parse($dbh->selectrow_array('SELECT VERSION()')); | ||
3972 | 3627 | |||
3973 | 3628 | # ####################################################################### | 3380 | # ####################################################################### |
3974 | 3629 | # Do the main work. | 3381 | # Do the main work. |
3975 | 3630 | # ####################################################################### | 3382 | # ####################################################################### |
3976 | 3631 | my $ks = $o->get('summary') ? new KeySize(q=>$q) : undef; | 3383 | my $ks = $o->get('summary') ? new KeySize(q=>$q) : undef; |
3977 | 3632 | my $dk = new DuplicateKeyFinder(); | 3384 | my $dk = new DuplicateKeyFinder(); |
3978 | 3633 | my $du = new MySQLDump(); | ||
3979 | 3634 | 3385 | ||
3980 | 3635 | my %tp_opts = ( | 3386 | my %tp_opts = ( |
3981 | 3636 | ignore_type => $o->get('all-structs'), | 3387 | ignore_type => $o->get('all-structs'), |
3982 | @@ -3646,25 +3397,23 @@ | |||
3983 | 3646 | dbh => $dbh, | 3397 | dbh => $dbh, |
3984 | 3647 | OptionParser => $o, | 3398 | OptionParser => $o, |
3985 | 3648 | Quoter => $q, | 3399 | Quoter => $q, |
3986 | 3649 | MySQLDump => $du, | ||
3987 | 3650 | TableParser => $tp, | 3400 | TableParser => $tp, |
3988 | 3651 | Schema => $schema, | 3401 | Schema => $schema, |
3989 | 3652 | keep_ddl => 1, | ||
3990 | 3653 | ); | 3402 | ); |
3991 | 3654 | TABLE: | 3403 | TABLE: |
3994 | 3655 | while ( my $tbl = $schema_itr->next_schema_object() ) { | 3404 | while ( my $tbl = $schema_itr->next() ) { |
3995 | 3656 | $tbl->{engine} = $tp->get_engine($tbl->{ddl}); | 3405 | $tbl->{engine} = $tbl->{tbl_struct}->{engine}; |
3996 | 3657 | 3406 | ||
3997 | 3658 | my ($keys, $clustered_key, $fks); | 3407 | my ($keys, $clustered_key, $fks); |
3998 | 3659 | if ( $get_keys ) { | 3408 | if ( $get_keys ) { |
3999 | 3660 | ($keys, $clustered_key) | 3409 | ($keys, $clustered_key) |
4001 | 3661 | = $tp->get_keys($tbl->{ddl}, {version => $version}); | 3410 | = $tp->get_keys($tbl->{ddl}, {}); |
4002 | 3662 | } | 3411 | } |
4003 | 3663 | if ( $get_fks ) { | 3412 | if ( $get_fks ) { |
4004 | 3664 | $fks = $tp->get_fks($tbl->{ddl}, {database => $tbl->{db}}); | 3413 | $fks = $tp->get_fks($tbl->{ddl}, {database => $tbl->{db}}); |
4005 | 3665 | } | 3414 | } |
4006 | 3666 | 3415 | ||
4008 | 3667 | next TABLE unless %$keys || %$fks; | 3416 | next TABLE unless ($keys && %$keys) || ($fks && %$fks); |
4009 | 3668 | 3417 | ||
4010 | 3669 | if ( $o->got('verbose') ) { | 3418 | if ( $o->got('verbose') ) { |
4011 | 3670 | print_all_keys($keys, $tbl, \%seen_tbl) if $keys; | 3419 | print_all_keys($keys, $tbl, \%seen_tbl) if $keys; |
4012 | @@ -4279,6 +4028,10 @@ | |||
4013 | 4279 | 4028 | ||
4014 | 4280 | =head1 VERSION | 4029 | =head1 VERSION |
4015 | 4281 | 4030 | ||
4016 | 4031 | <<<<<<< TREE | ||
4017 | 4282 | pt-duplicate-key-checker 2.0.5 | 4032 | pt-duplicate-key-checker 2.0.5 |
4018 | 4033 | ======= | ||
4019 | 4034 | pt-duplicate-key-checker 2.1.2 | ||
4020 | 4035 | >>>>>>> MERGE-SOURCE | ||
4021 | 4283 | 4036 | ||
4022 | 4284 | =cut | 4037 | =cut |
4023 | 4285 | 4038 | ||
4024 | === modified file 'bin/pt-fifo-split' | |||
4025 | --- bin/pt-fifo-split 2012-06-09 21:53:04 +0000 | |||
4026 | +++ bin/pt-fifo-split 2012-07-20 22:10:28 +0000 | |||
4027 | @@ -959,7 +959,7 @@ | |||
4028 | 959 | $opt->{value} = ($pre || '') . $num; | 959 | $opt->{value} = ($pre || '') . $num; |
4029 | 960 | } | 960 | } |
4030 | 961 | else { | 961 | else { |
4032 | 962 | $self->save_error("Invalid size for --$opt->{long}"); | 962 | $self->save_error("Invalid size for --$opt->{long}: $val"); |
4033 | 963 | } | 963 | } |
4034 | 964 | return; | 964 | return; |
4035 | 965 | } | 965 | } |
4036 | @@ -1547,6 +1547,10 @@ | |||
4037 | 1547 | 1547 | ||
4038 | 1548 | =head1 VERSION | 1548 | =head1 VERSION |
4039 | 1549 | 1549 | ||
4040 | 1550 | <<<<<<< TREE | ||
4041 | 1550 | pt-fifo-split 2.0.5 | 1551 | pt-fifo-split 2.0.5 |
4042 | 1552 | ======= | ||
4043 | 1553 | pt-fifo-split 2.1.2 | ||
4044 | 1554 | >>>>>>> MERGE-SOURCE | ||
4045 | 1551 | 1555 | ||
4046 | 1552 | =cut | 1556 | =cut |
4047 | 1553 | 1557 | ||
4048 | === modified file 'bin/pt-find' | |||
4049 | --- bin/pt-find 2012-06-09 21:53:04 +0000 | |||
4050 | +++ bin/pt-find 2012-07-20 22:10:28 +0000 | |||
4051 | @@ -237,51 +237,10 @@ | |||
4052 | 237 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, | 237 | PTDEBUG && _d($cxn_string, ' ', $user, ' ', $pass, |
4053 | 238 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); | 238 | join(', ', map { "$_=>$defaults->{$_}" } keys %$defaults )); |
4054 | 239 | 239 | ||
4093 | 240 | eval { | 240 | $dbh = eval { DBI->connect($cxn_string, $user, $pass, $defaults) }; |
4094 | 241 | $dbh = DBI->connect($cxn_string, $user, $pass, $defaults); | 241 | |
4057 | 242 | |||
4058 | 243 | if ( $cxn_string =~ m/mysql/i ) { | ||
4059 | 244 | my $sql; | ||
4060 | 245 | |||
4061 | 246 | $sql = 'SELECT @@SQL_MODE'; | ||
4062 | 247 | PTDEBUG && _d($dbh, $sql); | ||
4063 | 248 | my ($sql_mode) = $dbh->selectrow_array($sql); | ||
4064 | 249 | |||
4065 | 250 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
4066 | 251 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
4067 | 252 | . ($sql_mode ? ",$sql_mode" : '') | ||
4068 | 253 | . '\'*/'; | ||
4069 | 254 | PTDEBUG && _d($dbh, $sql); | ||
4070 | 255 | $dbh->do($sql); | ||
4071 | 256 | |||
4072 | 257 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
4073 | 258 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
4074 | 259 | PTDEBUG && _d($dbh, ':', $sql); | ||
4075 | 260 | $dbh->do($sql); | ||
4076 | 261 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
4077 | 262 | if ( $charset eq 'utf8' ) { | ||
4078 | 263 | binmode(STDOUT, ':utf8') | ||
4079 | 264 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
4080 | 265 | } | ||
4081 | 266 | else { | ||
4082 | 267 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
4083 | 268 | } | ||
4084 | 269 | } | ||
4085 | 270 | |||
4086 | 271 | if ( $self->prop('set-vars') ) { | ||
4087 | 272 | $sql = "SET " . $self->prop('set-vars'); | ||
4088 | 273 | PTDEBUG && _d($dbh, ':', $sql); | ||
4089 | 274 | $dbh->do($sql); | ||
4090 | 275 | } | ||
4091 | 276 | } | ||
4092 | 277 | }; | ||
4095 | 278 | if ( !$dbh && $EVAL_ERROR ) { | 242 | if ( !$dbh && $EVAL_ERROR ) { |
4102 | 279 | PTDEBUG && _d($EVAL_ERROR); | 243 | if ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { |
4097 | 280 | if ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
4098 | 281 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
4099 | 282 | delete $defaults->{mysql_enable_utf8}; | ||
4100 | 283 | } | ||
4101 | 284 | elsif ( $EVAL_ERROR =~ m/locate DBD\/mysql/i ) { | ||
4103 | 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 " |
4104 | 286 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " | 245 | . "not installed or not found. Run 'perl -MDBD::mysql' to see " |
4105 | 287 | . "the directories that Perl searches for DBD::mysql. If " | 246 | . "the directories that Perl searches for DBD::mysql. If " |
4106 | @@ -290,19 +249,70 @@ | |||
4107 | 290 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" | 249 | . " RHEL/CentOS yum install perl-DBD-MySQL\n" |
4108 | 291 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; | 250 | . " OpenSolaris pgk install pkg:/SUNWapu13dbd-mysql\n"; |
4109 | 292 | } | 251 | } |
4110 | 252 | elsif ( $EVAL_ERROR =~ m/not a compiled character set|character set utf8/ ) { | ||
4111 | 253 | PTDEBUG && _d('Going to try again without utf8 support'); | ||
4112 | 254 | delete $defaults->{mysql_enable_utf8}; | ||
4113 | 255 | } | ||
4114 | 293 | if ( !$tries ) { | 256 | if ( !$tries ) { |
4115 | 294 | die $EVAL_ERROR; | 257 | die $EVAL_ERROR; |
4116 | 295 | } | 258 | } |
4117 | 296 | } | 259 | } |
4118 | 297 | } | 260 | } |
4119 | 298 | 261 | ||
4120 | 262 | if ( $cxn_string =~ m/mysql/i ) { | ||
4121 | 263 | my $sql; | ||
4122 | 264 | |||
4123 | 265 | $sql = 'SELECT @@SQL_MODE'; | ||
4124 | 266 | PTDEBUG && _d($dbh, $sql); | ||
4125 | 267 | my ($sql_mode) = eval { $dbh->selectrow_array($sql) }; | ||
4126 | 268 | if ( $EVAL_ERROR ) { | ||
4127 | 269 | die $EVAL_ERROR; | ||
4128 | 270 | } | ||
4129 | 271 | |||
4130 | 272 | $sql = 'SET @@SQL_QUOTE_SHOW_CREATE = 1' | ||
4131 | 273 | . '/*!40101, @@SQL_MODE=\'NO_AUTO_VALUE_ON_ZERO' | ||
4132 | 274 | . ($sql_mode ? ",$sql_mode" : '') | ||
4133 | 275 | . '\'*/'; | ||
4134 | 276 | PTDEBUG && _d($dbh, $sql); | ||
4135 | 277 | eval { $dbh->do($sql) }; | ||
4136 | 278 | if ( $EVAL_ERROR ) { | ||
4137 | 279 | die $EVAL_ERROR; | ||
4138 | 280 | } | ||
4139 | 281 | |||
4140 | 282 | if ( my ($charset) = $cxn_string =~ m/charset=(\w+)/ ) { | ||
4141 | 283 | $sql = "/*!40101 SET NAMES $charset*/"; | ||
4142 | 284 | PTDEBUG && _d($dbh, ':', $sql); | ||
4143 | 285 | eval { $dbh->do($sql) }; | ||
4144 | 286 | if ( $EVAL_ERROR ) { | ||
4145 | 287 | die $EVAL_ERROR; | ||
4146 | 288 | } | ||
4147 | 289 | PTDEBUG && _d('Enabling charset for STDOUT'); | ||
4148 | 290 | if ( $charset eq 'utf8' ) { | ||
4149 | 291 | binmode(STDOUT, ':utf8') | ||
4150 | 292 | or die "Can't binmode(STDOUT, ':utf8'): $OS_ERROR"; | ||
4151 | 293 | } | ||
4152 | 294 | else { | ||
4153 | 295 | binmode(STDOUT) or die "Can't binmode(STDOUT): $OS_ERROR"; | ||
4154 | 296 | } | ||
4155 | 297 | } | ||
4156 | 298 | |||
4157 | 299 | if ( $self->prop('set-vars') ) { | ||
4158 | 300 | $sql = "SET " . $self->prop('set-vars'); | ||
4159 | 301 | PTDEBUG && _d($dbh, ':', $sql); | ||
4160 | 302 | eval { $dbh->do($sql) }; | ||
4161 | 303 | if ( $EVAL_ERROR ) { | ||
4162 | 304 | die $EVAL_ERROR; | ||
4163 | 305 | } | ||
4164 | 306 | } | ||
4165 | 307 | } | ||
4166 | 308 | |||
4167 | 299 | PTDEBUG && _d('DBH info: ', | 309 | PTDEBUG && _d('DBH info: ', |
4168 | 300 | $dbh, | 310 | $dbh, |
4169 | 301 | Dumper($dbh->selectrow_hashref( | 311 | Dumper($dbh->selectrow_hashref( |
4170 | 302 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), | 312 | 'SELECT DATABASE(), CONNECTION_ID(), VERSION()/*!50038 , @@hostname*/')), |
4171 | 303 | 'Connection info:', $dbh->{mysql_hostinfo}, | 313 | 'Connection info:', $dbh->{mysql_hostinfo}, |
4172 | 304 | 'Character set info:', Dumper($dbh->selectall_arrayref( | 314 | 'Character set info:', Dumper($dbh->selectall_arrayref( |
4174 | 305 | 'SHOW VARIABLES LIKE "character_set%"', { Slice => {}})), | 315 | "SHOW VARIABLES LIKE 'character_set%'", { Slice => {}})), |
4175 | 306 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, | 316 | '$DBD::mysql::VERSION:', $DBD::mysql::VERSION, |
4176 | 307 | '$DBI::VERSION:', $DBI::VERSION, | 317 | '$DBI::VERSION:', $DBI::VERSION, |
4177 | 308 | ); | 318 | ); |
4178 | @@ -1320,7 +1330,7 @@ | |||
4179 | 1320 | $opt->{value} = ($pre || '') . $num; | 1330 | $opt->{value} = ($pre || '') . $num; |
4180 | 1321 | } | 1331 | } |
4181 | 1322 | else { | 1332 | else { |
4183 | 1323 | $self->save_error("Invalid size for --$opt->{long}"); | 1333 | $self->save_error("Invalid size for --$opt->{long}: $val"); |
4184 | 1324 | } | 1334 | } |
4185 | 1325 | return; | 1335 | return; |
4186 | 1326 | } | 1336 | } |
4187 | @@ -1465,6 +1475,48 @@ | |||
4188 | 1465 | return $db ? "$db.$tbl" : $tbl; | 1475 | return $db ? "$db.$tbl" : $tbl; |
4189 | 1466 | } | 1476 | } |
4190 | 1467 | 1477 | ||
4191 | 1478 | sub serialize_list { | ||
4192 | 1479 | my ( $self, @args ) = @_; | ||
4193 | 1480 | return unless @args; | ||
4194 | 1481 | |||
4195 | 1482 | return $args[0] if @args == 1 && !defined $args[0]; | ||
4196 | 1483 | |||
4197 | 1484 | die "Cannot serialize multiple values with undef/NULL" | ||
4198 | 1485 | if grep { !defined $_ } @args; | ||
4199 | 1486 | |||
4200 | 1487 | return join ',', map { quotemeta } @args; | ||
4201 | 1488 | } | ||
4202 | 1489 | |||
4203 | 1490 | sub deserialize_list { | ||
4204 | 1491 | my ( $self, $string ) = @_; | ||
4205 | 1492 | return $string unless defined $string; | ||
4206 | 1493 | my @escaped_parts = $string =~ / | ||
4207 | 1494 | \G # Start of string, or end of previous match. | ||
4208 | 1495 | ( # Each of these is an element in the original list. | ||
4209 | 1496 | [^\\,]* # Anything not a backslash or a comma | ||
4210 | 1497 | (?: # When we get here, we found one of the above. | ||
4211 | 1498 | \\. # A backslash followed by something so we can continue | ||
4212 | 1499 | [^\\,]* # Same as above. | ||
4213 | 1500 | )* # Repeat zero of more times. | ||
4214 | 1501 | ) | ||
4215 | 1502 | , # Comma dividing elements | ||
4216 | 1503 | /sxgc; | ||
4217 | 1504 | |||
4218 | 1505 | push @escaped_parts, pos($string) ? substr( $string, pos($string) ) : $string; | ||
4219 | 1506 | |||
4220 | 1507 | my @unescaped_parts = map { | ||
4221 | 1508 | my $part = $_; | ||
4222 | 1509 | |||
4223 | 1510 | my $char_class = utf8::is_utf8($part) # If it's a UTF-8 string, | ||
4224 | 1511 | ? qr/(?=\p{ASCII})\W/ # We only care about non-word | ||
4225 | 1512 | : qr/(?=\p{ASCII})\W|[\x{80}-\x{FF}]/; # Otherwise, | ||
4226 | 1513 | $part =~ s/\\($char_class)/$1/g; | ||
4227 | 1514 | $part; | ||
4228 | 1515 | } @escaped_parts; | ||
4229 | 1516 | |||
4230 | 1517 | return @unescaped_parts; | ||
4231 | 1518 | } | ||
4232 | 1519 | |||
4233 | 1468 | 1; | 1520 | 1; |
4234 | 1469 | } | 1521 | } |
4235 | 1470 | # ########################################################################### | 1522 | # ########################################################################### |
4236 | @@ -1472,89 +1524,6 @@ | |||
4237 | 1472 | # ########################################################################### | 1524 | # ########################################################################### |
4238 | 1473 | 1525 | ||
4239 | 1474 | # ########################################################################### | 1526 | # ########################################################################### |
4240 | 1475 | # VersionParser package | ||
4241 | 1476 | # This package is a copy without comments from the original. The original | ||
4242 | 1477 | # with comments and its test file can be found in the Bazaar repository at, | ||
4243 | 1478 | # lib/VersionParser.pm | ||
4244 | 1479 | # t/lib/VersionParser.t | ||
4245 | 1480 | # See https://launchpad.net/percona-toolkit for more information. | ||
4246 | 1481 | # ########################################################################### | ||
4247 | 1482 | { | ||
4248 | 1483 | package VersionParser; | ||
4249 | 1484 | |||
4250 | 1485 | use strict; | ||
4251 | 1486 | use warnings FATAL => 'all'; | ||
4252 | 1487 | use English qw(-no_match_vars); | ||
4253 | 1488 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
4254 | 1489 | |||
4255 | 1490 | sub new { | ||
4256 | 1491 | my ( $class ) = @_; | ||
4257 | 1492 | bless {}, $class; | ||
4258 | 1493 | } | ||
4259 | 1494 | |||
4260 | 1495 | sub parse { | ||
4261 | 1496 | my ( $self, $str ) = @_; | ||
4262 | 1497 | my $result = sprintf('%03d%03d%03d', $str =~ m/(\d+)/g); | ||
4263 | 1498 | PTDEBUG && _d($str, 'parses to', $result); | ||
4264 | 1499 | return $result; | ||
4265 | 1500 | } | ||
4266 | 1501 | |||
4267 | 1502 | sub version_ge { | ||
4268 | 1503 | my ( $self, $dbh, $target ) = @_; | ||
4269 | 1504 | if ( !$self->{$dbh} ) { | ||
4270 | 1505 | $self->{$dbh} = $self->parse( | ||
4271 | 1506 | $dbh->selectrow_array('SELECT VERSION()')); | ||
4272 | 1507 | } | ||
4273 | 1508 | my $result = $self->{$dbh} ge $self->parse($target) ? 1 : 0; | ||
4274 | 1509 | PTDEBUG && _d($self->{$dbh}, 'ge', $target, ':', $result); | ||
4275 | 1510 | return $result; | ||
4276 | 1511 | } | ||
4277 | 1512 | |||
4278 | 1513 | sub innodb_version { | ||
4279 | 1514 | my ( $self, $dbh ) = @_; | ||
4280 | 1515 | return unless $dbh; | ||
4281 | 1516 | my $innodb_version = "NO"; | ||
4282 | 1517 | |||
4283 | 1518 | my ($innodb) = | ||
4284 | 1519 | grep { $_->{engine} =~ m/InnoDB/i } | ||
4285 | 1520 | map { | ||
4286 | 1521 | my %hash; | ||
4287 | 1522 | @hash{ map { lc $_ } keys %$_ } = values %$_; | ||
4288 | 1523 | \%hash; | ||
4289 | 1524 | } | ||
4290 | 1525 | @{ $dbh->selectall_arrayref("SHOW ENGINES", {Slice=>{}}) }; | ||
4291 | 1526 | if ( $innodb ) { | ||
4292 | 1527 | PTDEBUG && _d("InnoDB support:", $innodb->{support}); | ||
4293 | 1528 | if ( $innodb->{support} =~ m/YES|DEFAULT/i ) { | ||
4294 | 1529 | my $vars = $dbh->selectrow_hashref( | ||
4295 | 1530 | "SHOW VARIABLES LIKE 'innodb_version'"); | ||
4296 | 1531 | $innodb_version = !$vars ? "BUILTIN" | ||
4297 | 1532 | : ($vars->{Value} || $vars->{value}); | ||
4298 | 1533 | } | ||
4299 | 1534 | else { | ||
4300 | 1535 | $innodb_version = $innodb->{support}; # probably DISABLED or NO | ||
4301 | 1536 | } | ||
4302 | 1537 | } | ||
4303 | 1538 | |||
4304 | 1539 | PTDEBUG && _d("InnoDB version:", $innodb_version); | ||
4305 | 1540 | return $innodb_version; | ||
4306 | 1541 | } | ||
4307 | 1542 | |||
4308 | 1543 | sub _d { | ||
4309 | 1544 | my ($package, undef, $line) = caller 0; | ||
4310 | 1545 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
4311 | 1546 | map { defined $_ ? $_ : 'undef' } | ||
4312 | 1547 | @_; | ||
4313 | 1548 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
4314 | 1549 | } | ||
4315 | 1550 | |||
4316 | 1551 | 1; | ||
4317 | 1552 | } | ||
4318 | 1553 | # ########################################################################### | ||
4319 | 1554 | # End VersionParser package | ||
4320 | 1555 | # ########################################################################### | ||
4321 | 1556 | |||
4322 | 1557 | # ########################################################################### | ||
4323 | 1558 | # TableParser package | 1527 | # TableParser package |
4324 | 1559 | # This package is a copy without comments from the original. The original | 1528 | # This package is a copy without comments from the original. The original |
4325 | 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, |
4326 | @@ -1585,23 +1554,64 @@ | |||
4327 | 1585 | return bless $self, $class; | 1554 | return bless $self, $class; |
4328 | 1586 | } | 1555 | } |
4329 | 1587 | 1556 | ||
4330 | 1557 | sub get_create_table { | ||
4331 | 1558 | my ( $self, $dbh, $db, $tbl ) = @_; | ||
4332 | 1559 | die "I need a dbh parameter" unless $dbh; | ||
4333 | 1560 | die "I need a db parameter" unless $db; | ||
4334 | 1561 | die "I need a tbl parameter" unless $tbl; | ||
4335 | 1562 | my $q = $self->{Quoter}; | ||
4336 | 1563 | |||
4337 | 1564 | my $new_sql_mode | ||
4338 | 1565 | = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
4339 | 1566 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
4340 | 1567 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
4341 | 1568 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
4342 | 1569 | |||
4343 | 1570 | my $old_sql_mode = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
4344 | 1571 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
4345 | 1572 | |||
4346 | 1573 | PTDEBUG && _d($new_sql_mode); | ||
4347 | 1574 | eval { $dbh->do($new_sql_mode); }; | ||
4348 | 1575 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
4349 | 1576 | |||
4350 | 1577 | my $use_sql = 'USE ' . $q->quote($db); | ||
4351 | 1578 | PTDEBUG && _d($dbh, $use_sql); | ||
4352 | 1579 | $dbh->do($use_sql); | ||
4353 | 1580 | |||
4354 | 1581 | my $show_sql = "SHOW CREATE TABLE " . $q->quote($db, $tbl); | ||
4355 | 1582 | PTDEBUG && _d($show_sql); | ||
4356 | 1583 | my $href; | ||
4357 | 1584 | eval { $href = $dbh->selectrow_hashref($show_sql); }; | ||
4358 | 1585 | if ( $EVAL_ERROR ) { | ||
4359 | 1586 | PTDEBUG && _d($EVAL_ERROR); | ||
4360 | 1587 | |||
4361 | 1588 | PTDEBUG && _d($old_sql_mode); | ||
4362 | 1589 | $dbh->do($old_sql_mode); | ||
4363 | 1590 | |||
4364 | 1591 | return; | ||
4365 | 1592 | } | ||
4366 | 1593 | |||
4367 | 1594 | PTDEBUG && _d($old_sql_mode); | ||
4368 | 1595 | $dbh->do($old_sql_mode); | ||
4369 | 1596 | |||
4370 | 1597 | my ($key) = grep { m/create (?:table|view)/i } keys %$href; | ||
4371 | 1598 | if ( !$key ) { | ||
4372 | 1599 | die "Error: no 'Create Table' or 'Create View' in result set from " | ||
4373 | 1600 | . "$show_sql: " . Dumper($href); | ||
4374 | 1601 | } | ||
4375 | 1602 | |||
4376 | 1603 | return $href->{$key}; | ||
4377 | 1604 | } | ||
4378 | 1605 | |||
4379 | 1588 | sub parse { | 1606 | sub parse { |
4380 | 1589 | my ( $self, $ddl, $opts ) = @_; | 1607 | my ( $self, $ddl, $opts ) = @_; |
4381 | 1590 | return unless $ddl; | 1608 | return unless $ddl; |
4391 | 1591 | if ( ref $ddl eq 'ARRAY' ) { | 1609 | |
4392 | 1592 | if ( lc $ddl->[0] eq 'table' ) { | 1610 | if ( $ddl =~ m/CREATE (?:TEMPORARY )?TABLE "/ ) { |
4393 | 1593 | $ddl = $ddl->[1]; | 1611 | $ddl = $self->ansi_to_legacy($ddl); |
4385 | 1594 | } | ||
4386 | 1595 | else { | ||
4387 | 1596 | return { | ||
4388 | 1597 | engine => 'VIEW', | ||
4389 | 1598 | }; | ||
4390 | 1599 | } | ||
4394 | 1600 | } | 1612 | } |
4399 | 1601 | 1613 | elsif ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { | |
4400 | 1602 | if ( $ddl !~ m/CREATE (?:TEMPORARY )?TABLE `/ ) { | 1614 | die "TableParser doesn't handle CREATE TABLE without quoting."; |
4397 | 1603 | die "Cannot parse table definition; is ANSI quoting " | ||
4398 | 1604 | . "enabled or SQL_QUOTE_SHOW_CREATE disabled?"; | ||
4401 | 1605 | } | 1615 | } |
4402 | 1606 | 1616 | ||
4403 | 1607 | my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; | 1617 | my ($name) = $ddl =~ m/CREATE (?:TEMPORARY )?TABLE\s+(`.+?`)/; |
4404 | @@ -1810,19 +1820,13 @@ | |||
4405 | 1810 | my $key_ddl = $key; | 1820 | my $key_ddl = $key; |
4406 | 1811 | PTDEBUG && _d('Parsed key:', $key_ddl); | 1821 | PTDEBUG && _d('Parsed key:', $key_ddl); |
4407 | 1812 | 1822 | ||
4409 | 1813 | if ( $engine !~ m/MEMORY|HEAP/ ) { | 1823 | if ( !$engine || $engine !~ m/MEMORY|HEAP/ ) { |
4410 | 1814 | $key =~ s/USING HASH/USING BTREE/; | 1824 | $key =~ s/USING HASH/USING BTREE/; |
4411 | 1815 | } | 1825 | } |
4412 | 1816 | 1826 | ||
4413 | 1817 | my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; | 1827 | my ( $type, $cols ) = $key =~ m/(?:USING (\w+))? \((.+)\)/; |
4414 | 1818 | my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; | 1828 | my ( $special ) = $key =~ m/(FULLTEXT|SPATIAL)/; |
4415 | 1819 | $type = $type || $special || 'BTREE'; | 1829 | $type = $type || $special || 'BTREE'; |
4416 | 1820 | if ( $opts->{mysql_version} && $opts->{mysql_version} lt '004001000' | ||
4417 | 1821 | && $engine =~ m/HEAP|MEMORY/i ) | ||
4418 | 1822 | { | ||
4419 | 1823 | $type = 'HASH'; # MySQL pre-4.1 supports only HASH indexes on HEAP | ||
4420 | 1824 | } | ||
4421 | 1825 | |||
4422 | 1826 | my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; | 1830 | my ($name) = $key =~ m/(PRIMARY|`[^`]*`)/; |
4423 | 1827 | my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; | 1831 | my $unique = $key =~ m/PRIMARY|UNIQUE/ ? 1 : 0; |
4424 | 1828 | my @cols; | 1832 | my @cols; |
4425 | @@ -1848,7 +1852,7 @@ | |||
4426 | 1848 | ddl => $key_ddl, | 1852 | ddl => $key_ddl, |
4427 | 1849 | }; | 1853 | }; |
4428 | 1850 | 1854 | ||
4430 | 1851 | if ( $engine =~ m/InnoDB/i && !$clustered_key ) { | 1855 | if ( ($engine || '') =~ m/InnoDB/i && !$clustered_key ) { |
4431 | 1852 | my $this_key = $keys->{$name}; | 1856 | my $this_key = $keys->{$name}; |
4432 | 1853 | if ( $this_key->{name} eq 'PRIMARY' ) { | 1857 | if ( $this_key->{name} eq 'PRIMARY' ) { |
4433 | 1854 | $clustered_key = 'PRIMARY'; | 1858 | $clustered_key = 'PRIMARY'; |
4434 | @@ -1904,41 +1908,46 @@ | |||
4435 | 1904 | return $ddl; | 1908 | return $ddl; |
4436 | 1905 | } | 1909 | } |
4437 | 1906 | 1910 | ||
4473 | 1907 | sub remove_secondary_indexes { | 1911 | sub get_table_status { |
4474 | 1908 | my ( $self, $ddl ) = @_; | 1912 | my ( $self, $dbh, $db, $like ) = @_; |
4475 | 1909 | my $sec_indexes_ddl; | 1913 | my $q = $self->{Quoter}; |
4476 | 1910 | my $tbl_struct = $self->parse($ddl); | 1914 | my $sql = "SHOW TABLE STATUS FROM " . $q->quote($db); |
4477 | 1911 | 1915 | my @params; | |
4478 | 1912 | if ( ($tbl_struct->{engine} || '') =~ m/InnoDB/i ) { | 1916 | if ( $like ) { |
4479 | 1913 | my $clustered_key = $tbl_struct->{clustered_key}; | 1917 | $sql .= ' LIKE ?'; |
4480 | 1914 | $clustered_key ||= ''; | 1918 | push @params, $like; |
4481 | 1915 | 1919 | } | |
4482 | 1916 | my @sec_indexes = map { | 1920 | PTDEBUG && _d($sql, @params); |
4483 | 1917 | my $key_def = $_->{ddl}; | 1921 | my $sth = $dbh->prepare($sql); |
4484 | 1918 | $key_def =~ s/([\(\)])/\\$1/g; | 1922 | eval { $sth->execute(@params); }; |
4485 | 1919 | $ddl =~ s/\s+$key_def//i; | 1923 | if ($EVAL_ERROR) { |
4486 | 1920 | 1924 | PTDEBUG && _d($EVAL_ERROR); | |
4487 | 1921 | my $key_ddl = "ADD $_->{ddl}"; | 1925 | return; |
4488 | 1922 | $key_ddl .= ',' unless $key_ddl =~ m/,$/; | 1926 | } |
4489 | 1923 | $key_ddl; | 1927 | my @tables = @{$sth->fetchall_arrayref({})}; |
4490 | 1924 | } | 1928 | @tables = map { |
4491 | 1925 | grep { $_->{name} ne $clustered_key } | 1929 | my %tbl; # Make a copy with lowercased keys |
4492 | 1926 | values %{$tbl_struct->{keys}}; | 1930 | @tbl{ map { lc $_ } keys %$_ } = values %$_; |
4493 | 1927 | PTDEBUG && _d('Secondary indexes:', Dumper(\@sec_indexes)); | 1931 | $tbl{engine} ||= $tbl{type} || $tbl{comment}; |
4494 | 1928 | 1932 | delete $tbl{type}; | |
4495 | 1929 | if ( @sec_indexes ) { | 1933 | \%tbl; |
4496 | 1930 | $sec_indexes_ddl = join(' ', @sec_indexes); | 1934 | } @tables; |
4497 | 1931 | $sec_indexes_ddl =~ s/,$//; | 1935 | return @tables; |
4498 | 1932 | } | 1936 | } |
4499 | 1933 | 1937 | ||
4500 | 1934 | $ddl =~ s/,(\n\) )/$1/s; | 1938 | my $ansi_quote_re = qr/" [^"]* (?: "" [^"]* )* (?<=.) "/ismx; |
4501 | 1935 | } | 1939 | sub ansi_to_legacy { |
4502 | 1936 | else { | 1940 | my ($self, $ddl) = @_; |
4503 | 1937 | PTDEBUG && _d('Not removing secondary indexes from', | 1941 | $ddl =~ s/($ansi_quote_re)/ansi_quote_replace($1)/ge; |
4504 | 1938 | $tbl_struct->{engine}, 'table'); | 1942 | return $ddl; |
4505 | 1939 | } | 1943 | } |
4506 | 1940 | 1944 | ||
4507 | 1941 | return $ddl, $sec_indexes_ddl, $tbl_struct; | 1945 | sub ansi_quote_replace { |
4508 | 1946 | my ($val) = @_; | ||
4509 | 1947 | $val =~ s/^"|"$//g; | ||
4510 | 1948 | $val =~ s/`/``/g; | ||
4511 | 1949 | $val =~ s/""/"/g; | ||
4512 | 1950 | return "`$val`"; | ||
4513 | 1942 | } | 1951 | } |
4514 | 1943 | 1952 | ||
4515 | 1944 | sub _d { | 1953 | sub _d { |
4516 | @@ -1956,311 +1965,6 @@ | |||
4517 | 1956 | # ########################################################################### | 1965 | # ########################################################################### |
4518 | 1957 | 1966 | ||
4519 | 1958 | # ########################################################################### | 1967 | # ########################################################################### |
4520 | 1959 | # MySQLDump package | ||
4521 | 1960 | # This package is a copy without comments from the original. The original | ||
4522 | 1961 | # with comments and its test file can be found in the Bazaar repository at, | ||
4523 | 1962 | # lib/MySQLDump.pm | ||
4524 | 1963 | # t/lib/MySQLDump.t | ||
4525 | 1964 | # See https://launchpad.net/percona-toolkit for more information. | ||
4526 | 1965 | # ########################################################################### | ||
4527 | 1966 | { | ||
4528 | 1967 | package MySQLDump; | ||
4529 | 1968 | |||
4530 | 1969 | use strict; | ||
4531 | 1970 | use warnings FATAL => 'all'; | ||
4532 | 1971 | use English qw(-no_match_vars); | ||
4533 | 1972 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
4534 | 1973 | |||
4535 | 1974 | ( our $before = <<'EOF') =~ s/^ //gm; | ||
4536 | 1975 | /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; | ||
4537 | 1976 | /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */; | ||
4538 | 1977 | /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */; | ||
4539 | 1978 | /*!40101 SET NAMES utf8 */; | ||
4540 | 1979 | /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */; | ||
4541 | 1980 | /*!40103 SET TIME_ZONE='+00:00' */; | ||
4542 | 1981 | /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */; | ||
4543 | 1982 | /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */; | ||
4544 | 1983 | /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */; | ||
4545 | 1984 | /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */; | ||
4546 | 1985 | EOF | ||
4547 | 1986 | |||
4548 | 1987 | ( our $after = <<'EOF') =~ s/^ //gm; | ||
4549 | 1988 | /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; | ||
4550 | 1989 | /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; | ||
4551 | 1990 | /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; | ||
4552 | 1991 | /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */; | ||
4553 | 1992 | /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */; | ||
4554 | 1993 | /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */; | ||
4555 | 1994 | /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */; | ||
4556 | 1995 | /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */; | ||
4557 | 1996 | EOF | ||
4558 | 1997 | |||
4559 | 1998 | sub new { | ||
4560 | 1999 | my ( $class, %args ) = @_; | ||
4561 | 2000 | my $self = { | ||
4562 | 2001 | cache => 0, # Afaik no script uses this cache any longer because | ||
4563 | 2002 | }; | ||
4564 | 2003 | return bless $self, $class; | ||
4565 | 2004 | } | ||
4566 | 2005 | |||
4567 | 2006 | sub dump { | ||
4568 | 2007 | my ( $self, $dbh, $quoter, $db, $tbl, $what ) = @_; | ||
4569 | 2008 | |||
4570 | 2009 | if ( $what eq 'table' ) { | ||
4571 | 2010 | my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); | ||
4572 | 2011 | return unless $ddl; | ||
4573 | 2012 | if ( $ddl->[0] eq 'table' ) { | ||
4574 | 2013 | return $before | ||
4575 | 2014 | . 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" | ||
4576 | 2015 | . $ddl->[1] . ";\n"; | ||
4577 | 2016 | } | ||
4578 | 2017 | else { | ||
4579 | 2018 | return 'DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . ";\n" | ||
4580 | 2019 | . '/*!50001 DROP VIEW IF EXISTS ' | ||
4581 | 2020 | . $quoter->quote($tbl) . "*/;\n/*!50001 " | ||
4582 | 2021 | . $self->get_tmp_table($dbh, $quoter, $db, $tbl) . "*/;\n"; | ||
4583 | 2022 | } | ||
4584 | 2023 | } | ||
4585 | 2024 | elsif ( $what eq 'triggers' ) { | ||
4586 | 2025 | my $trgs = $self->get_triggers($dbh, $quoter, $db, $tbl); | ||
4587 | 2026 | if ( $trgs && @$trgs ) { | ||
4588 | 2027 | my $result = $before . "\nDELIMITER ;;\n"; | ||
4589 | 2028 | foreach my $trg ( @$trgs ) { | ||
4590 | 2029 | if ( $trg->{sql_mode} ) { | ||
4591 | 2030 | $result .= qq{/*!50003 SET SESSION SQL_MODE='$trg->{sql_mode}' */;;\n}; | ||
4592 | 2031 | } | ||
4593 | 2032 | $result .= "/*!50003 CREATE */ "; | ||
4594 | 2033 | if ( $trg->{definer} ) { | ||
4595 | 2034 | my ( $user, $host ) | ||
4596 | 2035 | = map { s/'/''/g; "'$_'"; } | ||
4597 | 2036 | split('@', $trg->{definer}, 2); | ||
4598 | 2037 | $result .= "/*!50017 DEFINER=$user\@$host */ "; | ||
4599 | 2038 | } | ||
4600 | 2039 | $result .= sprintf("/*!50003 TRIGGER %s %s %s ON %s\nFOR EACH ROW %s */;;\n\n", | ||
4601 | 2040 | $quoter->quote($trg->{trigger}), | ||
4602 | 2041 | @{$trg}{qw(timing event)}, | ||
4603 | 2042 | $quoter->quote($trg->{table}), | ||
4604 | 2043 | $trg->{statement}); | ||
4605 | 2044 | } | ||
4606 | 2045 | $result .= "DELIMITER ;\n\n/*!50003 SET SESSION SQL_MODE=\@OLD_SQL_MODE */;\n\n"; | ||
4607 | 2046 | return $result; | ||
4608 | 2047 | } | ||
4609 | 2048 | else { | ||
4610 | 2049 | return undef; | ||
4611 | 2050 | } | ||
4612 | 2051 | } | ||
4613 | 2052 | elsif ( $what eq 'view' ) { | ||
4614 | 2053 | my $ddl = $self->get_create_table($dbh, $quoter, $db, $tbl); | ||
4615 | 2054 | return '/*!50001 DROP TABLE IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" | ||
4616 | 2055 | . '/*!50001 DROP VIEW IF EXISTS ' . $quoter->quote($tbl) . "*/;\n" | ||
4617 | 2056 | . '/*!50001 ' . $ddl->[1] . "*/;\n"; | ||
4618 | 2057 | } | ||
4619 | 2058 | else { | ||
4620 | 2059 | die "You didn't say what to dump."; | ||
4621 | 2060 | } | ||
4622 | 2061 | } | ||
4623 | 2062 | |||
4624 | 2063 | sub _use_db { | ||
4625 | 2064 | my ( $self, $dbh, $quoter, $new ) = @_; | ||
4626 | 2065 | if ( !$new ) { | ||
4627 | 2066 | PTDEBUG && _d('No new DB to use'); | ||
4628 | 2067 | return; | ||
4629 | 2068 | } | ||
4630 | 2069 | my $sql = 'USE ' . $quoter->quote($new); | ||
4631 | 2070 | PTDEBUG && _d($dbh, $sql); | ||
4632 | 2071 | $dbh->do($sql); | ||
4633 | 2072 | return; | ||
4634 | 2073 | } | ||
4635 | 2074 | |||
4636 | 2075 | sub get_create_table { | ||
4637 | 2076 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
4638 | 2077 | if ( !$self->{cache} || !$self->{tables}->{$db}->{$tbl} ) { | ||
4639 | 2078 | my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
4640 | 2079 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
4641 | 2080 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
4642 | 2081 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
4643 | 2082 | PTDEBUG && _d($sql); | ||
4644 | 2083 | eval { $dbh->do($sql); }; | ||
4645 | 2084 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
4646 | 2085 | $self->_use_db($dbh, $quoter, $db); | ||
4647 | 2086 | $sql = "SHOW CREATE TABLE " . $quoter->quote($db, $tbl); | ||
4648 | 2087 | PTDEBUG && _d($sql); | ||
4649 | 2088 | my $href; | ||
4650 | 2089 | eval { $href = $dbh->selectrow_hashref($sql); }; | ||
4651 | 2090 | if ( $EVAL_ERROR ) { | ||
4652 | 2091 | warn "Failed to $sql. The table may be damaged.\nError: $EVAL_ERROR"; | ||
4653 | 2092 | return; | ||
4654 | 2093 | } | ||
4655 | 2094 | |||
4656 | 2095 | $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
4657 | 2096 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
4658 | 2097 | PTDEBUG && _d($sql); | ||
4659 | 2098 | $dbh->do($sql); | ||
4660 | 2099 | my ($key) = grep { m/create table/i } keys %$href; | ||
4661 | 2100 | if ( $key ) { | ||
4662 | 2101 | PTDEBUG && _d('This table is a base table'); | ||
4663 | 2102 | $self->{tables}->{$db}->{$tbl} = [ 'table', $href->{$key} ]; | ||
4664 | 2103 | } | ||
4665 | 2104 | else { | ||
4666 | 2105 | PTDEBUG && _d('This table is a view'); | ||
4667 | 2106 | ($key) = grep { m/create view/i } keys %$href; | ||
4668 | 2107 | $self->{tables}->{$db}->{$tbl} = [ 'view', $href->{$key} ]; | ||
4669 | 2108 | } | ||
4670 | 2109 | } | ||
4671 | 2110 | return $self->{tables}->{$db}->{$tbl}; | ||
4672 | 2111 | } | ||
4673 | 2112 | |||
4674 | 2113 | sub get_columns { | ||
4675 | 2114 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
4676 | 2115 | PTDEBUG && _d('Get columns for', $db, $tbl); | ||
4677 | 2116 | if ( !$self->{cache} || !$self->{columns}->{$db}->{$tbl} ) { | ||
4678 | 2117 | $self->_use_db($dbh, $quoter, $db); | ||
4679 | 2118 | my $sql = "SHOW COLUMNS FROM " . $quoter->quote($db, $tbl); | ||
4680 | 2119 | PTDEBUG && _d($sql); | ||
4681 | 2120 | my $cols = $dbh->selectall_arrayref($sql, { Slice => {} }); | ||
4682 | 2121 | |||
4683 | 2122 | $self->{columns}->{$db}->{$tbl} = [ | ||
4684 | 2123 | map { | ||
4685 | 2124 | my %row; | ||
4686 | 2125 | @row{ map { lc $_ } keys %$_ } = values %$_; | ||
4687 | 2126 | \%row; | ||
4688 | 2127 | } @$cols | ||
4689 | 2128 | ]; | ||
4690 | 2129 | } | ||
4691 | 2130 | return $self->{columns}->{$db}->{$tbl}; | ||
4692 | 2131 | } | ||
4693 | 2132 | |||
4694 | 2133 | sub get_tmp_table { | ||
4695 | 2134 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
4696 | 2135 | my $result = 'CREATE TABLE ' . $quoter->quote($tbl) . " (\n"; | ||
4697 | 2136 | $result .= join(",\n", | ||
4698 | 2137 | map { ' ' . $quoter->quote($_->{field}) . ' ' . $_->{type} } | ||
4699 | 2138 | @{$self->get_columns($dbh, $quoter, $db, $tbl)}); | ||
4700 | 2139 | $result .= "\n)"; | ||
4701 | 2140 | PTDEBUG && _d($result); | ||
4702 | 2141 | return $result; | ||
4703 | 2142 | } | ||
4704 | 2143 | |||
4705 | 2144 | sub get_triggers { | ||
4706 | 2145 | my ( $self, $dbh, $quoter, $db, $tbl ) = @_; | ||
4707 | 2146 | if ( !$self->{cache} || !$self->{triggers}->{$db} ) { | ||
4708 | 2147 | $self->{triggers}->{$db} = {}; | ||
4709 | 2148 | my $sql = '/*!40101 SET @OLD_SQL_MODE := @@SQL_MODE, ' | ||
4710 | 2149 | . q{@@SQL_MODE := REPLACE(REPLACE(@@SQL_MODE, 'ANSI_QUOTES', ''), ',,', ','), } | ||
4711 | 2150 | . '@OLD_QUOTE := @@SQL_QUOTE_SHOW_CREATE, ' | ||
4712 | 2151 | . '@@SQL_QUOTE_SHOW_CREATE := 1 */'; | ||
4713 | 2152 | PTDEBUG && _d($sql); | ||
4714 | 2153 | eval { $dbh->do($sql); }; | ||
4715 | 2154 | PTDEBUG && $EVAL_ERROR && _d($EVAL_ERROR); | ||
4716 | 2155 | $sql = "SHOW TRIGGERS FROM " . $quoter->quote($db); | ||
4717 | 2156 | PTDEBUG && _d($sql); | ||
4718 | 2157 | my $sth = $dbh->prepare($sql); | ||
4719 | 2158 | $sth->execute(); | ||
4720 | 2159 | if ( $sth->rows ) { | ||
4721 | 2160 | my $trgs = $sth->fetchall_arrayref({}); | ||
4722 | 2161 | foreach my $trg (@$trgs) { | ||
4723 | 2162 | my %trg; | ||
4724 | 2163 | @trg{ map { lc $_ } keys %$trg } = values %$trg; | ||
4725 | 2164 | push @{ $self->{triggers}->{$db}->{ $trg{table} } }, \%trg; | ||
4726 | 2165 | } | ||
4727 | 2166 | } | ||
4728 | 2167 | $sql = '/*!40101 SET @@SQL_MODE := @OLD_SQL_MODE, ' | ||
4729 | 2168 | . '@@SQL_QUOTE_SHOW_CREATE := @OLD_QUOTE */'; | ||
4730 | 2169 | PTDEBUG && _d($sql); | ||
4731 | 2170 | $dbh->do($sql); | ||
4732 | 2171 | } | ||
4733 | 2172 | if ( $tbl ) { | ||
4734 | 2173 | return $self->{triggers}->{$db}->{$tbl}; | ||
4735 | 2174 | } | ||
4736 | 2175 | return values %{$self->{triggers}->{$db}}; | ||
4737 | 2176 | } | ||
4738 | 2177 | |||
4739 | 2178 | sub get_databases { | ||
4740 | 2179 | my ( $self, $dbh, $quoter, $like ) = @_; | ||
4741 | 2180 | if ( !$self->{cache} || !$self->{databases} || $like ) { | ||
4742 | 2181 | my $sql = 'SHOW DATABASES'; | ||
4743 | 2182 | my @params; | ||
4744 | 2183 | if ( $like ) { | ||
4745 | 2184 | $sql .= ' LIKE ?'; | ||
4746 | 2185 | push @params, $like; | ||
4747 | 2186 | } | ||
4748 | 2187 | my $sth = $dbh->prepare($sql); | ||
4749 | 2188 | PTDEBUG && _d($sql, @params); | ||
4750 | 2189 | $sth->execute( @params ); | ||
4751 | 2190 | my @dbs = map { $_->[0] } @{$sth->fetchall_arrayref()}; | ||
4752 | 2191 | $self->{databases} = \@dbs unless $like; | ||
4753 | 2192 | return @dbs; | ||
4754 | 2193 | } | ||
4755 | 2194 | return @{$self->{databases}}; | ||
4756 | 2195 | } | ||
4757 | 2196 | |||
4758 | 2197 | sub get_table_status { | ||
4759 | 2198 | my ( $self, $dbh, $quoter, $db, $like ) = @_; | ||
4760 | 2199 | if ( !$self->{cache} || !$self->{table_status}->{$db} || $like ) { | ||
4761 | 2200 | my $sql = "SHOW TABLE STATUS FROM " . $quoter->quote($db); | ||
4762 | 2201 | my @params; | ||
4763 | 2202 | if ( $like ) { | ||
4764 | 2203 | $sql .= ' LIKE ?'; | ||
4765 | 2204 | push @params, $like; | ||
4766 | 2205 | } | ||
4767 | 2206 | PTDEBUG && _d($sql, @params); | ||
4768 | 2207 | my $sth = $dbh->prepare($sql); | ||
4769 | 2208 | $sth->execute(@params); | ||
4770 | 2209 | my @tables = @{$sth->fetchall_arrayref({})}; | ||
4771 | 2210 | @tables = map { | ||
4772 | 2211 | my %tbl; # Make a copy with lowercased keys | ||
4773 | 2212 | @tbl{ map { lc $_ } keys %$_ } = values %$_; | ||
4774 | 2213 | $tbl{engine} ||= $tbl{type} || $tbl{comment}; | ||
4775 | 2214 | delete $tbl{type}; | ||
4776 | 2215 | \%tbl; | ||
4777 | 2216 | } @tables; | ||
4778 | 2217 | $self->{table_status}->{$db} = \@tables unless $like; | ||
4779 | 2218 | return @tables; | ||
4780 | 2219 | } | ||
4781 | 2220 | return @{$self->{table_status}->{$db}}; | ||
4782 | 2221 | } | ||
4783 | 2222 | |||
4784 | 2223 | sub get_table_list { | ||
4785 | 2224 | my ( $self, $dbh, $quoter, $db, $like ) = @_; | ||
4786 | 2225 | if ( !$self->{cache} || !$self->{table_list}->{$db} || $like ) { | ||
4787 | 2226 | my $sql = "SHOW /*!50002 FULL*/ TABLES FROM " . $quoter->quote($db); | ||
4788 | 2227 | my @params; | ||
4789 | 2228 | if ( $like ) { | ||
4790 | 2229 | $sql .= ' LIKE ?'; | ||
4791 | 2230 | push @params, $like; | ||
4792 | 2231 | } | ||
4793 | 2232 | PTDEBUG && _d($sql, @params); | ||
4794 | 2233 | my $sth = $dbh->prepare($sql); | ||
4795 | 2234 | $sth->execute(@params); | ||
4796 | 2235 | my @tables = @{$sth->fetchall_arrayref()}; | ||
4797 | 2236 | @tables = map { | ||
4798 | 2237 | my %tbl = ( | ||
4799 | 2238 | name => $_->[0], | ||
4800 | 2239 | engine => ($_->[1] || '') eq 'VIEW' ? 'VIEW' : '', | ||
4801 | 2240 | ); | ||
4802 | 2241 | \%tbl; | ||
4803 | 2242 | } @tables; | ||
4804 | 2243 | $self->{table_list}->{$db} = \@tables unless $like; | ||
4805 | 2244 | return @tables; | ||
4806 | 2245 | } | ||
4807 | 2246 | return @{$self->{table_list}->{$db}}; | ||
4808 | 2247 | } | ||
4809 | 2248 | |||
4810 | 2249 | sub _d { | ||
4811 | 2250 | my ($package, undef, $line) = caller 0; | ||
4812 | 2251 | @_ = map { (my $temp = $_) =~ s/\n/\n# /g; $temp; } | ||
4813 | 2252 | map { defined $_ ? $_ : 'undef' } | ||
4814 | 2253 | @_; | ||
4815 | 2254 | print STDERR "# $package:$line $PID ", join(' ', @_), "\n"; | ||
4816 | 2255 | } | ||
4817 | 2256 | |||
4818 | 2257 | 1; | ||
4819 | 2258 | } | ||
4820 | 2259 | # ########################################################################### | ||
4821 | 2260 | # End MySQLDump package | ||
4822 | 2261 | # ########################################################################### | ||
4823 | 2262 | |||
4824 | 2263 | # ########################################################################### | ||
4825 | 2264 | # Daemon package | 1968 | # Daemon package |
4826 | 2265 | # This package is a copy without comments from the original. The original | 1969 | # This package is a copy without comments from the original. The original |
4827 | 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, |
4828 | @@ -2479,7 +2183,6 @@ | |||
4829 | 2479 | my $dbh; # This program's $dbh | 2183 | my $dbh; # This program's $dbh |
4830 | 2480 | my $exec_dbh; # The $dbh to use for exec and exec-plus | 2184 | my $exec_dbh; # The $dbh to use for exec and exec-plus |
4831 | 2481 | my $tp; | 2185 | my $tp; |
4832 | 2482 | my $du; | ||
4833 | 2483 | 2186 | ||
4834 | 2484 | # Functions to call while evaluating tests. | 2187 | # Functions to call while evaluating tests. |
4835 | 2485 | my %test_for = ( | 2188 | my %test_for = ( |
4836 | @@ -2774,7 +2477,6 @@ | |||
4837 | 2774 | my $need_table_struct = grep { $o->got($_); } @table_struct_tests; | 2477 | my $need_table_struct = grep { $o->got($_); } @table_struct_tests; |
4838 | 2775 | PTDEBUG && _d('Need table struct:', $need_table_struct); | 2478 | PTDEBUG && _d('Need table struct:', $need_table_struct); |
4839 | 2776 | if ( $need_table_struct ) { | 2479 | if ( $need_table_struct ) { |
4840 | 2777 | $du = new MySQLDump(); | ||
4841 | 2778 | $tp = new TableParser(Quoter => $q); | 2480 | $tp = new TableParser(Quoter => $q); |
4842 | 2779 | } | 2481 | } |
4843 | 2780 | 2482 | ||
4844 | @@ -2847,11 +2549,7 @@ | |||
4845 | 2847 | ($server_id) = $dbh->selectrow_array('SELECT @@SERVER_ID'); | 2549 | ($server_id) = $dbh->selectrow_array('SELECT @@SERVER_ID'); |
4846 | 2848 | 2550 | ||
4847 | 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. |
4853 | 2850 | my $vp = new VersionParser(); | 2552 | my $need_stored_code = grep { $o->got($_); } @stored_code_tests; |
4849 | 2851 | my $need_stored_code = $vp->version_ge($dbh, '5.0.0'); | ||
4850 | 2852 | $need_stored_code = grep { $o->got($_); } @stored_code_tests | ||
4851 | 2853 | if $need_stored_code; | ||
4852 | 2854 | PTDEBUG && _d('Need stored code:', $need_stored_code); | ||
4854 | 2855 | 2553 | ||
4855 | 2856 | # ######################################################################## | 2554 | # ######################################################################## |
4856 | 2857 | # Go do it. | 2555 | # Go do it. |
4857 | @@ -2900,8 +2598,8 @@ | |||
4858 | 2900 | if ( $need_table_struct ) { | 2598 | if ( $need_table_struct ) { |
4859 | 2901 | PTDEBUG && _d('Getting table struct for', | 2599 | PTDEBUG && _d('Getting table struct for', |
4860 | 2902 | $database, '.', $table->{Name}); | 2600 | $database, '.', $table->{Name}); |
4863 | 2903 | my $ddl = $du->get_create_table($dbh,$q, $database, $table->{Name}); | 2601 | my $ddl = $tp->get_create_table($dbh, $database, $table->{Name}); |
4864 | 2904 | if ( $ddl->[0] eq 'table' ) { | 2602 | if ( $ddl =~ m/CREATE TABLE/ ) { |
4865 | 2905 | my $table_struct; | 2603 | my $table_struct; |
4866 | 2906 | eval { $table_struct = $tp->parse($ddl) }; | 2604 | eval { $table_struct = $tp->parse($ddl) }; |
4867 | 2907 | if ( $EVAL_ERROR ) { | 2605 | if ( $EVAL_ERROR ) { |
4868 | @@ -2909,8 +2607,8 @@ | |||
4869 | 2909 | } | 2607 | } |
4870 | 2910 | $table->{struct} = $table_struct; | 2608 | $table->{struct} = $table_struct; |
4871 | 2911 | } | 2609 | } |
4874 | 2912 | elsif ( $ddl->[0] eq 'view' ) { | 2610 | else { |
4875 | 2913 | $table->{view} = $ddl->[1]; | 2611 | $table->{view} = $ddl; |
4876 | 2914 | } | 2612 | } |
4877 | 2915 | } | 2613 | } |
4878 | 2916 | } | 2614 | } |
4879 | @@ -3827,6 +3525,10 @@ | |||
4880 | 3827 | 3525 | ||
4881 | 3828 | =head1 VERSION | 3526 | =head1 VERSION |
4882 | 3829 | 3527 | ||
4883 | 3528 | <<<<<<< TREE | ||
4884 | 3830 | pt-find 2.0.5 | 3529 | pt-find 2.0.5 |
4885 | 3530 | ======= | ||
4886 | 3531 | pt-find 2.1.2 | ||
4887 | 3532 | >>>>>>> MERGE-SOURCE | ||
4888 | 3831 | 3533 | ||
4889 | 3832 | =cut | 3534 | =cut |
4890 | 3833 | 3535 | ||
4891 | === added file 'bin/pt-fingerprint' | |||
4892 | --- bin/pt-fingerprint 1970-01-01 00:00:00 +0000 | |||
4893 | +++ bin/pt-fingerprint 2012-07-20 22:10:28 +0000 | |||
4894 | @@ -0,0 +1,2143 @@ | |||
4895 | 1 | #!/usr/bin/env perl | ||
4896 | 2 | |||
4897 | 3 | # This program is part of Percona Toolkit: http://www.percona.com/software/ | ||
4898 | 4 | # See "COPYRIGHT, LICENSE, AND WARRANTY" at the end of this file for legal | ||
4899 | 5 | # notices and disclaimers. | ||
4900 | 6 | |||
4901 | 7 | use strict; | ||
4902 | 8 | use warnings FATAL => 'all'; | ||
4903 | 9 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
4904 | 10 | |||
4905 | 11 | # ########################################################################### | ||
4906 | 12 | # OptionParser package | ||
4907 | 13 | # This package is a copy without comments from the original. The original | ||
4908 | 14 | # with comments and its test file can be found in the Bazaar repository at, | ||
4909 | 15 | # lib/OptionParser.pm | ||
4910 | 16 | # t/lib/OptionParser.t | ||
4911 | 17 | # See https://launchpad.net/percona-toolkit for more information. | ||
4912 | 18 | # ########################################################################### | ||
4913 | 19 | { | ||
4914 | 20 | package OptionParser; | ||
4915 | 21 | |||
4916 | 22 | use strict; | ||
4917 | 23 | use warnings FATAL => 'all'; | ||
4918 | 24 | use English qw(-no_match_vars); | ||
4919 | 25 | use constant PTDEBUG => $ENV{PTDEBUG} || 0; | ||
4920 | 26 | |||
4921 | 27 | use List::Util qw(max); | ||
4922 | 28 | use Getopt::Long; | ||
4923 | 29 | |||
4924 | 30 | my $POD_link_re = '[LC]<"?([^">]+)"?>'; | ||
4925 | 31 | |||
4926 | 32 | sub new { | ||
4927 | 33 | my ( $class, %args ) = @_; | ||
4928 | 34 | my @required_args = qw(); | ||
4929 | 35 | foreach my $arg ( @required_args ) { | ||
4930 | 36 | die "I need a $arg argument" unless $args{$arg}; | ||
4931 | 37 | } | ||
4932 | 38 | |||
4933 | 39 | my ($program_name) = $PROGRAM_NAME =~ m/([.A-Za-z-]+)$/; | ||
4934 | 40 | $program_name ||= $PROGRAM_NAME; | ||
4935 | 41 | my $home = $ENV{HOME} || $ENV{HOMEPATH} || $ENV{USERPROFILE} || '.'; | ||
4936 | 42 | |||
4937 | 43 | my %attributes = ( | ||
4938 | 44 | 'type' => 1, | ||
4939 | 45 | 'short form' => 1, | ||
4940 | 46 | 'group' => 1, | ||
4941 | 47 | 'default' => 1, | ||
4942 | 48 | 'cumulative' => 1, | ||
4943 | 49 | 'negatable' => 1, | ||
4944 | 50 | ); | ||
4945 | 51 | |||
4946 | 52 | my $self = { | ||
4947 | 53 | head1 => 'OPTIONS', # These args are used internally | ||
4948 | 54 | skip_rules => 0, # to instantiate another Option- | ||
4949 | 55 | item => '--(.*)', # Parser obj that parses the | ||
4950 | 56 | attributes => \%attributes, # DSN OPTIONS section. Tools | ||
4951 | 57 | parse_attributes => \&_parse_attribs, # don't tinker with these args. | ||
4952 | 58 | |||
4953 | 59 | %args, | ||
4954 | 60 | |||
4955 | 61 | strict => 1, # disabled by a special rule | ||
4956 | 62 | program_name => $program_name, | ||
4957 | 63 | opts => {}, | ||
4958 | 64 | got_opts => 0, | ||
4959 | 65 | short_opts => {}, | ||
4960 | 66 | defaults => {}, | ||
4961 | 67 | groups => {}, | ||
4962 | 68 | allowed_groups => {}, | ||
4963 | 69 | errors => [], | ||
4964 | 70 | rules => [], # desc of rules for --help | ||
4965 | 71 | mutex => [], # rule: opts are mutually exclusive | ||
4966 | 72 | atleast1 => [], # rule: at least one opt is required | ||
4967 | 73 | disables => {}, # rule: opt disables other opts | ||
4968 | 74 | defaults_to => {}, # rule: opt defaults to value of other opt | ||
4969 | 75 | DSNParser => undef, | ||
4970 | 76 | default_files => [ | ||
4971 | 77 | "/etc/percona-toolkit/percona-toolkit.conf", | ||
4972 | 78 | "/etc/percona-toolkit/$program_name.conf", | ||
4973 | 79 | "$home/.percona-toolkit.conf", | ||
4974 | 80 | "$home/.$program_name.conf", | ||
4975 | 81 | ], | ||
4976 | 82 | types => { | ||
4977 | 83 | string => 's', # standard Getopt type | ||
4978 | 84 | int => 'i', # standard Getopt type | ||
4979 | 85 | float => 'f', # standard Getopt type | ||
4980 | 86 | Hash => 'H', # hash, formed from a comma-separated list | ||
4981 | 87 | hash => 'h', # hash as above, but only if a value is given | ||
4982 | 88 | Array => 'A', # array, similar to Hash | ||
4983 | 89 | array => 'a', # array, similar to hash | ||
4984 | 90 | DSN => 'd', # DSN | ||
4985 | 91 | size => 'z', # size with kMG suffix (powers of 2^10) | ||
4986 | 92 | time => 'm', # time, with an optional suffix of s/h/m/d | ||
4987 | 93 | }, | ||
4988 | 94 | }; | ||
4989 | 95 | |||
4990 | 96 | return bless $self, $class; | ||
4991 | 97 | } | ||
4992 | 98 | |||
4993 | 99 | sub get_specs { | ||
4994 | 100 | my ( $self, $file ) = @_; | ||
4995 | 101 | $file ||= $self->{file} || __FILE__; | ||
4996 | 102 | my @specs = $self->_pod_to_specs($file); | ||
4997 | 103 | $self->_parse_specs(@specs); | ||
4998 | 104 | |||
4999 | 105 | open my $fh, "<", $file or die "Cannot open $file: $OS_ERROR"; | ||
5000 | 106 | my $contents = do { local $/ = undef; <$fh> }; |
The diff has been truncated for viewing.