package Chart::Clicker::SQL::REPL; use Moose; use 5.020; use feature 'signatures', 'postderef'; no warnings 'experimental::signatures'; no warnings 'experimental::postderef'; use Browser::Open; use File::HomeDir; use File::Spec; use File::Temp; use List::Util; use Module::Runtime; use Path::Class; use Scalar::Util; use Term::ReadLine; use Try::Tiny; use Chart::Clicker::SQL; has sql => ( is => 'rw', isa => 'Chart::Clicker::SQL', predicate => 'initialized', ); has history_file => ( is => 'ro', isa => 'Str', default => sub { my $filename = File::Spec->catfile( File::HomeDir->my_data, '.ccsql_history' ); file($filename)->touch; return $filename; }, ); has rl => ( is => 'ro', isa => 'Term::ReadLine', lazy => 1, default => sub ($self) { my $rl = Term::ReadLine->new(__PACKAGE__); for my $line (file($self->history_file)->slurp(chomp => 1)) { $rl->addhistory($line); } Scalar::Util::weaken(my $weakself = $self); $rl->Attribs->{completion_entry_function} = sub { () }; $rl->Attribs->{attempted_completion_function} = sub { $weakself->_attempt_completion(@_); }; return $rl; }, ); has width => ( is => 'rw', isa => 'Int', default => 1000, ); has height => ( is => 'rw', isa => 'Int', default => 600, ); has last_query => ( is => 'rw', isa => 'Str', predicate => 'has_last_query', ); has domain_axis_class => ( is => 'rw', isa => 'Str', default => 'Chart::Clicker::Axis', ); has range_axis_class => ( is => 'rw', isa => 'Str', default => 'Chart::Clicker::Axis', ); has renderer_class => ( is => 'rw', isa => 'Str', default => 'Chart::Clicker::Renderer::Line', ); sub _draw ($self) { if (!$self->initialized) { warn "not initialized"; return; } if (!$self->has_last_query) { warn "no active query"; return; } my $chart = $self->sql->render($self->last_query); my $xaxis = $chart->get_context('default')->domain_axis->label; $self->_configure_chart($chart, $xaxis); my ($fh, $filename) = File::Temp::tempfile(SUFFIX => '.png', UNLINK => 1); $chart->draw; $fh->write($chart->rendered_data); $fh->flush; Browser::Open::open_browser("file://$filename"); } sub _configure_chart ($self, $chart, $xaxis) { $chart->get_context('default')->domain_axis($self->_domain_axis($xaxis)); $chart->get_context('default')->range_axis($self->_range_axis); $chart->width($self->width); $chart->height($self->height); $chart->set_renderer($self->_renderer); } sub _domain_axis ($self, $label) { Module::Runtime::require_module($self->domain_axis_class); return $self->domain_axis_class->new( orientation => 'horizontal', position => 'bottom', tick_division_type => 'LinearRounded', label => $label, ); } sub _range_axis ($self) { Module::Runtime::require_module($self->range_axis_class); return $self->range_axis_class->new( orientation => 'vertical', position => 'left', tick_division_type => 'LinearRounded', ) } sub _renderer ($self) { Module::Runtime::require_module($self->renderer_class); return $self->renderer_class->new; } sub _can_draw ($self) { $self->initialized && $self->has_last_query } sub _attempt_completion ($self, $text, $line, $start, $end) { my ($initial_word) = $line =~ /^(\S+)\s+/; my @matches = $self->_get_completions($text, $initial_word); return $self->rl->completion_matches($text, sub ($text, $index) { return $matches[$index]; }); } sub _get_completions ($self, $text, $initial_word) { if ($initial_word) { my $completion_method = "_complete_\L$initial_word"; return unless $self->can($completion_method); return $self->$completion_method($text); } else { my @keywords = map { s/^_command_//r } grep { /^_command_/ } grep { !Moose::Object->can($_) } $self->meta->get_all_method_names; return $self->_keyword_complete($text, \@keywords); } } sub _keyword_complete ($self, $text, $keywords) { my ($prefix) = $text =~ /.*\b(\w+)$/; $prefix ||= ''; my $capital = $prefix eq uc($prefix); my $empty = length($prefix) == 0; return map { my $suffix = $empty ? $_ : ($capital ? uc : lc); $prefix . substr($suffix, length($prefix)) } grep { /^\Q$prefix/i } $keywords->@*; } sub _sql_keywords ($self) { # just using sqlite keywords for now, but would be nice to switch this on # the backend engine in use based on the dsn at some point # https://www.sqlite.org/lang_keywords.html qw( ABORT ACTION ADD AFTER ALL ALTER ANALYZE AND AS ASC ATTACH AUTOINCREMENT BEFORE BEGIN BETWEEN BY CASCADE CASE CAST CHECK COLLATE COLUMN COMMIT CONFLICT CONSTRAINT CREATE CROSS CURRENT_DATE CURRENT_TIME CURRENT_TIMESTAMP DATABASE DEFAULT DEFERRABLE DEFERRED DELETE DESC DETACH DISTINCT DROP EACH ELSE END ESCAPE EXCEPT EXCLUSIVE EXISTS EXPLAIN FAIL FOR FOREIGN FROM FULL GLOB GROUP HAVING IF IGNORE IMMEDIATE IN INDEX INDEXED INITIALLY INNER INSERT INSTEAD INTERSECT INTO IS ISNULL JOIN KEY LEFT LIKE LIMIT MATCH NATURAL NO NOT NOTNULL NULL OF OFFSET ON OR ORDER OUTER PLAN PRAGMA PRIMARY QUERY RAISE RECURSIVE REFERENCES REGEXP REINDEX RELEASE RENAME REPLACE RESTRICT RIGHT ROLLBACK ROW SAVEPOINT SELECT SET TABLE TEMP TEMPORARY THEN TO TRANSACTION TRIGGER UNION UNIQUE UPDATE USING VACUUM VALUES VIEW VIRTUAL WHEN WHERE WITH WITHOUT ) } sub _sql_functions ($self) { # just using sqlite functions for now, but would be nice to switch this on # the backend engine in use based on the dsn at some point my @functions = ( # https://www.sqlite.org/lang_corefunc.html qw( abs changes char coalesce glob ifnull instr hex last_insert_rowid length like likelihood likely load_extension lower ltrim max min nullif printf quote random randomblob replace round rtrim soundex sqlite_compileoption_get sqlite_compileoption_used sqlite_source_id sqlite_version substr total_changes trim typeof unlikely unicode upper zeroblob ), # https://www.sqlite.org/lang_datefunc.html qw( date time datetime julianday strftime ), # https://www.sqlite.org/lang_aggfunc.html qw( avg count group_concat max min sum total ), # https://www.sqlite.org/json1.html qw( json json_array json_array_length json_extract json_insert json_object json_remove json_replace json_set json_type json_valid json_quote json_group_array json_group_object json_each json_tree ), ); map { "$_(" } @functions } sub _sql_tables ($self) { return unless $self->initialized; my @tables = $self->sql->dbh->tables; my @table_components = map { split /\./ } @tables; my @all_tables = (@tables, @table_components); return ( @all_tables, map { s/"//gr } @all_tables, ); } sub _sql_columns ($self) { return unless $self->initialized; my $sth = $self->sql->dbh->column_info(undef, undef, undef, undef); my $rows = $sth->fetchall_arrayref; return List::Util::uniq map { $_->[3] } $rows->@*; } sub command ($name, $body) { __PACKAGE__->meta->add_method("_command_$name", sub ($self, $args) { if ($body) { $args =~ s/^\s*|\s*$//g; $body->($self, $args); return; } else { return 1; } }); } sub complete ($name, $body) { __PACKAGE__->meta->add_method("_complete_$name", sub ($self, $text) { $body->($self, $text); }); } command dsn => sub ($self, $dsn) { $self->sql(Chart::Clicker::SQL->new(dsn => $dsn)); }; for my $sql_keyword (qw(select with)) { command $sql_keyword => sub ($self, $query) { $self->last_query("$sql_keyword $query"); }; complete $sql_keyword => sub ($self, $text) { $self->_keyword_complete( $text, [ $self->_sql_keywords, $self->_sql_functions, $self->_sql_tables, $self->_sql_columns, ] ) }; } for my $method (qw(width height)) { command $method => sub ($self, $value) { $self->$method($value); }; complete $method => sub ($self, $text) { $self->_keyword_complete($text, [ $self->$method ]) }; } command timechart => sub ($self, $args) { $self->domain_axis_class( $args eq 'on' ? "Chart::Clicker::Axis::DateTime" : "Chart::Clicker::Axis" ) }; complete timechart => sub ($self, $text) { $self->_keyword_complete($text, [ 'off', 'on' ]); }; for my $renderer (qw(Line StackedLine Bar StackedBar Area StackedArea Point)) { command lc($renderer) => sub ($self, $args) { $self->renderer_class("Chart::Clicker::Renderer::$renderer"); }; } command exit => undef; command quit => undef; sub run ($self) { while (1) { my $prompt = "> "; if ($self->initialized) { $prompt = $self->sql->dsn . $prompt; } if (defined(my $input = $self->rl->readline($prompt))) { next unless length($input); chomp($input); my ($command, $args) = split(' ', $input, 2); my $exit; try { my $method = "_command_\L$command"; $exit = $self->$method($args); $self->_draw if $self->_can_draw } catch { warn $_; }; last if $exit; } else { print "\n"; last; } } } sub DEMOLISH ($self, $igd) { $self->rl->WriteHistory($self->history_file); } __PACKAGE__->meta->make_immutable; no Moose; 1;