├── .gitignore ├── Build.PL ├── Changes ├── INSTALL ├── MANIFEST ├── MANIFEST.SKIP ├── META.json ├── META.yml ├── Makefile.PL ├── README.pod ├── bin └── altsql ├── cpanfile ├── eg ├── MyReceiver.pm ├── mysql.pgx ├── pegex.pl ├── readline_test.pl └── test.sql ├── lib └── App │ ├── AltSQL.pm │ └── AltSQL │ ├── Model.pm │ ├── Model │ ├── MySQL.pm │ ├── Pg.pm │ └── SQLite.pm │ ├── Plugin │ ├── Dump.pm │ ├── Dump │ │ ├── Format.pm │ │ └── Format │ │ │ ├── csv.pm │ │ │ ├── html.pm │ │ │ ├── json.pm │ │ │ ├── perl.pm │ │ │ ├── sql.pm │ │ │ ├── xls.pm │ │ │ ├── xml.pm │ │ │ └── yaml.pm │ └── Tail.pm │ ├── Role.pm │ ├── Term.pm │ ├── Term │ └── Plugin │ │ └── SyntaxHighlight.pm │ ├── View.pm │ └── View │ └── Plugin │ ├── Color.pm │ ├── UnicodeBox.pm │ └── VerticalSorted.pm └── t ├── 001_arguments.t ├── 002_my_cnf.t ├── 003_custom_prompt.t ├── 004_runtime_mysql.t ├── 005_sql_parse_line.t ├── lib └── My │ ├── Common.pm │ └── ModifierResub.pm └── sql ├── pagila-data.sql ├── pagila-insert-data.sql ├── pagila-schema.sql ├── sakila-data.sql └── sakila-schema.sql /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | MYMETA.yml 3 | *.swp 4 | deps/ 5 | *.bak 6 | bin/shutterstock* 7 | *.tar.gz 8 | format_test 9 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | use Module::Build; 2 | 3 | my $build = Module::Build->new( 4 | module_name => 'App::AltSQL', 5 | license => 'perl', 6 | sign => 1, 7 | configure_requires => { 8 | 'Module::Build' => 0.4, 9 | }, 10 | build_requires => { 11 | 'Test::More' => 0, 12 | 'Test::Deep' => 0, 13 | 'File::Temp' => 0, 14 | 'Data::Structure::Util' => 0, 15 | }, 16 | requires => { 17 | 'Moose' => 2.0600, 18 | 'MooseX::Object::Pluggable' => 0, 19 | 'DBI' => 0, 20 | 'DBD::mysql' => 0, 21 | 'Text::CharWidth' => 0, 22 | 'Text::UnicodeBox' => 0.03, 23 | 'Term::ANSIColor' => 0.04, 24 | 'Term::ReadLine::Zoid' => 0, 25 | 'Sys::SigAction' => 0, 26 | 'Hash::Union' => 0, 27 | 'Getopt::Long' => 2.38, 28 | 'Data::Dumper' => 0, 29 | 'Config::Any' => 0, 30 | 'JSON' => 0, 31 | 'YAML' => 0, 32 | 'perl' => '5.8.0', 33 | }, 34 | suggests => { 35 | 'DateTime' => 0, 36 | 'JSON::XS' => 0, 37 | 'DBIx::MyParsePP' => 0, 38 | 'Text::ASCIITable' => 0, 39 | 'DBD::Pg' => 0, 40 | 'DBD::SQLite' => 0, 41 | }, 42 | create_makefile_pl => 'small', 43 | meta_merge => { 44 | resources => { 45 | repository => "http://github.com/ewaters/altsql-shell", 46 | homepage => "http://ewaters.github.com/altsql-shell", 47 | bugtracker => "http://github.com/ewaters/altsql-shell/issues?labels=bug", 48 | }, 49 | }, 50 | ); 51 | 52 | $build->create_build_script; 53 | 54 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for App::AltSQL 2 | 3 | v0.05 Fri, 01 Jun 2012 12:49:25 -0400 4 | 5 | - Adding pre-release Term::Plugin::SyntaxHighlight and View::Plugin::VerticalSorted 6 | - Customizable prompt in altsql config with substitutions (and test file) 7 | - Cache autocomplete and fix minor issue with it 8 | - Allow CLI -p to override .my.cnf if empty string 9 | - Refactor Model::MySQL render_prompt into parse_prompt 10 | - Add setup() method to subclasses 11 | - View::Plugin::UnicodeBox header_reminder option (default: 100) 12 | 13 | v0.04 Tue, 29 May 2012 08:51:45 -0400 14 | 15 | - Fixing build dependency issue 16 | 17 | v0.03 Fri, 25 May 2012 15:39:15 -0400 18 | 19 | - Adding Dump plugin [contributed by https://github.com/joeshin] 20 | - Parsing of .my.cnf w/ tests [contributed by https://github.com/spikegrobstein] 21 | - Change the prompt with .my.cnf 'prompt' setting 22 | - Adding INSTALL document and some minor build changes 23 | - Use JSON instead of JSON::XS 24 | - Make non-critical dependencies optional 25 | 26 | v0.02 Fri May 18 10:33:00 2012 -0400 27 | 28 | - Remove unused dependency on Switch 29 | 30 | v0.01 Wed May 16 10:07:51 2012 -0400 31 | 32 | - Initial release 33 | 34 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | Install System Wide: 2 | ==================== 3 | 4 | Installing altsql system side is best done with the `cpan` tool you probably already have installed on your machine. 5 | 6 | $ sudo cpan 7 | 8 | cpan[1]> install App::AltSQL 9 | 10 | If you don't have cpan or if it's not configured properly, a good alternative is cpanm. If you don't have cpanm, it's pretty easy to install: 11 | 12 | $ curl -L http://cpanmin.us | perl - --sudo App::cpanminus 13 | 14 | Now install with cpanm: 15 | 16 | $ sudo cpanm App::AltSQL 17 | 18 | Install User Space: 19 | =================== 20 | 21 | 22 | If you don't have sudo access on the box you're working on, you can install altsql into your userspace fairly easily. This involves using local::lib (http://search.cpan.org/perldoc?local%3A%3Alib). 23 | 24 | NOTE: This is not recommended unless you're comfortable getting your hands a bit dirty. 25 | 26 | Step 1: Install cpanm 27 | 28 | mkdir ~/bin 29 | cd ~/bin 30 | curl -LO http://xrl.us/cpanm 31 | chmod +x cpanm 32 | 33 | Step 2: Install local::lib and setup your environment 34 | 35 | ~/bin/cpanm --local-lib=~/perl5 local::lib 36 | eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib) 37 | 38 | Step 3: Recreate this environment on future shells 39 | 40 | Bash: 41 | echo 'eval $(perl -I$HOME/perl5/lib/perl5 -Mlocal::lib)' >> ~/.bashrc 42 | 43 | C shell: 44 | perl -I$HOME/perl5/lib/perl5 -Mlocal::lib >> ~/.cshrc 45 | 46 | Step 4: Install altsql 47 | 48 | ~/bin/cpanm App::AltSQL 49 | 50 | Step 5: Run! 51 | 52 | altsql 53 | 54 | 55 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | bin/altsql 2 | Changes 3 | lib/App/AltSQL.pm 4 | lib/App/AltSQL/Model.pm 5 | lib/App/AltSQL/Model/MySQL.pm 6 | lib/App/AltSQL/Plugin/Dump.pm 7 | lib/App/AltSQL/Plugin/Dump/Format.pm 8 | lib/App/AltSQL/Plugin/Dump/Format/csv.pm 9 | lib/App/AltSQL/Plugin/Dump/Format/html.pm 10 | lib/App/AltSQL/Plugin/Dump/Format/json.pm 11 | lib/App/AltSQL/Plugin/Dump/Format/perl.pm 12 | lib/App/AltSQL/Plugin/Dump/Format/sql.pm 13 | lib/App/AltSQL/Plugin/Dump/Format/xls.pm 14 | lib/App/AltSQL/Plugin/Dump/Format/xml.pm 15 | lib/App/AltSQL/Plugin/Dump/Format/yaml.pm 16 | lib/App/AltSQL/Plugin/Tail.pm 17 | lib/App/AltSQL/Role.pm 18 | lib/App/AltSQL/Term.pm 19 | lib/App/AltSQL/View.pm 20 | lib/App/AltSQL/View/Plugin/Color.pm 21 | lib/App/AltSQL/View/Plugin/UnicodeBox.pm 22 | Build.PL 23 | Makefile.PL 24 | MANIFEST This list of files 25 | MANIFEST.SKIP 26 | META.json 27 | META.yml 28 | README.pod 29 | INSTALL 30 | t/001_arguments.t 31 | t/002_my_cnf.t 32 | t/003_custom_prompt.t 33 | t/sql/sakila-data.sql 34 | t/sql/sakila-schema.sql 35 | lib/App/AltSQL/View/Plugin/VerticalSorted.pm 36 | lib/App/AltSQL/Term/Plugin/SyntaxHighlight.pm 37 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^\.git 2 | ^\bdeps\b 3 | ^\bbin/shutterstock.+ 4 | ^MYMETA.yml$ 5 | ^_build/ 6 | ^Build 7 | ^blib/ 8 | ^MYMETA\.json$ 9 | -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "A drop in replacement to the MySQL prompt with a pluggable Perl interface", 3 | "author" : [ 4 | "Eric Waters " 5 | ], 6 | "dynamic_config" : 1, 7 | "generated_by" : "Module::Build version 0.4, CPAN::Meta::Converter version 2.120630", 8 | "license" : [ 9 | "perl_5" 10 | ], 11 | "meta-spec" : { 12 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 13 | "version" : "2" 14 | }, 15 | "name" : "App-AltSQL", 16 | "prereqs" : { 17 | "build" : { 18 | "requires" : { 19 | "Data::Structure::Util" : "0", 20 | "File::Temp" : "0", 21 | "Test::Deep" : "0", 22 | "Test::More" : "0" 23 | } 24 | }, 25 | "configure" : { 26 | "requires" : { 27 | "Module::Build" : "0.4" 28 | } 29 | }, 30 | "runtime" : { 31 | "requires" : { 32 | "Config::Any" : "0", 33 | "DBD::mysql" : "0", 34 | "DBI" : "0", 35 | "Data::Dumper" : "0", 36 | "Getopt::Long" : "2.38", 37 | "Hash::Union" : "0", 38 | "JSON" : "0", 39 | "Moose" : "2.06", 40 | "MooseX::Object::Pluggable" : "0", 41 | "Sys::SigAction" : "0", 42 | "Term::ANSIColor" : "0.04", 43 | "Term::ReadLine::Zoid" : "0", 44 | "Text::CharWidth" : "0", 45 | "Text::UnicodeBox" : "0.03", 46 | "YAML" : "0" 47 | } 48 | } 49 | }, 50 | "provides" : { 51 | "App::AltSQL" : { 52 | "file" : "lib/App/AltSQL.pm", 53 | "version" : "0.05" 54 | }, 55 | "App::AltSQL::Model" : { 56 | "file" : "lib/App/AltSQL/Model.pm", 57 | "version" : 0 58 | }, 59 | "App::AltSQL::Model::MySQL" : { 60 | "file" : "lib/App/AltSQL/Model/MySQL.pm", 61 | "version" : 0 62 | }, 63 | "App::AltSQL::Plugin::Dump" : { 64 | "file" : "lib/App/AltSQL/Plugin/Dump.pm", 65 | "version" : 0 66 | }, 67 | "App::AltSQL::Plugin::Dump::Format" : { 68 | "file" : "lib/App/AltSQL/Plugin/Dump/Format.pm", 69 | "version" : 0 70 | }, 71 | "App::AltSQL::Plugin::Dump::Format::csv" : { 72 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/csv.pm", 73 | "version" : 0 74 | }, 75 | "App::AltSQL::Plugin::Dump::Format::html" : { 76 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/html.pm", 77 | "version" : 0 78 | }, 79 | "App::AltSQL::Plugin::Dump::Format::json" : { 80 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/json.pm", 81 | "version" : 0 82 | }, 83 | "App::AltSQL::Plugin::Dump::Format::perl" : { 84 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/perl.pm", 85 | "version" : 0 86 | }, 87 | "App::AltSQL::Plugin::Dump::Format::sql" : { 88 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/sql.pm", 89 | "version" : 0 90 | }, 91 | "App::AltSQL::Plugin::Dump::Format::xls" : { 92 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/xls.pm", 93 | "version" : 0 94 | }, 95 | "App::AltSQL::Plugin::Dump::Format::xml" : { 96 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/xml.pm", 97 | "version" : 0 98 | }, 99 | "App::AltSQL::Plugin::Dump::Format::yaml" : { 100 | "file" : "lib/App/AltSQL/Plugin/Dump/Format/yaml.pm", 101 | "version" : 0 102 | }, 103 | "App::AltSQL::Plugin::Tail" : { 104 | "file" : "lib/App/AltSQL/Plugin/Tail.pm", 105 | "version" : 0 106 | }, 107 | "App::AltSQL::Role" : { 108 | "file" : "lib/App/AltSQL/Role.pm", 109 | "version" : 0 110 | }, 111 | "App::AltSQL::Term" : { 112 | "file" : "lib/App/AltSQL/Term.pm", 113 | "version" : 0 114 | }, 115 | "App::AltSQL::Term::Plugin::SyntaxHighlight" : { 116 | "file" : "lib/App/AltSQL/Term/Plugin/SyntaxHighlight.pm", 117 | "version" : 0 118 | }, 119 | "App::AltSQL::View" : { 120 | "file" : "lib/App/AltSQL/View.pm", 121 | "version" : 0 122 | }, 123 | "App::AltSQL::View::Plugin::Color" : { 124 | "file" : "lib/App/AltSQL/View/Plugin/Color.pm", 125 | "version" : 0 126 | }, 127 | "App::AltSQL::View::Plugin::UnicodeBox" : { 128 | "file" : "lib/App/AltSQL/View/Plugin/UnicodeBox.pm", 129 | "version" : 0 130 | }, 131 | "App::AltSQL::View::Plugin::VerticalSorted" : { 132 | "file" : "lib/App/AltSQL/View/Plugin/VerticalSorted.pm", 133 | "version" : 0 134 | } 135 | }, 136 | "release_status" : "stable", 137 | "resources" : { 138 | "bugtracker" : { 139 | "web" : "http://github.com/ewaters/altsql-shell/issues?labels=bug" 140 | }, 141 | "homepage" : "http://ewaters.github.com/altsql-shell", 142 | "license" : [ 143 | "http://dev.perl.org/licenses/" 144 | ], 145 | "repository" : { 146 | "url" : "http://github.com/ewaters/altsql-shell" 147 | } 148 | }, 149 | "version" : "0.05" 150 | } 151 | -------------------------------------------------------------------------------- /META.yml: -------------------------------------------------------------------------------- 1 | --- 2 | abstract: 'A drop in replacement to the MySQL prompt with a pluggable Perl interface' 3 | author: 4 | - 'Eric Waters ' 5 | build_requires: 6 | Data::Structure::Util: 0 7 | File::Temp: 0 8 | Test::Deep: 0 9 | Test::More: 0 10 | configure_requires: 11 | Module::Build: 0.4 12 | dynamic_config: 1 13 | generated_by: 'Module::Build version 0.4, CPAN::Meta::Converter version 2.120630' 14 | license: perl 15 | meta-spec: 16 | url: http://module-build.sourceforge.net/META-spec-v1.4.html 17 | version: 1.4 18 | name: App-AltSQL 19 | provides: 20 | App::AltSQL: 21 | file: lib/App/AltSQL.pm 22 | version: 0.05 23 | App::AltSQL::Model: 24 | file: lib/App/AltSQL/Model.pm 25 | version: 0 26 | App::AltSQL::Model::MySQL: 27 | file: lib/App/AltSQL/Model/MySQL.pm 28 | version: 0 29 | App::AltSQL::Plugin::Dump: 30 | file: lib/App/AltSQL/Plugin/Dump.pm 31 | version: 0 32 | App::AltSQL::Plugin::Dump::Format: 33 | file: lib/App/AltSQL/Plugin/Dump/Format.pm 34 | version: 0 35 | App::AltSQL::Plugin::Dump::Format::csv: 36 | file: lib/App/AltSQL/Plugin/Dump/Format/csv.pm 37 | version: 0 38 | App::AltSQL::Plugin::Dump::Format::html: 39 | file: lib/App/AltSQL/Plugin/Dump/Format/html.pm 40 | version: 0 41 | App::AltSQL::Plugin::Dump::Format::json: 42 | file: lib/App/AltSQL/Plugin/Dump/Format/json.pm 43 | version: 0 44 | App::AltSQL::Plugin::Dump::Format::perl: 45 | file: lib/App/AltSQL/Plugin/Dump/Format/perl.pm 46 | version: 0 47 | App::AltSQL::Plugin::Dump::Format::sql: 48 | file: lib/App/AltSQL/Plugin/Dump/Format/sql.pm 49 | version: 0 50 | App::AltSQL::Plugin::Dump::Format::xls: 51 | file: lib/App/AltSQL/Plugin/Dump/Format/xls.pm 52 | version: 0 53 | App::AltSQL::Plugin::Dump::Format::xml: 54 | file: lib/App/AltSQL/Plugin/Dump/Format/xml.pm 55 | version: 0 56 | App::AltSQL::Plugin::Dump::Format::yaml: 57 | file: lib/App/AltSQL/Plugin/Dump/Format/yaml.pm 58 | version: 0 59 | App::AltSQL::Plugin::Tail: 60 | file: lib/App/AltSQL/Plugin/Tail.pm 61 | version: 0 62 | App::AltSQL::Role: 63 | file: lib/App/AltSQL/Role.pm 64 | version: 0 65 | App::AltSQL::Term: 66 | file: lib/App/AltSQL/Term.pm 67 | version: 0 68 | App::AltSQL::Term::Plugin::SyntaxHighlight: 69 | file: lib/App/AltSQL/Term/Plugin/SyntaxHighlight.pm 70 | version: 0 71 | App::AltSQL::View: 72 | file: lib/App/AltSQL/View.pm 73 | version: 0 74 | App::AltSQL::View::Plugin::Color: 75 | file: lib/App/AltSQL/View/Plugin/Color.pm 76 | version: 0 77 | App::AltSQL::View::Plugin::UnicodeBox: 78 | file: lib/App/AltSQL/View/Plugin/UnicodeBox.pm 79 | version: 0 80 | App::AltSQL::View::Plugin::VerticalSorted: 81 | file: lib/App/AltSQL/View/Plugin/VerticalSorted.pm 82 | version: 0 83 | requires: 84 | Config::Any: 0 85 | DBD::mysql: 0 86 | DBI: 0 87 | Data::Dumper: 0 88 | Getopt::Long: 2.38 89 | Hash::Union: 0 90 | JSON: 0 91 | Moose: 2.06 92 | MooseX::Object::Pluggable: 0 93 | Sys::SigAction: 0 94 | Term::ANSIColor: 0.04 95 | Term::ReadLine::Zoid: 0 96 | Text::CharWidth: 0 97 | Text::UnicodeBox: 0.03 98 | YAML: 0 99 | resources: 100 | bugtracker: http://github.com/ewaters/altsql-shell/issues?labels=bug 101 | homepage: http://ewaters.github.com/altsql-shell 102 | license: http://dev.perl.org/licenses/ 103 | repository: http://github.com/ewaters/altsql-shell 104 | version: 0.05 105 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # Note: this file was auto-generated by Module::Build::Compat version 0.40 2 | use Module::Build::Compat 0.02; 3 | 4 | Module::Build::Compat->run_build_pl(args => \@ARGV); 5 | require Module::Build; 6 | Module::Build::Compat->write_makefile(build_class => 'Module::Build'); 7 | -------------------------------------------------------------------------------- /README.pod: -------------------------------------------------------------------------------- 1 | =encoding utf-8 2 | 3 | =head1 NAME 4 | 5 | App::AltSQL - A drop in replacement to the MySQL prompt with a pluggable Perl interface 6 | 7 | =head1 SYNOPSIS 8 | 9 | ./altsql -h -u -D -p 10 | 11 | altsql> select * from film limit 4; 12 | ╒═════════╤══════════════════╤════════════════════════════ 13 | │ film_id │ title │ description 14 | ╞═════════╪══════════════════╪════════════════════════════ 15 | │ 1 │ ACADEMY DINOSAUR │ A Epic Drama of a Feminist 16 | │ 2 │ ACE GOLDFINGER │ A Astounding Epistle of a D 17 | │ 3 │ ADAPTATION HOLES │ A Astounding Reflection of 18 | │ 4 │ AFFAIR PREJUDICE │ A Fanciful Documentary of a 19 | ╘═════════╧══════════════════╧════════════════════════════ 20 | 4 rows in set (0.00 sec) 21 | 22 | =head1 DESCRIPTION 23 | 24 | AltSQL is a way to improve your user experience with C, C, C and other tools that Perl has L drivers for. Currently written for MySQL only, the long term goal of this project is to provide users of the various SQL-based databases with a familiar command line interface but with modern improvements such as color, unicode box tables, and tweaks to the user interface that are fast and easy to prototype and experiment with. 25 | 26 | =head1 INSTALLATION 27 | 28 | It's best to use CPAN or L to install this application. Should be as simple as: 29 | 30 | $ sudo cpanm App::AltSQL 31 | 32 | =head1 COPYRIGHT 33 | 34 | Copyright (c) 2012 Eric Waters and Shutterstock Images (http://shutterstock.com). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 35 | 36 | The full text of the license can be found in the LICENSE file included with this module. 37 | 38 | =head1 AUTHOR 39 | 40 | Eric Waters 41 | 42 | =cut 43 | 44 | -------------------------------------------------------------------------------- /bin/altsql: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use App::AltSQL; 6 | 7 | my $c = App::AltSQL->new_from_cli(); 8 | $c->run(); 9 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires 'Moose', '2.0600'; 2 | requires 'MooseX::Object::Pluggable'; 3 | requires 'DBD::mysql'; 4 | requires 'Text::CharWidth'; 5 | requires 'Text::UnicodeBox'; 6 | requires 'Term::ANSIColor'; 7 | requires 'Term::ReadLine::Zoid'; 8 | requires 'Sys::SigAction'; 9 | requires 'Hash::Union'; 10 | requires 'Getopt::Long'; 11 | requires 'Data::Dumper'; 12 | requires 'Config::Any'; 13 | requires 'JSON'; 14 | requires 'YAML'; 15 | 16 | on 'test' => sub { 17 | requires 'Test::More'; 18 | requires 'Test::Deep'; 19 | requires 'File::Temp'; 20 | requires 'Data::Structure::Util'; 21 | }; 22 | 23 | recommends 'DateTime'; 24 | recommends 'JSON::XS'; 25 | recommends 'DBIx::MyParsePP'; 26 | recommends 'Text::ASCIITable'; 27 | recommends 'DBD::Pg'; 28 | recommends 'DBD::SQLite'; 29 | -------------------------------------------------------------------------------- /eg/MyReceiver.pm: -------------------------------------------------------------------------------- 1 | package MyReceiver; 2 | 3 | use strict; 4 | use warnings; 5 | use base 'Pegex::Receiver'; 6 | use Data::Dumper; 7 | 8 | sub got_name { 9 | my ($self, $name) = @_; 10 | printf "Got name %s at position %d\n", 11 | $name, 12 | $self->parser->position; 13 | return { name => $name }; 14 | } 15 | 16 | sub got_is { 17 | my ($self) = @_; 18 | return; 19 | } 20 | 21 | sub got_age { 22 | my ($self, $age) = @_; 23 | print "Got age $age\n"; 24 | return { age => $age }; 25 | } 26 | 27 | sub got_age_assertion { 28 | my ($self, $parts) = @_; 29 | print Dumper($parts); 30 | # Collapse the hashes into one 31 | my %assertion = map {+( %$_ )} @$parts; 32 | print Dumper(\%assertion); 33 | } 34 | 35 | 1; 36 | -------------------------------------------------------------------------------- /eg/mysql.pgx: -------------------------------------------------------------------------------- 1 | # %grammar mysql 2 | # %version 5.5 3 | 4 | mysql_statement: 5 | + 6 | 7 | #ALTER {DATABASE | SCHEMA} [db_name] 8 | #alter_specification ... 9 | #ALTER {DATABASE | SCHEMA} db_name 10 | #UPGRADE DATA DIRECTORY NAME 11 | # 12 | #alter_specification: 13 | #[DEFAULT] CHARACTER SET [=] charset_name 14 | # | [DEFAULT] COLLATE [=] collation_name 15 | 16 | age_assertion: 17 | 18 | 19 | 20 | 21 | 22 | name: /([A-Za-z]+)/ 23 | age: /(\d+)/ 24 | is: + /is/ + 25 | 26 | test: 27 | /Eric/ 28 | 29 | alter_database: 30 | /alter+(?:database|schema)+/ 31 | 32 | /+upgrade+data+directory+name/ 33 | 34 | semicolon: /;/ 35 | 36 | db_name: /a-z0-9/ 37 | -------------------------------------------------------------------------------- /eg/pegex.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | use Pegex; 6 | 7 | 8 | -------------------------------------------------------------------------------- /eg/readline_test.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | BEGIN { 7 | $ENV{PERL_RL} = 'Gnu'; 8 | } 9 | 10 | use Term::ReadLine; 11 | use Term::ReadLine::Gnu; 12 | use Term::ANSIColor; 13 | 14 | my $term = Term::ReadLine->new('Testing'); 15 | my $attr = $term->Attribs; 16 | $term->ornaments(''); 17 | 18 | $term->add_defun(my_bind_cr => sub { 19 | if ($attr->{line_buffer} =~ m{;\s*$}m) { 20 | $attr->{done} = 1; 21 | print "\n"; 22 | } 23 | else { 24 | $term->insert_text("\n"); 25 | } 26 | }); 27 | $term->add_defun(my_abort => sub { 28 | print "Abort!\n"; 29 | }); 30 | $term->bind_key(ord "\r", 'my_bind_cr'); 31 | $term->bind_key(ord "\n", 'my_bind_cr'); 32 | $term->bind_key(ord "\cc", 'my_abort'); 33 | 34 | { 35 | local $SIG{INT} = sub {}; 36 | while (defined (my $input = $term->readline(colored('prompt', 'red') . '> '))) { 37 | if ($input =~ m{^quit}) { 38 | last; 39 | } 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /eg/test.sql: -------------------------------------------------------------------------------- 1 | Eric is 32 2 | Colleen is 23 3 | -------------------------------------------------------------------------------- /lib/App/AltSQL.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL; 2 | 3 | =encoding utf-8 4 | 5 | =head1 NAME 6 | 7 | App::AltSQL - A drop in replacement to the MySQL prompt with a pluggable Perl interface 8 | 9 | =head1 SYNOPSIS 10 | 11 | ./altsql -h -u -D -p 12 | 13 | altsql> select * from film limit 4; 14 | ╒═════════╤══════════════════╤════════════════════════════ 15 | │ film_id │ title │ description 16 | ╞═════════╪══════════════════╪════════════════════════════ 17 | │ 1 │ ACADEMY DINOSAUR │ A Epic Drama of a Feminist 18 | │ 2 │ ACE GOLDFINGER │ A Astounding Epistle of a D 19 | │ 3 │ ADAPTATION HOLES │ A Astounding Reflection of 20 | │ 4 │ AFFAIR PREJUDICE │ A Fanciful Documentary of a 21 | ╘═════════╧══════════════════╧════════════════════════════ 22 | 4 rows in set (0.00 sec) 23 | 24 | =head1 DESCRIPTION 25 | 26 | AltSQL is a way to improve your user experience with C, C, C and other tools that Perl has L drivers for. Currently written for MySQL only, the long term goal of this project is to provide users of the various SQL-based databases with a familiar command line interface but with modern improvements such as color, unicode box tables, and tweaks to the user interface that are fast and easy to prototype and experiment with. 27 | 28 | There are a few key issues that this programmer has had with using the mysql client every day. After looking for alternatives and other ways to fix the problems, reimplementing the client in Perl seemed like the easiest approach, and lent towards the greatest possible adoption by my peers. Here are a few of those issues: 29 | 30 | =over 4 31 | 32 | =item Ctrl-C kills the program 33 | 34 | All of the shells that we used on a daily basis allow you to abandon the half-written statement on the prompt by typing Ctrl-C. Spending all day in shells, you expect this behavior to be consistent, but you do this in mysql and you will be thrown to the street. Let's do what I mean, and abandon the statement. 35 | 36 | =item Wide output wraps 37 | 38 | We are grateful that mysql at least uses ASCII art for table formatting (unlike C for some reason). But there are some tables that I work with that have many columns, with long names (it's often easier to keep adding columns to a table over time). As a result, when you perform a simple `select * from fim limit 4` you quickly find your terminal overwhelmed by useless ASCII art attempting (and mostly failing) to provide any semblance of meaning from the result. You can throw a '\G' onto the command, but if it took 10 seconds to execute and you locked tables while doing it, you could be slowing down your website or letting your slave fall behind on sync. 39 | 40 | Suffice it to say, it's a much better experience if, just like with C, wide output is left wide, and you are optionally able to scroll horizontally with your arrow keys like you wanted in the first place. 41 | 42 | =item Color 43 | 44 | Most other modern programs we developers use on a daily basis (vim, ls, top, git, tmux, screen) offer to provide additional context to you via color. By consistently setting colors on a variable type or file type, programs can convey to us additional context that allows us to better grasp and understand what's happening. They help us be smarter and faster at our jobs, and detect when we've made a mistake. There's no reason we shouldn't use color to make it obvious which column(s) form the primary key of a table, or which columns are a number type or string type. The DBI statement handler contains lots of context, and we can interrogate the C tables in mysql for even more. 45 | 46 | =item Unicode Box characters 47 | 48 | The usage of '|', '+' and '-' for drawing tables and formatting data seems a bit antiquated. Other tools are adopting Unicode characters, and most programmers are now using terminal programs that support Unicode and UTF8 encoding natively. The Unicode box symbol set allows seamless box drawing which allows you to read between the lines, so to speak. It is less obtrusive, and combining this with color you can create a more useful and clear user experience. 49 | 50 | =back 51 | 52 | I've thought of a number of other features, but so too have my coworkers and friends. Most people I've spoken with have ideas for future features. Next time you're using your DB shell and find yourself irritated at a feature or bug in the software that you feel could be done much better, file a feature request or, better yet, write your own plugins. 53 | 54 | =head1 CONFIGURATION 55 | 56 | The command line arguments inform how to connect to the database, whereas the configuration file(s) provide behavior and features of the UI. 57 | 58 | =head2 Command Line 59 | 60 | The following options are available. 61 | 62 | =over 4 63 | 64 | =item -h HOSTNAME | --host HOSTNAME 65 | 66 | =item -u USERNAME | --user USERNAME 67 | 68 | =item -p | --password=PASSWORD | -pPASSWORD 69 | 70 | =item --port PORT 71 | 72 | =item -D DATABASE | --database DATABASE 73 | 74 | Basic connection parameters to the MySQL database. 75 | 76 | =item --A | --no-auto-rehash 77 | 78 | By default, upon startup and whenever the database is changed, the C tables will be read to perform tab completion. Disable this behavior to get a faster startup time (but no tab complete). 79 | 80 | =back 81 | 82 | =head2 Config File 83 | 84 | We are using L for finding and parsing the configuration file. You may use any format you'd like to write it so long as it's support in C. 85 | 86 | =over 4 87 | 88 | =item /etc/altsql.(yml|cnf|ini|js|pl) 89 | 90 | =item ~/.altsql.(yml|cnf|ini|js|pl) 91 | 92 | Write your configuration file to either the system or the local configuration locations. The local file will inherit from the global configuration but with local modifications. For purposes of this example I'll be writing out the config in YAML, but again any other compatible format would do just as well. 93 | 94 | =back 95 | 96 | --- 97 | prompt: 'altsql> ' 98 | 99 | plugins: 100 | - Tail 101 | - Dump 102 | 103 | view_plugins: 104 | - Color 105 | - UnicodeBox 106 | 107 | App::AltSQL::View::Plugin::Color: 108 | header_text: 109 | default: red 110 | cell_text: 111 | is_null: blue 112 | is_primary_key: bold 113 | is_number: yellow 114 | 115 | App::AltSQL::View::Plugin::UnicodeBox: 116 | style: heavy_header 117 | split_lines: 1 118 | plain_ascii: 0 119 | 120 | This is the default configuration, and currently encompasses all the configurable settings. This should be future safe; as you can see, plugins may use this file for their own variables as there are namespaced sections. 121 | 122 | =over 4 123 | 124 | =item B 125 | 126 | prompt: "%u@%h[%d]> " 127 | # 'username@hostname[database]> ' 128 | prompt: "%c{red}%u%c{reset} %t{%F %T}> ' 129 | # 'username' (in red) ' YYYY-MM-DD HH:MM:SS> ' 130 | 131 | Provide a custom prompt. The following variables will be interpolated: 132 | 133 | =over 4 134 | 135 | =item B<%u> 136 | 137 | The username used to connect to the model 138 | 139 | =item B<%d> 140 | 141 | The current database or '(none)' 142 | 143 | =item B<%h> 144 | 145 | The hostname the model is connected to 146 | 147 | =item B<%%> 148 | 149 | An escaped percent sign 150 | 151 | =item B<%c{...}> 152 | 153 | A L color name. The value will be passed directly to the C method. 154 | 155 | =item B<%e{...}> 156 | 157 | A block to be eval'ed. You may use $self to refer to the L object 158 | 159 | =item B<%t{...}> 160 | 161 | The argument to this option will be passed to L C for the current time 162 | 163 | =back 164 | 165 | =item B 166 | 167 | An array of plugin names for the main namespace. 168 | 169 | =item B 170 | 171 | An array of View plugin names to be applied to each View object created 172 | 173 | =back 174 | 175 | =head1 EXTENDING 176 | 177 | As mentioned above, one key point of this project is to make it easy for people to extend. For this reason, I've built it on L and offer a L interface. If you extend C, you may want to know about the following methods. 178 | 179 | =cut 180 | 181 | use Class::Load qw(load_class); 182 | use Moose; 183 | use Getopt::Long qw(GetOptionsFromArray); 184 | use Data::Dumper; 185 | use Config::Any; 186 | use Hash::Union qw(union); 187 | 188 | our $VERSION = 0.05; 189 | our $| = 1; 190 | 191 | # Don't emit 'Wide character in output' warnings 192 | binmode STDOUT, ':utf8'; 193 | 194 | with 'MooseX::Object::Pluggable'; 195 | 196 | my @_config_stems = ( '/etc/altsql', "$ENV{HOME}/.altsql" ); 197 | my %_default_classes = ( 198 | term => 'App::AltSQL::Term', 199 | view => 'App::AltSQL::View', 200 | model => 'App::AltSQL::Model::MySQL', 201 | ); 202 | our %default_config = ( 203 | plugins => [ 'Tail', 'Dump' ], 204 | view_plugins => [ 'Color', 'UnicodeBox' ], 205 | term_plugins => [ 'SyntaxHighlight' ], 206 | ); 207 | 208 | =head2 Accessors 209 | 210 | =over 4 211 | 212 | =item term - the singleton L (or subclass) instance 213 | 214 | =item view - the class in which all table output will be accomplished (defaults to L) 215 | 216 | =item model - where the database calls happen (L) 217 | 218 | =cut 219 | 220 | has ['term', 'view', 'model'] => (is => 'ro'); 221 | 222 | =item args 223 | 224 | Hash of the command line arguments 225 | 226 | =item config 227 | 228 | Hash of the file configuration 229 | 230 | =back 231 | 232 | =cut 233 | 234 | has ['args', 'config'] => (is => 'rw'); 235 | 236 | ## Configure 237 | 238 | sub args_spec { 239 | return ( 240 | help => { 241 | cli => 'help|?', 242 | help => '--help', 243 | description => 'Displays this help message and exits', 244 | }, 245 | ); 246 | } 247 | 248 | sub BUILD { 249 | my $self = shift; 250 | 251 | foreach my $subclass (qw(term view model)) { 252 | # Extract out subclass args from args 253 | my %args = ( 254 | map { my $key = $_; /^_${subclass}_(.+)/; +($1 => delete $self->args->{$key}) } 255 | grep { /^_${subclass}_/ } 256 | keys %{ $self->args } 257 | ); 258 | 259 | my $subclass_name = $self->args->{"${subclass}_class"}; 260 | 261 | load_class($subclass_name); 262 | 263 | if ($subclass eq 'view') { 264 | # We don't have one view per class; we create it per statement 265 | $self->args->{view_args} = \%args; 266 | } 267 | else { 268 | $self->{$subclass} = $subclass_name->new({ 269 | app => $self, 270 | %args, 271 | }); 272 | } 273 | } 274 | 275 | # Call setup on each subclass now that they're all created 276 | foreach my $subclass (qw(term model)) { 277 | $self->{$subclass}->setup(); 278 | } 279 | 280 | $self->model->db_connect(); 281 | } 282 | 283 | =head2 parse_cli_args \@ARGV 284 | 285 | Called in C to collect command line arguments and return a hashref 286 | 287 | =cut 288 | 289 | sub parse_cli_args { 290 | my ($class, $argv, %args) = @_; 291 | my @argv = defined $argv ? @$argv : (); 292 | 293 | # Read in the args_spec() from each subclass we'll be using 294 | my %opts_spec; 295 | $args{term_class} ||= $_default_classes{term}; 296 | $args{view_class} ||= $_default_classes{view}; 297 | $args{model_class} ||= $_default_classes{model}; 298 | 299 | foreach my $args_class ('main', 'view', 'term', 'model') { 300 | if ($args_class eq 'main') { 301 | my %args_spec = $class->args_spec(); 302 | foreach my $arg (keys %args_spec) { 303 | next unless $args_spec{$arg}{cli}; 304 | $opts_spec{ $args_spec{$arg}{cli} } = \$args{$arg}; 305 | } 306 | } 307 | else { 308 | my $args_classname = $args{"${args_class}_class"}; 309 | load_class($args_classname); 310 | my %args_spec = $args_classname->args_spec(); 311 | foreach my $key (keys %args_spec) { 312 | next unless $args_spec{$key}{cli}; 313 | $opts_spec{ $args_spec{$key}{cli} } = \$args{"_${args_class}_$key"}; 314 | if (my $default = $args_spec{$key}{default}) { 315 | $args{"_${args_class}_$key"} = $default; 316 | } 317 | } 318 | } 319 | } 320 | 321 | # Password is a special case 322 | foreach my $i (0..$#argv) { 323 | my $arg = $argv[$i]; 324 | next unless $arg =~ m{^(?:-p|--password=)(.*)$}; 325 | splice @argv, $i, 1; 326 | if (length $1) { 327 | $args{_model_password} = $1; 328 | # Remove the password from the program name so people can't see it in process listings 329 | $0 = join ' ', $0, @argv; 330 | } 331 | else { 332 | # Prompt the user for the password 333 | require Term::ReadKey; 334 | Term::ReadKey::ReadMode('noecho'); 335 | print "Enter password: "; 336 | $args{_model_password} = Term::ReadKey::ReadLine(0); 337 | Term::ReadKey::ReadMode('normal'); 338 | print "\n"; 339 | chomp $args{_model_password}; 340 | } 341 | last; # I've found what I was looking for 342 | } 343 | 344 | GetOptionsFromArray(\@argv, %opts_spec); 345 | 346 | # Database is a special case; if left over arguments, that's the database name 347 | if (@argv && int @argv == 1) { 348 | $args{_model_database} = $argv[0]; 349 | } 350 | 351 | return \%args; 352 | } 353 | 354 | =head2 resolve_namespace_config_value $namespace, $key | [ $key1, $key2, ... ], \%default_config 355 | 356 | $self->resolve_namespace_config_value('MyApp', 'timeout', { timeout => 60 }); 357 | # Will search $self->config->{MyApp}{timeout} and will return that or the default 60 if not present 358 | 359 | Provides plugin authors with easy access to the configuration file. Provide either an arrayref of keys for deep hash matching or a single key for a two dimensional hash. 360 | 361 | =cut 362 | 363 | sub resolve_namespace_config_value { 364 | my ($self, $namespace, $key_or_keys, $default_config) = @_; 365 | 366 | my $return; 367 | my $cache_key = join ':', $namespace, ref $key_or_keys ? @$key_or_keys : $key_or_keys; 368 | if (exists $self->{_resolve_namespace_config_value_cache}{$cache_key}) { 369 | return $self->{_resolve_namespace_config_value_cache}{$cache_key}; 370 | } 371 | 372 | if (ref $key_or_keys && int @$key_or_keys > 1) { 373 | my @keys = @$key_or_keys; 374 | my $first_key = shift @keys; 375 | my $default_hash = $default_config->{$first_key}; 376 | my $defined_hash = $self->get_namespace_config_value($namespace, $first_key) || {}; 377 | my $config = union([ $default_hash, $defined_hash ]); 378 | $return = _find_hash_value($config, @keys); 379 | } 380 | else { 381 | my $default = $default_config->{$key_or_keys}; 382 | my $defined = $self->get_namespace_config_value($namespace, $key_or_keys) || undef; 383 | $return = defined $defined ? $defined : $default; 384 | } 385 | 386 | $self->{_resolve_namespace_config_value_cache}{$cache_key} = $return; 387 | return $return; 388 | } 389 | 390 | sub _find_hash_value { 391 | my ($config, @keys) = @_; 392 | my $key = shift @keys; 393 | return undef if ! defined $key; 394 | return undef if ! exists $config->{$key}; 395 | my $value = $config->{$key}; 396 | if (ref $value && ref $value eq 'HASH') { 397 | return _find_hash_value($value, @keys); 398 | } 399 | return $value; 400 | } 401 | 402 | =head2 get_namespace_config_value $namespace, $key 403 | 404 | Return a config value of the given key in the namespace. Returns empty list if non-existant. 405 | 406 | =cut 407 | 408 | sub get_namespace_config_value { 409 | my ($self, $namespace, $key) = @_; 410 | my $config = $self->config->{$namespace}; 411 | return unless defined $config; 412 | return $config->{$key}; 413 | } 414 | 415 | =head2 read_config_file 416 | 417 | Will read in all the config file(s) and return the config they represent 418 | 419 | =cut 420 | 421 | sub read_config_file { 422 | my $class = shift; 423 | 424 | # Read system settings first, then get more specific 425 | my @configs; 426 | my $configs = Config::Any->load_stems({ stems => \@_config_stems, use_ext => 1 }); 427 | foreach my $config (@$configs) { 428 | my ($filename) = keys %$config; 429 | push @configs, $config->{$filename}; 430 | } 431 | 432 | # Merge all the hash configs together smartly 433 | return union(\@configs); 434 | } 435 | 436 | =head2 new_from_cli 437 | 438 | Called in C to read in the command line arguments and create a new instance from them and any config files found. 439 | 440 | =cut 441 | 442 | sub new_from_cli { 443 | my $class = shift; 444 | my $args = $class->parse_cli_args(\@ARGV); 445 | if ($args->{help}) { 446 | $class->show_help($args); 447 | exit; 448 | } 449 | my $config = $class->read_config_file(); 450 | my $self = $class->new(args => $args, config => $config || \%default_config); 451 | 452 | # Load in any plugins that are configured 453 | if ($self->config->{plugins}) { 454 | foreach my $plugin (@{ $self->config->{plugins} }) { 455 | $self->load_plugin($plugin); 456 | } 457 | } 458 | if ($self->config->{term_plugins}) { 459 | foreach my $plugin (@{ $self->config->{term_plugins} }) { 460 | $self->term->load_plugin($plugin); 461 | } 462 | } 463 | 464 | return $self; 465 | } 466 | 467 | =head2 run 468 | 469 | Start the shell up and enter the readline event loop. 470 | 471 | =cut 472 | 473 | sub run { 474 | my $self = shift; 475 | 476 | $self->log_info("Starting ".__PACKAGE__); 477 | 478 | my $input; 479 | while (defined ($input = $self->term->readline())) { 480 | $self->handle_term_input($input); 481 | } 482 | } 483 | 484 | =head2 shutdown 485 | 486 | Perform any cleanup steps here. 487 | 488 | =cut 489 | 490 | sub shutdown { 491 | my $self = shift; 492 | 493 | $self->term->write_history(); 494 | 495 | exit; 496 | } 497 | 498 | =head2 handle_term_input $input 499 | 500 | The user has just typed something and submitted the buffer. Do something with it. Most notably, parse it for directives and act upon them. 501 | 502 | =cut 503 | 504 | sub handle_term_input { 505 | my ($self, $input) = @_; 506 | 507 | # Next if Ctrl-C or if user typed nothing 508 | if (! length $input) { 509 | return; 510 | } 511 | 512 | $input =~ s/\s*$//; # no trailing spaces 513 | $input =~ s/;*$//; # no trailing semicolon 514 | 515 | # Support mysql '\c' clear command 516 | if ($input =~ m/\\c$/) { 517 | return; 518 | } 519 | 520 | # Extract out \G 521 | my %render_opts; 522 | if ($input =~ s/\\G$//) { 523 | $render_opts{one_row_per_column} = 1; 524 | } 525 | 526 | # Allow the user to pass non-SQL control verbs 527 | if ($input =~ m/^\s*(quit|exit)\s*$/) { 528 | return $self->shutdown(); 529 | } 530 | 531 | # Allow the user to execute perl code via '% print Dumper(...);' 532 | if (my ($perl_code) = $input =~ m/^% (.+)$/) { 533 | eval $perl_code; 534 | if ($@) { 535 | $self->log_error($@); 536 | } 537 | return; 538 | } 539 | 540 | if (my ($command) = $input =~ m/^\.([a-z_]+)\b/i) { 541 | my $handled = $self->call_command(lc($command), $input); 542 | return if $handled; 543 | } 544 | 545 | my $view = $self->model->handle_sql_input($input, \%render_opts); 546 | return $view; 547 | } 548 | 549 | =head2 call_command $command, $input 550 | 551 | Currently, the application treats any text that starts with a period as a command to the program rather then as SQL to be sent to the server. This method will be called with that command and the full line types. So, if someone typed '.reset screen', command would be 'reset' and the input woudl be '.reset screen'. This is naturally a good place to add any extensions to the SQL syntax. 552 | 553 | =cut 554 | 555 | sub call_command { 556 | my ($self, $command, $input) = @_; 557 | # Do nothing here; placeholder for plugin's to attach to 558 | return; 559 | } 560 | 561 | =head2 create_view %args 562 | 563 | Call L C, mixing in the app and command line view arguments and loading any requested plugins. 564 | 565 | =cut 566 | 567 | sub create_view { 568 | my ($self, %args) = @_; 569 | 570 | my $view = $self->args->{view_class}->new( 571 | app => $self, 572 | %args, 573 | %{ $self->args->{view_args} }, 574 | ); 575 | 576 | if (my $plugins = $self->config->{view_plugins}) { 577 | $view->load_plugins(@$plugins); 578 | } 579 | 580 | return $view; 581 | } 582 | 583 | =head2 log_info, log_debug, log_error 584 | 585 | Your basic logging methods, they all currently do the same thing. 586 | 587 | =cut 588 | 589 | sub log_info { 590 | my ($self, $message) = @_; 591 | print $message . "\n"; 592 | } 593 | 594 | sub log_debug { 595 | return log_info(@_); 596 | } 597 | 598 | sub log_error { 599 | return log_info(@_); 600 | } 601 | 602 | =head2 show_help($args) 603 | 604 | Displays the help message for this program. 605 | 606 | =cut 607 | 608 | sub show_help { 609 | my ( $class, $args ) = @_; 610 | my @labels_and_args = map { 611 | my $c = $_ eq 'main' ? $class : $args->{$_ . '_class'}; 612 | load_class($c); 613 | $_ => { $c->args_spec() } 614 | } ( 'main', qw/model term view/ ); 615 | 616 | my $max_help_length = 0; 617 | 618 | for(my $i = 0; $i < @labels_and_args; $i += 2) { 619 | my $args = $labels_and_args[$i + 1]; 620 | 621 | foreach my $spec (values %$args) { 622 | if(length($spec->{help}) > $max_help_length) { 623 | $max_help_length = length($spec->{help}); 624 | } 625 | } 626 | } 627 | 628 | my $format = '%' . $max_help_length . "s %s\n"; 629 | 630 | for(my $i = 0; $i < @labels_and_args; $i += 2) { 631 | my ( $label, $args ) = @labels_and_args[ $i, $i + 1 ]; 632 | my $tc_label = $label; 633 | $tc_label =~ s/^([a-z])/uc($1)/e; 634 | 635 | print "$tc_label Options\n"; 636 | print '-' x length("$tc_label Options"), "\n"; 637 | print "\n"; 638 | 639 | foreach my $key (sort keys %$args) { 640 | my $spec = $args->{$key}; 641 | printf $format, @{$spec}{qw/help description/}; 642 | } 643 | 644 | print "\n"; 645 | } 646 | } 647 | 648 | no Moose; 649 | __PACKAGE__->meta->make_immutable; 650 | 651 | =head1 DEVELOPMENT 652 | 653 | This module is being developed via a git repository publicly available at http://github.com/ewaters/altsql-shell. I encourage anyone who is interested to fork my code and contribute bug fixes or new features, or just have fun and be creative. 654 | 655 | =head1 COPYRIGHT 656 | 657 | Copyright (c) 2012 Eric Waters and Shutterstock Images (http://shutterstock.com). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 658 | 659 | The full text of the license can be found in the LICENSE file included with this module. 660 | 661 | =head1 AUTHOR 662 | 663 | Eric Waters 664 | 665 | =cut 666 | 667 | 1; 668 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Model.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Model; 2 | 3 | use Moose; 4 | 5 | with 'App::AltSQL::Role'; 6 | with 'MooseX::Object::Pluggable'; 7 | 8 | has 'dbh' => (is => 'rw'); 9 | has 'current_database' => (is => 'rw'); 10 | 11 | no Moose; 12 | __PACKAGE__->meta->make_immutable(); 13 | 14 | sub show_sql_error { 15 | my ($self, $input, $char_number, $line_number) = @_; 16 | 17 | my @lines = split /\n/, $input; 18 | my $line = $lines[ $line_number - 1 ]; 19 | $self->log_error("There was an error parsing the SQL statement on line $line_number:"); 20 | $self->log_error($line); 21 | $self->log_error(('-' x ($char_number - 1)) . '^'); 22 | } 23 | 24 | sub execute_sql { 25 | my ($self, $input) = @_; 26 | 27 | my $sth = $self->dbh->prepare($input); 28 | $sth->execute() if $sth; 29 | 30 | if (my $error = $self->dbh->errstr || $@) { 31 | $self->log_error($error); 32 | return; 33 | } 34 | 35 | return $sth; 36 | } 37 | 38 | sub is_end_of_statement { 39 | my ($self, $line) = @_; 40 | 41 | # first we parse to strip the strings and quotes 42 | # to prevent characters like ; appearing within strings 43 | # from making us incorrectly detect the end of the 44 | # statement. 45 | my @chars = split //, $line; 46 | my @sanitized_string; 47 | 48 | my $in_something = ''; 49 | my $last_char = ''; 50 | CHAR: while(my $char = shift @chars) { 51 | if ($in_something) { 52 | if ($last_char eq '\\' && $in_something =~ /["'`]/) { 53 | # this character is escaped. lets ignore it. 54 | $last_char = ''; 55 | next CHAR; 56 | } 57 | if ($char eq $in_something) { 58 | $in_something = ''; 59 | } 60 | if ($in_something eq '/*' && $char eq '/' && $last_char eq '*') { 61 | $in_something = ''; 62 | } 63 | if($in_something eq '--') { 64 | if($char =~ /[\r\n]/) { 65 | $in_something = ''; 66 | } 67 | } 68 | } 69 | else { 70 | for my $start (qw/' " `/) { 71 | if ($char eq $start) { 72 | if ($last_char eq '\\') { 73 | last; 74 | # it's escaped 75 | } 76 | $in_something = $start; 77 | } 78 | } 79 | if ($char eq '*') { 80 | if ($last_char eq '/') { 81 | $in_something = '/*'; 82 | pop @sanitized_string; 83 | } 84 | } 85 | if ($char eq '-') { 86 | if ($last_char eq '-') { 87 | $in_something = '--'; 88 | pop @sanitized_string; 89 | } 90 | } 91 | unless($in_something) { 92 | push @sanitized_string, $char; 93 | } 94 | } 95 | $last_char = $char; 96 | } 97 | if ($in_something eq '--') { 98 | $in_something = ''; 99 | } 100 | return 0 if $in_something; 101 | 102 | $line = join '', @sanitized_string; 103 | # If the buffer ends in ';' or '\G', or 104 | # if they've typed the bare word 'quit' or 'exit', accept the buffer 105 | if ($line =~ m{(;|\\G|\\c)\s*$} || $line =~ m{^\s*(quit|exit)\s*$} || $line =~ m{^\s*$}) { 106 | return 1; 107 | } 108 | else { 109 | return 0; 110 | } 111 | } 112 | 113 | 1; 114 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Model/MySQL.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Model::MySQL; 2 | 3 | =head1 NAME 4 | 5 | App::AltSQL::Model::MySQL 6 | 7 | =head1 DESCRIPTION 8 | 9 | This module is currently the only Model supported by L. 10 | 11 | Upon startup, we will read in C<$HOME/.my.cnf> and will read and respect the following configuration variables: 12 | 13 | =over 4 14 | 15 | =item B 16 | 17 | =item B 18 | 19 | =item B 20 | 21 | =item B 22 | 23 | =item B 24 | 25 | =item B 26 | 27 | =item B 28 | 29 | =item B 30 | 31 | =back 32 | 33 | =cut 34 | 35 | use Moose; 36 | use DBI; 37 | use Sys::SigAction qw(set_sig_handler); 38 | use Time::HiRes qw(gettimeofday tv_interval); 39 | 40 | extends 'App::AltSQL::Model'; 41 | 42 | has 'sql_parser' => (is => 'ro', default => sub { 43 | # Let this be deferred until it's needed, and okay for us to proceed if it's not present 44 | eval { 45 | require DBIx::MyParsePP; 46 | }; 47 | if ($@) { 48 | return 0; # when we use this we check for definedness as well as boolean 49 | } 50 | return DBIx::MyParsePP->new(); 51 | }); 52 | 53 | has [qw(host user password database port)] => ( is => 'ro' ); 54 | has [qw(no_auto_rehash select_limit safe_update prompt)] => ( is => 'ro' ); 55 | 56 | sub args_spec { 57 | return ( 58 | host => { 59 | cli => 'host|h=s', 60 | help => '-h HOSTNAME | --host HOSTNAME', 61 | description => 'The hostname for the database server', 62 | }, 63 | user => { 64 | cli => 'user|u=s', 65 | help => '-u USERNAME | --user USERNAME', 66 | description => 'The username to authenticate as', 67 | }, 68 | password => { 69 | help => '-p | --password=PASSWORD | -pPASSWORD', 70 | description => 'The password to authenticate with', 71 | }, 72 | database => { 73 | cli => 'database|d=s', 74 | help => '-d DATABASE | --database DATABASE', 75 | description => 'The database to use once connected', 76 | }, 77 | port => { 78 | cli => 'port=i', 79 | help => '--port PORT', 80 | description => 'The port to use for the database server', 81 | }, 82 | no_auto_rehash => { 83 | cli => 'no-auto-rehash|A', 84 | help => '-A --no-auto-rehash', 85 | description => q{Don't scan the information schema for tab autocomplete data}, 86 | }, 87 | ); 88 | } 89 | 90 | sub setup { 91 | my $self = shift; 92 | $self->find_and_read_configs(); 93 | 94 | # If the user has configured a custom prompt in .my.cnf and not one in the config, use that in the Term instance 95 | if ($self->prompt && ! $self->app->config->{prompt}) { 96 | $self->app->term->prompt( $self->parse_prompt() ); 97 | } 98 | } 99 | 100 | sub find_and_read_configs { 101 | my $self = shift; 102 | my @config_paths = ( 103 | "$ENV{HOME}/.my.cnf", 104 | ); 105 | 106 | foreach my $path (@config_paths) { 107 | (-e $path) or next; 108 | $self->read_my_dot_cnf($path); 109 | } 110 | } 111 | 112 | sub read_my_dot_cnf { 113 | my $self = shift; 114 | my $path = shift; 115 | 116 | my @valid_keys = qw( user password host port database prompt safe_update select_limit no_auto_rehash ); # keys we'll read 117 | my @valid_sections = qw( client mysql ); # valid [section] names 118 | my @boolean_keys = qw( safe_update no_auto_rehash ); 119 | 120 | open MYCNF, "<$path"; 121 | 122 | # ignore lines in file until we hit a valid [section] 123 | # then read key=value pairs 124 | my $in_valid_section = 0; 125 | while() { 126 | 127 | # ignore commented lines: 128 | /^\s*#/ && next; 129 | 130 | if (/^\s*\[(.*?)\]\s*$/) { # we've hit a section 131 | # verify that we're inside a valid section, 132 | # and if so, set $in_valid_section 133 | if ( grep $_ eq $1, @valid_sections ) { 134 | $in_valid_section = 1; 135 | } else { 136 | $in_valid_section = 0; 137 | } 138 | 139 | } elsif ($in_valid_section) { 140 | # read a key/value pair 141 | #/^\s*(.+?)\s*=\s*(.+?)\s*$/; 142 | #my ($key, $val) = ($1, $2); 143 | my ($key, $val) = split /\s*=\s*/, $_, 2; 144 | 145 | # value cleanup 146 | $key =~ s/^\s*(.+?)\s*$/$1/; 147 | $key || next; 148 | $key =~ s/-/_/g; 149 | 150 | $val || ( $val = '' ); 151 | $val && $val =~ s/\s*$//; 152 | 153 | # special case for no_auto_rehash, which is 'skip-auto-rehash' in my.cnf 154 | if ($key eq 'skip_auto_rehash') { 155 | $key = 'no_auto_rehash'; 156 | } 157 | 158 | # verify that the field is one of the supported ones 159 | unless ( grep $_ eq $key, @valid_keys ) { next; } 160 | 161 | # if this key is expected to be a boolean, fix the value 162 | if ( grep $_ eq $key, @boolean_keys ) { 163 | if ($val eq '0' || $val eq 'false') { 164 | $val = 0; 165 | } else { 166 | # this includes empty values 167 | $val = 1; 168 | } 169 | } 170 | 171 | # override anything that was set on the commandline with the stuff read from the config. 172 | unless (defined $self->{$key}) { $self->{$key} = $val }; 173 | } 174 | } 175 | 176 | close MYCNF; 177 | } 178 | 179 | sub db_connect { 180 | my $self = shift; 181 | my $dsn = 'DBI:mysql:' . join (';', 182 | map { "$_=" . $self->$_ } 183 | grep { defined $self->$_ } 184 | qw(database host port) 185 | ); 186 | my $dbh = DBI->connect($dsn, $self->user, $self->password, { 187 | PrintError => 0, 188 | mysql_auto_reconnect => 1, 189 | mysql_enable_utf8 => 1, 190 | }) or die $DBI::errstr . "\nDSN used: '$dsn'\n"; 191 | $self->dbh($dbh); 192 | 193 | ## Update autocomplete entries 194 | 195 | if ($self->database) { 196 | $self->current_database($self->database); 197 | $self->update_autocomplete_entries($self->database); 198 | } 199 | 200 | $self->update_db_types(); 201 | } 202 | 203 | sub update_autocomplete_entries { 204 | my ($self, $database) = @_; 205 | 206 | return if $self->no_auto_rehash; 207 | my $cache_key = 'autocomplete_' . $database; 208 | if (! $self->{_cache}{$cache_key}) { 209 | $self->log_debug("Reading table information for completion of table and column names\nYou can turn off this feature to get a quicker startup with -A\n"); 210 | 211 | my %autocomplete; 212 | my $rows = $self->dbh->selectall_arrayref("select TABLE_NAME, COLUMN_NAME from information_schema.COLUMNS where TABLE_SCHEMA = ?", {}, $database); 213 | foreach my $row (@$rows) { 214 | $autocomplete{$row->[0]} = 1; # Table 215 | $autocomplete{$row->[1]} = 1; # Column 216 | $autocomplete{$row->[0] . '.' . $row->[1]} = 1; # Table.Column 217 | } 218 | $self->{_cache}{$cache_key} = \%autocomplete; 219 | } 220 | $self->app->term->autocomplete_entries( $self->{_cache}{$cache_key} ); 221 | } 222 | 223 | sub handle_sql_input { 224 | my ($self, $input, $render_opts) = @_; 225 | 226 | # Figure out the verb of the SQL by either using regex or a parser. If we 227 | # use the parser, we get error checking here instead of the server. 228 | my $verb; 229 | if (defined $self->sql_parser && $self->sql_parser) { 230 | # Attempt to parse the input with a SQL parser 231 | my $parsed = $self->sql_parser->parse($input); 232 | if (! defined $parsed->root) { 233 | $self->show_sql_error($input, $parsed->pos, $parsed->line); 234 | return; 235 | } 236 | 237 | # Figure out the verb 238 | my $statement = $parsed->root->extract('statement'); 239 | if (! $statement) { 240 | $self->log_error("Not sure what to do with this; no 'statement' in the parse tree"); 241 | return; 242 | } 243 | $verb = $statement->children->[0]; 244 | } 245 | else { 246 | ($verb, undef) = split /\s+/, $input, 2; 247 | } 248 | 249 | # Run the SQL 250 | 251 | my $t0 = gettimeofday; 252 | 253 | my $sth = $self->execute_sql($input); 254 | return unless $sth; # error may have been reached (and reported) 255 | 256 | # Track which database we're in for autocomplete 257 | if (my ($database) = $input =~ /^use \s+ (\S+)$/ix) { 258 | $self->current_database($database); 259 | $self->update_autocomplete_entries($database); 260 | } 261 | 262 | my %timing = ( prepare_execute => gettimeofday - $t0 ); 263 | 264 | my $view = $self->app->create_view( 265 | sth => $sth, 266 | timing => \%timing, 267 | verb => $verb, 268 | column_meta => { 269 | map { my $key = $_; $key =~ s/^mysql_//; +($key => $sth->{$_}) } 270 | qw(mysql_is_blob mysql_is_key mysql_is_num mysql_is_pri_key mysql_is_auto_increment mysql_length mysql_max_length) 271 | }, 272 | ); 273 | $view->render(%$render_opts); 274 | 275 | return $view; 276 | } 277 | 278 | sub execute_sql { 279 | my ($self, $input) = @_; 280 | 281 | my $sth = $self->dbh->prepare($input); 282 | 283 | # Execute the statement, allowing Ctrl-C to interrupt the call 284 | eval { 285 | eval { 286 | my $h = set_sig_handler('INT', sub { 287 | my $thread_id = $self->dbh->{mysql_thread_id}; 288 | $self->dbh->clone->do("KILL QUERY $thread_id"); 289 | die "Query aborted by Ctrl+C\n"; 290 | }); 291 | $sth->execute(); 292 | }; 293 | die "$@" if $@; 294 | }; 295 | 296 | if (my $error = $self->dbh->errstr || $@) { 297 | $self->log_error($error); 298 | return; 299 | } 300 | 301 | return $sth; 302 | } 303 | 304 | sub update_db_types { 305 | my $self = shift; 306 | 307 | ## Collect type info from the handle 308 | 309 | my %types; 310 | my $type_info_all = $self->{dbh}->type_info_all(); 311 | my %key_map = %{ shift @$type_info_all }; 312 | 313 | $types{unknown} = { map { $_ => 'unknown' } keys %key_map }; 314 | 315 | foreach my $i (0..$#{ $type_info_all }) { 316 | my %type; 317 | while (my ($key, $index) = each %key_map) { 318 | $type{$key} = $type_info_all->[$i][$index]; 319 | } 320 | $types{$i} = \%type; 321 | } 322 | 323 | $self->{db_types} = \%types; 324 | } 325 | 326 | sub db_type_info { 327 | my ($self, $type) = @_; 328 | 329 | my $info = $self->{db_types}{$type}; 330 | if (! $info) { 331 | #$self->log_error("No such type info for $type"); 332 | return $self->{db_types}{unknown}; 333 | } 334 | return $info; 335 | } 336 | 337 | my %prompt_substitutions = ( 338 | S => ';', 339 | "'" => "'", 340 | '"' => '"', 341 | v => 'TODO-server-version', 342 | p => sub { shift->{self}->port }, 343 | '\\' => '\\', 344 | n => "\n", 345 | t => "\t", 346 | '_' => ' ', 347 | ' ' => ' ', 348 | d => '%d', 349 | h => '%h', 350 | c => '%e{ ++( shift->{self}{_statement_counter} ) }', 351 | u => '%u', 352 | U => '%u@%h', 353 | D => '%t{%a, %d %b %H:%M:%S %Y}', 354 | w => '%t{%a}', 355 | y => '%t{%y}', 356 | Y => '%t{%Y}', 357 | o => '%t{%m}', 358 | O => '%t{%b}', 359 | R => '%t{%k}', 360 | r => '%t{%I}', 361 | m => '%t{%M}', 362 | s => '%t{%S}', 363 | P => '%t{%p}', 364 | ); 365 | 366 | # Take a .my.cnf prompt format and convert it into Term escape options 367 | # 368 | # Reference: 369 | # http://www.thegeekstuff.com/2010/02/mysql_ps1-6-examples-to-make-your-mysql-prompt-like-angelina-jolie/ 370 | 371 | sub parse_prompt { 372 | my $self = shift; 373 | 374 | my $parsed_prompt = $self->prompt; 375 | $parsed_prompt =~ s{\\\\(.)}{ 376 | my $substitute = $prompt_substitutions{$1}; 377 | if (! $substitute) { 378 | "$1"; 379 | } 380 | elsif (ref $substitute) { 381 | $substitute->($self); 382 | } 383 | else { 384 | $substitute; 385 | } 386 | }exg; 387 | 388 | return $parsed_prompt; 389 | } 390 | 391 | no Moose; 392 | __PACKAGE__->meta->make_immutable; 393 | 394 | =head1 COPYRIGHT 395 | 396 | Copyright (c) 2012 Eric Waters and Shutterstock Images (http://shutterstock.com). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 397 | 398 | The full text of the license can be found in the LICENSE file included with this module. 399 | 400 | =head1 AUTHOR 401 | 402 | Eric Waters 403 | 404 | =cut 405 | 406 | 1; 407 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Model/Pg.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Model::Pg; 2 | 3 | =head1 NAME 4 | 5 | App::AltSQL::Model::Pg 6 | 7 | =head1 DESCRIPTION 8 | 9 | Initial attempt at a Postgres model class 10 | 11 | =cut 12 | 13 | use Moose; 14 | use DBI; 15 | use Sys::SigAction qw(set_sig_handler); 16 | use Time::HiRes qw(gettimeofday tv_interval); 17 | 18 | extends 'App::AltSQL::Model'; 19 | 20 | has [qw(host user password database port)] => ( is => 'ro' ); 21 | 22 | sub args_spec { 23 | return ( 24 | host => { 25 | cli => 'host|h=s', 26 | help => '-h HOSTNAME | --host HOSTNAME', 27 | description => 'The hostname for the database server', 28 | }, 29 | user => { 30 | cli => 'user|u=s', 31 | help => '-u USERNAME | --user USERNAME', 32 | description => 'The username to authenticate as', 33 | }, 34 | password => { 35 | help => '-p | --password=PASSWORD | -pPASSWORD', 36 | description => 'The password to authenticate with', 37 | }, 38 | database => { 39 | cli => 'database|d=s', 40 | help => '-d DATABASE | --database DATABASE', 41 | description => 'The database to use once connected', 42 | }, 43 | port => { 44 | cli => 'port=i', 45 | help => '--port PORT', 46 | description => 'The port to use for the database server', 47 | }, 48 | ); 49 | } 50 | 51 | sub db_connect { 52 | my $self = shift; 53 | my $dsn = 'DBI:Pg:' . join (';', 54 | map { "$_=" . $self->$_ } 55 | grep { defined $self->$_ } 56 | qw(database host port) 57 | ); 58 | my $dbh = DBI->connect($dsn, $self->user, $self->password, { 59 | PrintError => 0, 60 | }) or die $DBI::errstr . "\nDSN used: '$dsn'\n"; 61 | $self->dbh($dbh); 62 | 63 | if ($self->database) { 64 | $self->current_database($self->database); 65 | } 66 | } 67 | 68 | sub handle_sql_input { 69 | my ($self, $input, $render_opts) = @_; 70 | 71 | # Figure out the verb of the SQL by either using regex or a parser. If we 72 | # use the parser, we get error checking here instead of the server. 73 | my $verb; 74 | ($verb, undef) = split /\s+/, $input, 2; 75 | 76 | # Run the SQL 77 | 78 | my $t0 = gettimeofday; 79 | 80 | my $sth = $self->execute_sql($input); 81 | return unless $sth; # error may have been reached (and reported) 82 | 83 | # Track which database we're in for autocomplete 84 | if (my ($database) = $input =~ /^use \s+ (\S+)$/ix) { 85 | $self->current_database($database); 86 | } 87 | 88 | my %timing = ( prepare_execute => gettimeofday - $t0 ); 89 | 90 | my $view = $self->app->create_view( 91 | sth => $sth, 92 | timing => \%timing, 93 | verb => $verb, 94 | ); 95 | $view->render(%$render_opts); 96 | 97 | return $view; 98 | } 99 | 100 | no Moose; 101 | __PACKAGE__->meta->make_immutable; 102 | 103 | =head1 COPYRIGHT 104 | 105 | Copyright (c) 2012 Eric Waters and Shutterstock Images (http://shutterstock.com). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 106 | 107 | The full text of the license can be found in the LICENSE file included with this module. 108 | 109 | =head1 AUTHOR 110 | 111 | Eric Waters 112 | 113 | =cut 114 | 115 | 1; 116 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Model/SQLite.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Model::SQLite; 2 | 3 | =head1 NAME 4 | 5 | App::AltSQL::Model::SQLite 6 | 7 | =head1 DESCRIPTION 8 | 9 | A model for SQLite. 10 | 11 | =cut 12 | 13 | use Moose; 14 | use DBI; 15 | 16 | extends 'App::AltSQL::Model'; 17 | 18 | has database => ( 19 | is => 'ro', 20 | ); 21 | 22 | sub args_spec { 23 | return ( 24 | database => { 25 | cli => 'database|d=s', 26 | help => '-d DATABASE | --database DATABASE', 27 | description => 'The database file to use', 28 | }, 29 | ); 30 | } 31 | 32 | sub db_connect { 33 | my ( $self ) = @_; 34 | 35 | my $dsn = 'DBI:SQLite:dbname=' . $self->database; 36 | my $dbh = DBI->connect($dsn, undef, undef, { 37 | PrintError => 1, 38 | # XXX sqlite-specific options 39 | }) or die $DBI::errstr . "\nDSN uesd: '$dsn'\n"; 40 | $self->dbh($dbh); 41 | 42 | # XXX update autocomplete/db_types 43 | } 44 | 45 | sub handle_sql_input { 46 | my ( $self, $input, $render_opts ) = @_; 47 | 48 | my $verb = 'SELECT'; # XXX fix me 49 | 50 | my $sth = $self->execute_sql($input); 51 | return unless $sth; 52 | 53 | my %timing; # XXX fix me 54 | 55 | my $view = $self->app->create_view( 56 | sth => $sth, 57 | timing => \%timing, 58 | verb => $verb, 59 | column_meta => { 60 | # XXX fix me 61 | }, 62 | ); 63 | $view->render(%$render_opts); 64 | 65 | return $view; 66 | } 67 | 68 | no Moose; 69 | __PACKAGE__->meta->make_immutable; 70 | 71 | =head1 AUTHOR 72 | 73 | Rob Hoelz 74 | 75 | =cut 76 | 77 | 1; 78 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump; 2 | 3 | use Moose::Role; 4 | use Moose::Util qw( apply_all_roles ); 5 | 6 | use App::AltSQL::Plugin::Dump::Format; 7 | 8 | =head1 Name 9 | 10 | Dump AltSQL Plugin 11 | 12 | =head1 Synopsis 13 | 14 | Usage: 15 | 16 | .dump .[csv|html|json|pl|pm|sql|xls|xml|yaml|yml] ; 17 | 18 | =head1 Description 19 | 20 | This plugin will allow you to dump out results from 21 | a sql query into one of many data formats. 22 | 23 | =head1 Examples 24 | 25 | Given: 26 | 27 | CREATE TABLE `users` ( 28 | `id` int(11) NOT NULL AUTO_INCREMENT, 29 | `name` varchar(32) NOT NULL, 30 | PRIMARY KEY (`id`) 31 | ); 32 | 33 | CSV: 34 | 35 | .dump out.csv select * from users; 36 | 37 | out.csv: 38 | 39 | "id","name" 40 | "1","Moo" 41 | "2","Pie" 42 | "3","Cow" 43 | 44 | HTML: 45 | 46 | .dump out.html select * from users; 47 | 48 | out.html: 49 | 50 | =begin html 51 | 52 |
idname
1Moo
2Pie
3Cow
53 | 54 | =end html 55 | 56 | JSON: 57 | 58 | .dump out.json select * from users; 59 | 60 | out.json: 61 | 62 | [{"name":"Moo","id":"1"},{"name":"Pie","id":"2"},{"name":"Cow","id":"3"}] 63 | 64 | PERL: 65 | 66 | .dump out.[pl|pm] select * from users; 67 | 68 | out.[pl|pm]: 69 | 70 | $VAR1 = [ 71 | { 72 | 'id' => '1', 73 | 'name' => 'Moo' 74 | }, 75 | { 76 | 'id' => '2', 77 | 'name' => 'Pie' 78 | }, 79 | { 80 | 'id' => '3', 81 | 'name' => 'Cow' 82 | }, 83 | ]; 84 | 85 | SQL: 86 | 87 | .dump out.sql select * from users; 88 | 89 | out.sql: 90 | 91 | INSERT INTO table (`id`,`name`) VALUES('1','Moo'),('2','Pie'),('3','Cow'); 92 | 93 | XLS: 94 | 95 | .dump out.xls select * from users; 96 | 97 | out.xls: 98 | 99 | You just get a excel spreadsheet... 100 | 101 | XML: 102 | 103 | .dump out.xml select * from users; 104 | 105 | out.xml: 106 | 107 | 108 | 109 | 1 110 | Moo 111 | 112 | 113 | 2 114 | Pie 115 | 116 | 117 | 3 118 | Cow 119 | 120 |
121 | 122 | YAML: 123 | 124 | .dump out.[yaml|yml] select * from users; 125 | 126 | out.[yaml|yml]: 127 | 128 | --- 129 | - id: 1 130 | name: Moo 131 | - id: 2 132 | name: Pie 133 | - id: 3 134 | name: Cow 135 | 136 | =cut 137 | 138 | around call_command => sub { 139 | my ($orig, $self, @args) = @_; 140 | 141 | my $option; 142 | 143 | my ($command, $input) = @args[0..1]; 144 | 145 | if ($command ne 'dump') { 146 | # Call next chained command 147 | return $self->$orig(@args); 148 | } 149 | 150 | my (undef, $filename, $query) = split /\s+/, $input, 3; 151 | 152 | if (!$filename || !$query) { 153 | $self->log_error("Usage: .dump \$filename \$sql"); 154 | $self->log_error("Available formats: csv, xls, html, json, [pl|pm], sql, xml, [yml|yaml]"); 155 | 156 | return 1; # handled, won't run this as a query 157 | } 158 | 159 | my ($ext) = $filename =~ /\.([a-zA-Z-]+)$/; 160 | 161 | my $format; 162 | 163 | if ($ext =~ /^pl|pm$/i) { $format = 'perl'; } 164 | elsif ($ext =~ /^yml|yaml$/i) { $format = 'yaml'; } 165 | else { $format = lc $ext; } 166 | 167 | my $formatter = App::AltSQL::Plugin::Dump::Format->new(); 168 | 169 | local $@; 170 | 171 | eval { 172 | apply_all_roles( $formatter, "App::AltSQL::Plugin::Dump::Format::$format" ); 173 | }; 174 | 175 | if ($@) { 176 | $self->log_error("Sorry $format is not a supported format because:\n$@"); 177 | return 1; 178 | } 179 | 180 | my $sth = $self->model->execute_sql($query); 181 | return 1 unless $sth; # handled; error occurred has has been reported to user 182 | 183 | my @headers; 184 | 185 | my %table_data; 186 | 187 | if ( $sth->{NUM_OF_FIELDS} ) { 188 | for my $i (0 .. $sth->{NUM_OF_FIELDS} - 1) { 189 | push @{ $table_data{columns} }, { name => $sth->{NAME}[$i] }; 190 | } 191 | } 192 | 193 | $table_data{rows} = $sth->fetchall_arrayref() || []; 194 | 195 | if ( @{ $table_data{rows} } ) { 196 | my $data = $formatter->format( 197 | table_data => \%table_data, 198 | filename => $filename, 199 | ); 200 | if ($data) { 201 | open(my $FILE, '>', $filename); 202 | print $FILE $data; 203 | close($FILE); 204 | } 205 | } 206 | 207 | $self->log_info("Wrote ".($sth->{NUM_OF_FIELDS} || 0)." rows to file $filename"); 208 | 209 | return 1; 210 | }; 211 | 212 | 1; 213 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format; 2 | 3 | use Moose; 4 | 5 | sub _convert_to_array_of_hashes { 6 | my ($self, $table_data) = @_; 7 | 8 | my @new_array; 9 | 10 | my $cols = $table_data->{columns}; 11 | 12 | for my $row ( @{ $table_data->{rows} } ) { 13 | my $hash; 14 | for my $i ( 0..(@$row - 1) ) { 15 | $hash->{ $cols->[$i]->{name} } = $row->[$i]; 16 | } 17 | push @new_array, $hash; 18 | } 19 | 20 | return \@new_array; 21 | } 22 | 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/csv.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::csv; 2 | 3 | use Moose::Role; 4 | 5 | sub format { 6 | my ($self, %params) = @_; 7 | 8 | my $table_data = $params{table_data}; 9 | 10 | # make headers for the csv file 11 | my $csv = join( ",", map{ escape($_->{name}) } @{ $table_data->{columns} } ) . "\n"; 12 | 13 | # print out the rows 14 | for my $row (@{ $table_data->{rows} }) { 15 | $csv .= join( ",", map{ escape($_) } @$row ) . "\n"; 16 | } 17 | 18 | return $csv; 19 | } 20 | 21 | sub escape { 22 | my ($value) = @_; 23 | return '' if !defined $value; 24 | $value =~ s/"/""/g; 25 | return '"' . $value . '"'; 26 | } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/html.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::html; 2 | 3 | use Moose::Role; 4 | 5 | sub format { 6 | my ($self, %params) = @_; 7 | 8 | my $table_data = $params{table_data}; 9 | 10 | # ehhh prob shouldn't put this here but couldn't resist. 11 | my $css = 'table{margin: 1em 1em 1em 2em;background: whitesmoke;border-collapse: collapse;}table th, table td{border: 1px gainsboro solid;padding: 0.2em;}table th{background: gainsboro;text-align: left;}'; 12 | 13 | my $html = ""; 14 | $html .= '' . join( '', map{ '' } @{ $table_data->{columns} } ) . ""; 15 | 16 | for my $row (@{ $table_data->{rows} }) { 17 | $html .= '' . join( '', map {'' } @$row ) . ''; 18 | } 19 | 20 | $html .= '
' . escape($_->{name}) . '
' . escape($_) . '
'; 21 | 22 | return $html; 23 | } 24 | 25 | sub escape { 26 | my ($value) = @_; 27 | return '' if !defined $value; 28 | $value =~ s//>/g; 30 | return $value; 31 | } 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/json.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::json; 2 | 3 | use Moose::Role; 4 | use JSON; 5 | 6 | sub format { 7 | my ($self, %params) = @_; 8 | my $data = $self->_convert_to_array_of_hashes($params{table_data}); 9 | return JSON->new->encode($data); 10 | } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/perl.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::perl; 2 | 3 | use Moose::Role; 4 | use Data::Dumper; 5 | 6 | sub format { 7 | my ($self, %params) = @_; 8 | 9 | $Data::Dumper::Sortkeys = 1; 10 | 11 | my $data = $self->_convert_to_array_of_hashes($params{table_data}); 12 | 13 | return Dumper($data); 14 | } 15 | 16 | 1; 17 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/sql.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::sql; 2 | 3 | use Moose::Role; 4 | 5 | sub format { 6 | my ($self, %params) = @_; 7 | 8 | my $table_data = $params{table_data}; 9 | 10 | # todo: add a create table once we have the datatypes in table data 11 | 12 | # todo: add support for non multi column insert for sqlite3 13 | my $sql = 'INSERT INTO table (' . 14 | join( ',', map{ escape($_->{name}, 'column') } @{ $table_data->{columns} } ) . ') VALUES'; 15 | 16 | for my $row (@{ $table_data->{rows} }) { 17 | $sql .= '(' . join( ',', map {escape($_)} @$row ) . '),'; 18 | } 19 | 20 | # change last trailing comma with semicolon 21 | $sql =~ s/,$/;/; 22 | 23 | return $sql; 24 | } 25 | 26 | sub escape { 27 | my ($value, $type) = @_; 28 | 29 | return 'NULL' if !defined $value; 30 | 31 | if (!$type || $type ne 'column') { 32 | $value =~ s/'/''/g; 33 | return "'$value'"; 34 | } 35 | 36 | return "`$value`"; 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/xls.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::xls; 2 | 3 | use Moose::Role; 4 | use Spreadsheet::WriteExcel::Big; 5 | 6 | sub format { 7 | my ($self, %params) = @_; 8 | 9 | my $filename = $params{filename}; 10 | my $table_data = $params{table_data}; 11 | 12 | my $workbook = Spreadsheet::WriteExcel::Big->new($filename); 13 | my $worksheet = $workbook->add_worksheet(); 14 | 15 | my $header_format = $workbook->add_format; 16 | $header_format->set_bold; 17 | 18 | my $col_pos = 0; 19 | my $row_pos = 0; 20 | 21 | # write header 22 | for my $column ( @{ $table_data->{columns} } ) { 23 | $worksheet->write(0, $col_pos++, $column->{name}, $header_format); 24 | } 25 | 26 | # move down 2 lines, let it breath some 27 | $row_pos += 2; 28 | 29 | for my $row ( @{ $table_data->{rows} } ) { 30 | $col_pos = 0; # reset col_pos. 31 | $worksheet->write($row_pos, $col_pos++, $_) for @$row; 32 | $row_pos++; 33 | } 34 | 35 | $workbook->close(); 36 | 37 | return; 38 | } 39 | 40 | 1; 41 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/xml.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::xml; 2 | 3 | use Moose::Role; 4 | use XML::Simple; 5 | 6 | sub format { 7 | my ($self, %params) = @_; 8 | 9 | my @xml; 10 | 11 | my $table_data = $params{table_data}; 12 | my $col = $table_data->{columns}; 13 | 14 | for my $row ( @{ $table_data->{rows} } ) { 15 | my $new_row; 16 | for my $i ( 0..(@$row - 1) ) { 17 | my $name = $col->[$i]->{name}; 18 | push @{ $new_row->{field} }, { name => $name, content => $row->[$i] }; 19 | } 20 | push @xml, $new_row; 21 | } 22 | 23 | return XMLout( { row => \@xml }, RootName => 'table', ); 24 | } 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Dump/Format/yaml.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Dump::Format::yaml; 2 | 3 | use Moose::Role; 4 | use YAML qw(Dump); 5 | 6 | sub format { 7 | my ($self, %params) = @_; 8 | my $data = $self->_convert_to_array_of_hashes($params{table_data}); 9 | return Dump($data); 10 | } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Plugin/Tail.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Plugin::Tail; 2 | 3 | use Moose::Role; 4 | 5 | =head1 TAIL 6 | 7 | Given: 8 | 9 | CREATE TABLE log_entries ( 10 | id int primary key auto_increment, 11 | ts datetime not null, 12 | log varchar(255) not null 13 | ); 14 | 15 | The SQL: 16 | 17 | .tail ts, log from log_entries every 30; 18 | 19 | Will: 20 | 21 | * Find the column 'id', which is the only primary key and is auto_increment 22 | * Find the current auto_increment value of id as last_seen_max_value 23 | * Loop: 24 | - sleep 30 seconds 25 | - select ts, log from log_entries where id > last_seen_max_value 26 | - update last_seen_max_value 27 | 28 | Other recognized forms: 29 | 30 | .tail * from log_entries every 30; 31 | .tail log_entries every 30; 32 | 33 | .tail log from log_entries where log like '%ERROR%' every 30; 34 | 35 | =cut 36 | 37 | around call_command => sub { 38 | my ($orig, $self, @args) = @_; 39 | my ($command, $input) = @args[0..1]; 40 | 41 | if ($command ne 'tail') { 42 | # Call next chained call_command 43 | return $self->$orig(@args); 44 | } 45 | 46 | my ($from, $table, $where, $sleep_seconds) = $input =~ 47 | m{^\.tail (.+? from|) \s+ (\S+) \s+ (where .+?|) every \s+ (\d+) \s* (?:s|seconds|)$}xi; 48 | if (! defined $table) { 49 | $self->log_error("Usage: .TAIL \$select FROM \$table WHERE \$criteria EVERY \$seconds | .TAIL \$table EVERY \$seconds"); 50 | return 1; # handled 51 | } 52 | 53 | ## Find the primary key, auto_increment column 54 | 55 | my $column_search = $self->model->dbh->selectall_arrayref(q| 56 | select 57 | COLUMN_NAME, IS_NULLABLE, DATA_TYPE, COLUMN_KEY, EXTRA 58 | from 59 | information_schema.COLUMNS 60 | where 61 | TABLE_SCHEMA = ? and 62 | TABLE_NAME = ? 63 | |, { Slice => {} }, $self->model->current_database, $table); 64 | 65 | my $key_column; 66 | { 67 | my @primary_keys = map { $_->{COLUMN_NAME} } grep { $_->{COLUMN_KEY} eq 'PRI' } @$column_search; 68 | my @autoinc_keys = map { $_->{COLUMN_NAME} } grep { $_->{EXTRA} eq 'auto_increment' } @$column_search; 69 | if (int @primary_keys == 1 && int @autoinc_keys == 1 && $autoinc_keys[0] eq $primary_keys[0]) { 70 | $key_column = $primary_keys[0]; 71 | } 72 | else { 73 | $self->log_error("Unable to find an auto-incrementing, primary key on the '$table' table"); 74 | return; 75 | } 76 | } 77 | 78 | ## Find the current max value of this autoincrementing column 79 | 80 | my $last_seen_max_value; 81 | my $update_last_seen_max_value = sub { 82 | my $table_status = $self->model->dbh->selectrow_hashref(q| 83 | show 84 | table status 85 | where 86 | Name = ? 87 | |, undef, $table); 88 | $last_seen_max_value = $table_status->{Auto_increment} - 1; 89 | }; 90 | 91 | ## Construct tail SQL statement 92 | 93 | $from ||= '* from'; 94 | if ($where) { 95 | $where .= " and $key_column > "; 96 | } 97 | else { 98 | $where = "where $key_column > "; 99 | } 100 | 101 | my $tail_sql_fragment = "select $from $table $where"; 102 | 103 | ## Loop 104 | 105 | my $break = 0; 106 | $SIG{INT} = sub { 107 | $break = 1; 108 | }; 109 | 110 | my %render_opts = ( no_pager => 1 ); 111 | 112 | while (1) { 113 | last if $break; 114 | $update_last_seen_max_value->(); 115 | sleep $sleep_seconds; 116 | my $sql = $tail_sql_fragment . $last_seen_max_value; 117 | $self->log_info( scalar(localtime(time)) . ': ' . $sql); 118 | $self->model->handle_sql_input($sql, \%render_opts); 119 | } 120 | 121 | return 1; 122 | }; 123 | 124 | no Moose::Role; 125 | 126 | 1; 127 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Role.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Role; 2 | 3 | use Moose::Role; 4 | 5 | has 'app' => ( 6 | is => 'ro', 7 | required => 1, 8 | handles => [qw(log_info log_debug log_error get_namespace_config_value resolve_namespace_config_value)], 9 | ); 10 | 11 | sub setup { 12 | my $self = shift; 13 | # Do nothing; leave it to subclasses 14 | } 15 | 16 | no Moose::Role; 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Term.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Term; 2 | 3 | use Moose; 4 | use Term::ReadLine::Zoid; 5 | use Data::Dumper; 6 | use JSON qw(encode_json decode_json); 7 | use Term::ANSIColor; 8 | 9 | with 'App::AltSQL::Role'; 10 | with 'MooseX::Object::Pluggable'; 11 | 12 | has 'term' => ( 13 | is => 'ro', 14 | lazy_build => 1, 15 | ); 16 | has 'prompt' => ( 17 | is => 'rw', 18 | default => 'altsql> ', 19 | ); 20 | has 'history_fn' => ( is => 'ro' ); 21 | has 'autocomplete_entries' => ( is => 'rw' ); 22 | 23 | sub args_spec { 24 | return ( 25 | history_fn => { 26 | cli => 'history=s', 27 | default => $ENV{HOME} . '/.altsql_history.js', 28 | help => '--history FILENAME', 29 | description => 'The file to store history entries in', 30 | }, 31 | ); 32 | } 33 | 34 | sub BUILD { 35 | my $self = shift; 36 | $self->log_info("Ctrl-C to reset the line; Ctrl-D to exit"); 37 | } 38 | 39 | sub setup { 40 | my $self = shift; 41 | if (my $custom_prompt = $self->app->config->{prompt}) { 42 | $self->prompt($custom_prompt); 43 | } 44 | } 45 | 46 | sub _build_term { 47 | my $self = shift; 48 | 49 | my $term = Term::ReadLine::Zoid->new("altsql-shell"); 50 | $self->{term} = $term; 51 | 52 | # Require the tab key to be hit twice before showing the list of autocomplete items 53 | $term->Attribs->{autolist} = 0; 54 | 55 | $term->Attribs->{completion_function} = sub { 56 | $self->completion_function(@_); 57 | }; 58 | 59 | $term->Attribs->{beat} = sub { 60 | # Check on things in the background here; called every second there is no input from the user 61 | }; 62 | 63 | $term->bindkey('^Z', sub { 64 | kill 20, $$; # send ourselves SIGTSTP 65 | }); 66 | 67 | $term->bindkey('^D', sub { 68 | print "\n"; 69 | $self->app->shutdown(); 70 | }); 71 | 72 | $term->bindkey('return', sub { $self->return_key }); 73 | 74 | $self->read_history(); 75 | 76 | return $term; 77 | } 78 | 79 | sub return_key { 80 | my $self = shift; 81 | 82 | my $input = join "\n", @{ $self->term->{lines} }; 83 | if ($self->app->model->is_end_of_statement($input)) { 84 | $self->term->accept_line(); 85 | } 86 | else { 87 | $self->term->insert_line(); 88 | } 89 | } 90 | 91 | sub readline { 92 | my $self = shift; 93 | 94 | return $self->term->readline($self->render_prompt()); 95 | } 96 | 97 | sub completion_function { 98 | my ($self, $word, $buffer, $start) = @_; 99 | 100 | #$self->log_debug("\ncompletion_function: '$word', '$buffer', '$start'"); 101 | 102 | my $hash = $self->autocomplete_entries; 103 | return () unless $hash; 104 | 105 | my @matches; 106 | foreach my $key (sort keys %$hash) { 107 | push @matches, $key if $key =~ m/^$word/i; 108 | } 109 | return @matches; 110 | } 111 | 112 | sub write_history { 113 | my ($self, $fn) = @_; 114 | 115 | $fn ||= $self->history_fn; 116 | if (! $fn) { 117 | return; 118 | } 119 | 120 | open my $out, '>', $fn or die "Can't open $fn for writing: $!"; 121 | print $out encode_json({ history => [ $self->term->GetHistory ] }); 122 | close $out; 123 | } 124 | 125 | sub read_history { 126 | my ($self, $fn) = @_; 127 | 128 | # Seed the history from a file if present 129 | $fn ||= $self->history_fn; 130 | if (! $fn || ! -f $fn) { 131 | return; 132 | } 133 | 134 | open my $in, '<', $fn or die "Can't open $fn for reading: $!"; 135 | local $\ = undef; 136 | my $data = <$in>; 137 | close $in; 138 | 139 | my @history; 140 | eval { 141 | my $parsed = decode_json($data); 142 | @history = @{ $parsed->{history} }; 143 | }; 144 | if (my $exception = $@) { 145 | $self->log_error("An error occurred when decoding $fn: $exception"); 146 | } 147 | 148 | $self->term->SetHistory($self->tidy_history(@history)); 149 | } 150 | 151 | sub tidy_history { 152 | my ($self, @history) = @_; 153 | 154 | # Filter out exit/quit statements 155 | @history = grep { ! /^(quit|exit)/ } @history; 156 | 157 | # Limit it to a sane number 158 | if ($#history > 1_000) { 159 | splice @history, 0, $#history - 1_000; 160 | } 161 | 162 | return @history; 163 | } 164 | 165 | sub get_term_width { 166 | my $self = shift; 167 | my ($width, $height) = $self->term->TermSize(); 168 | return $width; 169 | } 170 | 171 | sub get_term_height { 172 | my $self = shift; 173 | my ($width, $height) = $self->term->TermSize(); 174 | return $height; 175 | } 176 | 177 | my %prompt_substitutions = ( 178 | u => sub { shift->{self}->app->model->user }, 179 | d => sub { shift->{self}->app->model->current_database || '(none)' }, 180 | h => sub { shift->{self}->app->model->host }, 181 | '%' => '%', 182 | ); 183 | 184 | my %block_prompt_substitutions = ( 185 | c => sub { 186 | my ($context, $block) = @_; 187 | return color($block); 188 | }, 189 | e => sub { 190 | my ($context, $block) = @_; 191 | # Make '$self' expected in the current scope so the $block can reference it 192 | my $self = $context->{self}; 193 | my $return = eval $block; 194 | if (my $ex = $@) { 195 | $self->log_error($ex); 196 | $return = 'err'; 197 | } 198 | return $return; 199 | }, 200 | t => sub { 201 | my ($context, $format) = @_; 202 | my $now = $context->{date}; 203 | if (! $now) { 204 | return 'err'; 205 | } 206 | return $now->strftime($format); 207 | }, 208 | ); 209 | 210 | sub render_prompt { 211 | my ($self, $now) = @_; 212 | 213 | if (! defined $self->{_has_datetime}) { 214 | eval { require DateTime; }; 215 | $self->{_has_datetime} = $@ ? 0 : 1; 216 | } 217 | 218 | if (! $now && $self->{_has_datetime}) { 219 | $now = DateTime->now( time_zone => 'local' ); 220 | } 221 | 222 | my %context = ( 223 | self => $self, 224 | date => $now, 225 | ); 226 | 227 | my $prompt = $self->prompt; 228 | my $output = ''; 229 | 230 | while (length $prompt) { 231 | my $char = substr $prompt, 0, 1, ''; 232 | 233 | # We're looking for a closing brace 234 | if ($context{requires_block}) { 235 | if ($char eq '}' && --$context{brace_count} == 0) { 236 | # Block is complete 237 | my $sub = $block_prompt_substitutions{ $context{symbol} }; 238 | $output .= $sub->(\%context, delete $context{block}); 239 | delete $context{requires_block}; 240 | delete $context{brace_count}; 241 | next; 242 | } 243 | 244 | $context{block} .= $char; 245 | 246 | if ($char eq '{') { 247 | $context{brace_count}++; 248 | } 249 | 250 | next; 251 | } 252 | 253 | if ($char eq '%') { 254 | $context{symbol} = substr $prompt, 0, 1, ''; 255 | if ($block_prompt_substitutions{ $context{symbol} } && substr($prompt, 0, 1) eq '{') { 256 | substr $prompt, 0, 1, ''; # shift the '{' 257 | $context{requires_block} = 1; 258 | $context{block} = ''; 259 | $context{brace_count} = 1; 260 | } 261 | else { 262 | my $sub = $prompt_substitutions{ $context{symbol} }; 263 | if (! $sub) { 264 | $self->log_error("Unrecognized prompt substitution '$context{symbol}'"); 265 | $output .= $char; 266 | } 267 | elsif (ref $sub) { 268 | $output .= $sub->(\%context); 269 | } 270 | else { 271 | $output .= $sub; 272 | } 273 | } 274 | next; 275 | } 276 | 277 | $output .= $char; 278 | } 279 | 280 | return $output; 281 | } 282 | 283 | no Moose; 284 | __PACKAGE__->meta->make_immutable; 285 | 286 | 1; 287 | -------------------------------------------------------------------------------- /lib/App/AltSQL/Term/Plugin/SyntaxHighlight.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::Term::Plugin::SyntaxHighlight; 2 | 3 | =head1 NAME 4 | 5 | App::AltSQL::Term::Plugin::SyntaxHighlight - Provide syntax-sensitive highlighting while you type 6 | 7 | =head1 DESCRIPTION 8 | 9 | Perform live syntax highlighting while you type. 10 | 11 | This module requires features in L that are not yet in the upstream release. If you don't want to wait until this module is updated you can install the developer release from here: L. This degrades safely without the updated module. 12 | 13 | =cut 14 | 15 | use Moose::Role; 16 | use Term::ANSIColor qw(color colored); 17 | 18 | # Very very basic keyword highlighting 19 | my @input_highlighting = ( 20 | { 21 | color => 'yellow', 22 | words => [qw( 23 | action add after aggregate all alter as asc auto_increment avg avg_row_length 24 | both by 25 | cascade change character check checksum column columns comment constraint create cross 26 | current_date current_time current_timestamp 27 | data database databases day day_hour day_minute day_second 28 | default delayed delay_key_write delete desc describe distinct distinctrow drop 29 | enclosed escape escaped explain 30 | fields file first flush for foreign from full function 31 | global grant grants group 32 | having heap high_priority hosts hour hour_minute hour_second 33 | identified ignore index infile inner insert insert_id into isam 34 | join 35 | key keys kill last_insert_id leading left limit lines load local lock logs long 36 | low_priority 37 | match max_rows middleint min_rows minute minute_second modify month myisam 38 | natural no 39 | on optimize option optionally order outer outfile 40 | pack_keys partial password primary privileges procedure process processlist 41 | read references reload rename replace restrict returns revoke right row rows 42 | second select show shutdown soname sql_big_result sql_big_selects sql_big_tables sql_log_off 43 | sql_log_update sql_low_priority_updates sql_select_limit sql_small_result sql_warnings starting 44 | status straight_join string 45 | table tables temporary terminated to trailing type 46 | unique unlock unsigned update usage use using 47 | values varbinary variables varying 48 | where with write 49 | year_month 50 | zerofill 51 | )], 52 | }, 53 | ); 54 | 55 | # Compile the above into regex 56 | foreach my $syntax_block (@input_highlighting) { 57 | my $words = join '|', @{ $syntax_block->{words} }; 58 | $syntax_block->{regex} = qr/\b($words)\b/i; 59 | } 60 | 61 | after _build_term => sub { 62 | my $self = shift; 63 | 64 | $self->{term}->Attribs->{lines_preprocess_function} = sub { 65 | my ($lines, $pos) = @_; 66 | for my $i (0..$#{ $lines }) { 67 | # Color the main color words (just for the fun) 68 | foreach my $syntax_block (@input_highlighting) { 69 | $lines->[$i] =~ s/($$syntax_block{regex})/colored($1, $syntax_block->{color})/eg; 70 | } 71 | } 72 | }; 73 | }; 74 | 75 | no Moose::Role; 76 | 77 | =head1 COPYRIGHT 78 | 79 | Copyright (c) 2012 Eric Waters and Shutterstock Images (http://shutterstock.com). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 80 | 81 | The full text of the license can be found in the LICENSE file included with this module. 82 | 83 | =head1 AUTHOR 84 | 85 | Eric Waters 86 | 87 | =cut 88 | 89 | 1; 90 | -------------------------------------------------------------------------------- /lib/App/AltSQL/View.pm: -------------------------------------------------------------------------------- 1 | package App::AltSQL::View; 2 | 3 | =head1 NAME 4 | 5 | App::AltSQL::View 6 | 7 | =head1 DESCRIPTION 8 | 9 | This is an internal class used by L to capture the output of a DBI statement handler and express it to the user somehow. It does this mainly with L, and is currently MySQL specific. 10 | 11 | =cut 12 | 13 | use Moose; 14 | use Data::Dumper; 15 | use Text::CharWidth qw(mbswidth); 16 | use Time::HiRes qw(gettimeofday); 17 | use List::Util qw(sum max); 18 | 19 | with 'App::AltSQL::Role'; 20 | with 'MooseX::Object::Pluggable'; 21 | 22 | has 'timing' => ( is => 'rw' ); 23 | has 'verb' => ( is => 'rw' ); 24 | 25 | has 'buffer' => ( is => 'rw' ); 26 | has 'table_data' => ( is => 'rw' ); 27 | has 'footer' => ( is => 'rw' ); 28 | 29 | sub args_spec { 30 | return ( 31 | ); 32 | } 33 | 34 | =head2 new 35 | 36 | Pass the following required arguments: 37 | 38 | =over 4 39 | 40 | =item B 41 | 42 | =item B 43 | 44 | =item B 45 | 46 | =item B 47 | 48 | =back 49 | 50 | And the following optional arguments: 51 | 52 | =over 4 53 | 54 | =item B 55 | 56 | =back 57 | 58 | The passed data will be rendered into one or more of: B, B