=head1 NAME

SQL::Steno - short hand for SQL and compact output

=head1 SYNOPSIS

Type some short-hand, see the corresponding SQL and its output:

 steno> TABLE1;somecolumn > 2    -- ; after tables means where
 select * from TABLE1 where somecolumn > 2;
 prepare: 0.000s   execute: 0.073s   rows: 14
   id|column1                                    |column2
     |                                           |    |somecolumn
 ----|-------------------------------------------|----|-|
   27|foo                                        |    |7|
   49|bar                                        |abcd|3|
   81|baz\nbazinga\nbazurka                      |jk  |9|
 1984|bla bla bla bla bla bla bla bla bla bla bla|xyz |5|
 ...
 steno> /abc|foo/#TBL1;.socol > 2    -- /regexp/ grep, #tableabbrev, .columnabbrev
 select * from TABLE1 where somecolumn > 2;
 prepare: 0.000s   execute: 0.039s   rows: 14
 id|column1
   |   |column2
   |   |    |somecolumn
 --|---|----|-|
 27|foo|    |7|
 49|bar|abcd|3|
 steno> .c1,.c2,.some;#TE1#:ob2d3    -- ; before tables means from, 2nd # alias, :macro
 select column1,column2,somecolumn from TABLE1 TE1 order by 2 desc, 3;
 ...
 steno> .col1,.clm2,.sn;#TBL1:jTBL2 u(id);mydate :b :m+3d and :d-w    -- :jTABLEABBREV and :+/- family
 select column1,column2,somecolumn from TABLE1 join TABLE2 using(id) where mydate between date_format(now(),"%Y-%m-01")+interval 3 day and curdate()-interval 1 week;
 ...

=head1 DESCRIPTION

You're the command-line type, but are tired of typing C<select * from TABLE
where CONDITION>, always forgetting the final C<;>?  Output always seems far
too wide and at least mysql cli messes up the format when it includes
newlines?

This module consists of the function C<convert> which implements a
configurable ultra-compact language that maps to SQL.  Then there is C<run>
which performs normal SQL queries but has various tricks for narrowing the
output.  It can also grep on whole rows, rather than having to list all fields
that you expect to match.  They get combined by the function C<shell> which
converts and runs in an endless loop.

This is work in progress, only recently isolated from a monolithic script.
Language elements and API may change as the need arises, e.g. C<:macro> used
to be C<@macro>, till the day I wanted to use an SQL-variable and noticed the
collision.  In this early stage, you are more than welcome to propose
ammendments, especially if they make the language more powerful and/or more
consistent.  Defaults are for MariaDB/MySQL, though the mechanism also works
with other DBs.

=cut

package SQL::Steno;
our $VERSION = v0.1;

use strict;
use Time::HiRes qw(gettimeofday tv_interval);

binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';

our $dbh;

our( %Table_Columns, $table_re );
sub init {
    die "\$dbh is undef\n" unless $dbh;
    local @{$dbh}{qw(PrintWarn PrintError RaiseError)} = (0, 0, 0); # \todo is this right? views can barf because more restrictive.
    for my $table ( @{$dbh->table_info->fetchall_arrayref} ) {
	$Table_Columns{uc $table->[2]} = [];
	splice @$table, 3, -1, '%';
	my $info = $dbh->column_info( @$table ) or next;
	for my $column ( @{$info->fetchall_arrayref} ) {
	    push @{$Table_Columns{$table->[2]}}, uc $column->[3];
	}
    }
    undef $table_re;		# (re)create below
}
our $init_from_query = <<\SQL;
	select ucase(TABLE_NAME), ucase(COLUMN_NAME)
	from information_schema.COLUMNS
	where TABLE_SCHEMA = schema()
SQL
sub init_from_query {
    die "\$dbh is undef\n" unless $dbh;
    local @{$dbh}{qw(PrintWarn PrintError RaiseError)} = (0, 0, 0); # \todo is this right?
    my $sth = $dbh->prepare( $init_from_query );
    $sth->execute;
    $sth->bind_columns( \my( $table, $column ));
    push @{$Table_Columns{$table}}, $column while $sth->fetch;
    undef $table_re;		# (re)create below
}
my @keys_Table_Columns;

our( %Queries_help, %Queries );
sub Queries(@) {
    for( @_ ) {
	$Queries_help{$_->[0]} = $_->[1];
	$Queries{$_->[0]} = $_->[2];
    }
}
Queries
    [ps => '   show processlist (without Sleep)',
      '/^(?!.+\|Sleep)/=show processlist'],

    [psf => '   show full processlist (without Sleep)',
      '/^(?!.+\|Sleep)/=show full processlist'],


    [s => 'var,value   set @var = value',
      'set @$1=$2'],

    [ss => 'var,value   set @var = "value"',
      'set @$1=$"*"'],

    [sd => 'var,value   set @var = cast("value" as date)',
      'set @$1=cast($"*" as date)'],

    [sdt => 'var,value   set @var = cast("value" as datetime)',
      'set @$1=cast($"*" as datetime)'],

    [st => 'var,value   set @var = cast("value" as time)',
      'set @$1=cast($"*" as time)'],

    [sy => '            set @a, @z   yesterday is between @a and @z  (see :baz)',
      #'set @a=date(now())-interval 1 day, @z=date(now())-interval 1 second',
     'select @a:=date(now()-interval 1 day)`@a`, @z:=date(now())-interval 1 second`@z`'];


our $weekstart = 1;
my $timespec_re = qr/[yqmwdhMs]?/;
our %Join_clause;
our %Macros =
   (
    b => ' between',
    baz => ' between @a and @z',
    d => ' distinct',
    h => ' having',
    j => ' join',
    l => ' like',
    lj => ' left join',
    n => ' is null',
    nb => ' not between',
    nc => ' sql_no_cache',
    nl => ' not like',
    nn => ' is not null',
    nr => ' not rlike',
    r => ' rlike',
    u => ' union select',
    ua => ' union all select',
    wr => ' with rollup',
    '' => sub {
	my $join = 'for all #TBL matching TABLE use abbreviation as alias...';
	my $int = 'see :+  :-  :y-m  :q+0  :d+2h';
	my $gob = 'for 0 or more digits, optionally followed by a or d';
	return ([jTBL => $join], [ljTBL => $join], [1 => 'for all numbers'],
		[gb147 => $gob], [ob2d5a9 => $gob],
		['+' => <<INT], ['-' => $int], ['d+2h' => $int], ['y-m' => $int], ['q+0' => $int])
:B+/-NO this B(ase) +/- N(umber, 0 for none, default 1 if O given) O(ffset)
	optional B, O is y(ear), q(uarter), m(onth), w(eek), d(ay), h(our), M(inute), s(econd)
INT
	    unless @_;		# help
	for( $_[0] ) {
	    return " limit $_" if /^\d+$/;
	    # \todo [og]b
	    if( s/^([og])b(?=(?:\d[ad]?)*$)/ $1 eq 'g' ? ' group by ' : ' order by ' /e ) {
		s/(?<! )(?=\d)/, /g;
		s/a/ asc/g; s/(?<!r)d/ desc/g;
		return $_;
	    }
	    if( s/^(l?)j/#/ ) {	# (l)jtbl: j or lj with any #tbl
		my $left = $1 ? ' left' : '';
		&convert_table_column;
		/^(\w+)/;
		return "$left join $_" . ($Join_clause{$1} || $Join_clause{''} || '');
	    }
	    return $_ if
		s(^($timespec_re)([+-])(\d*)($timespec_re)$) {
		    ({ y => ' date_format(now(),"%Y-01-01")',
		       q => ' date_format(now()-interval mod(month(now())+11,3) month,"%Y-%m-01")',
		       m => ' date_format(now(),"%Y-%m-01")',
		       w => ' curdate()-interval weekday(now())' . ($weekstart ? ' day' : '+1 day'),
		       d => ' curdate()',
		       h => ' date_format(now(),"%F %H:00")',
		       M => ' date_format(now(),"%F %H:%M")',
		       s => ' now()' }->{$1} || '') .
		    ($3 ne '0' &&
		     "$2interval" .
		     ($3 ? " $3" : $4 ? ' 1' : '') .
		     ({ y => ' year',
			q => ' quarter',
			m => ' month',
			w => ' week',
			d => ' day',
			h => ' hour',
			M => ' minute',
			s => ' second' }->{$4} || ''))
		}eo;
	}
    });

# \todo default arg n() -> n(*) time*(now())
our %Functions =
   (
    c => 'concat',
    cw => 'concat_ws',
    coa => 'coalesce',
    gc => 'group_concat',
    i => 'in',			# not really fn, but ( follows
    in => 'ifnull',
    l => 'char_length',
    lc => 'lcase',
    m => 'min',
    M => 'max',
    n => 'count',
    ni => 'not in',		# -"-
    s => 'substring',
    u => 'using',		# -"-
    uc => 'ucase'
   );
our @Functions = qw(
    abs acos adddate addtime aes_decrypt aes_encrypt ascii asin atan atan avg
    benchmark bin bit_and bit_count bit_length bit_or bit_xor cast ceiling
    char_length char character_length charset coalesce coercibility collation
    compress concat_ws concat connection_id conv convert_tz cos cot count crc32
    curdate current_date current_time current_timestamp current_user curtime
    database date_add date_format date_sub date datediff day dayname dayofmonth
    dayofweek dayofyear decode default degrees des_decrypt des_encrypt elt encode
    encrypt exp export_set field find_in_set floor format found_rows from_days
    from_unixtime get_format get_lock greatest group_concat hex hour if ifnull
    inet_aton inet_ntoa insert instr interval is_free_lock is_used_lock isnull
    last_insert_id lcase least left length ln load_file localtime localtimestamp
    locate log10 log2 log lower lpad ltrim make_set makedate maketime
    master_pos_wait max md5 microsecond mid min minute mod month monthname
    name_const now nullif oct octet_length old_password ord password period_add
    period_diff pi position power quarter quote radians rand release_lock repeat
    replace reverse right round row_count rpad rtrim schema sec_to_time second
    session_user sha1 sign sin sleep soundex space sqrt stddev stddev_pop
    stddev_samp str_to_date strcmp subdate substring_index substring subtime sum
    sysdate system_user tan time_format time_to_sec time timediff timestamp
    timestampadd timestampdiff to_days trim truncate ucase uncompress
    uncompressed_length unhex unix_timestamp upper user utc_date utc_time
    utc_timestamp uuid values var_pop var_samp variance week weekday weekofyear
    year yearweek);

# \todo #tbl -> table  #tbl# -> table tbl  #tbl#alias -> table alias  :jtbl#alias -> join table alias using...
our %Tables;
our %Columns;

sub regexp($$) {
    my( $str, $type ) = @_;
    if( $type < 2 ) {
	return if $str !~ /_/; # Otherwise same as find sprintf cases
	return ($type ? '' : '^') . join '.*?_', split /_/, $str; # 0 & 1
    }
    my $expr = join '.*?', split //, $str; # 2, 3 & 4
    if( $type < 4 ) {
	substr $expr, 0, 0, '^'; # 2 & 3
	$expr .= '$' if $type == 2; # 2
    }
    $expr;
}

my $error;
my @simple = qw(^%s$ ^%s_ ^%s _%s$ _%s %s$ %s_ %s);
sub find($$$\%;\@) {
    my( $str, $prefix, $suffix, $hash, $list ) = @_;
    my $ret = $hash->{$str};
    return $ret if $ret;

    $ret = $hash->{''};
    $ret = &$ret( $str ) if $ret;
    return $ret if $ret;

    if( $list ) {
	for my $type ( 0..@simple+4 ) { # Try to find a more and more fuzzy match.
	    my $expr = $type < @simple ?
		sprintf $simple[$type], $str :
		regexp $str, $type - @simple;
	    next unless defined $expr;
	    my @res = grep /$expr/i, @$list;
	    if( @res ) {
		return $res[0] if @res == 1;
		warn "$prefix$str$suffix matches @res\n";
		$error = 1;
		return '';
	    }
	}
    }
    # no special syntax for fields or functions, so don't fail on real one
    return $str if ord $prefix == ord '.' or ord $suffix == ord '(';

    warn "$prefix$str$suffix doesn't match\n";
    $error = 1;
}

sub convert_Queries($$) {
    my $res = find $_[0], '&', '', %Queries;
    local $_ =  $_[1];
    &convert_table_column;
    my @arg = split ',';
    my @rest;
    for my $i ( 1..@arg ) {
	$res =~ s/\$$i/$arg[$i - 1]/g or $res =~ s/\$"$i"/"$arg[$i - 1]"/g or push @rest, $arg[$i - 1];
    }
    $res =~ s!\$\?(.*?)\?(.*?)\?!@rest ? $1 : $2!e;
    $res =~ s!\$"\*"!'"' . join( '","', @rest ) . '"'!ge or
	$res =~ s!\$\*!join( ',', @rest )!ge;
    $res;
}

sub convert_table_column {
    # \todo .col. or .col.alias like #tbl#
    @keys_Table_Columns = keys %Table_Columns unless @keys_Table_Columns;
    s&(?<!\\)#(\w+)(?:#(\w*))?&find( $1, '#', '', %Tables, @keys_Table_Columns ) . ($2 ? " $2" : defined $2 ? " $1" : '')&eg unless $error;

    unless( $error ) {
	my %column;
	for( grep /$table_re/io, split /\W+/ ) {
	    undef $column{$_} for @{$Table_Columns{$_}};
	}
	my @column = keys %column;
	s/(^|[-+\s(,;&|])?(?<!\\)\.([a-z]\w*)/(defined $1 ? $1 : '.') . find $2, '.', '', %Columns, @column/egi;
    }
}


=head2 convert

This function takes a short-hand query in C<$_> and transforms it to SQL.  See
L</shell> for more run time oriented features.

First it looks for C<:macro>.  These are mostly simple text-replacements
stored in C<%Macros>.  There are also some dynamic macros.  Those starting
with C<:j> or C<:lj> may continue into a table spec without the leading C<#>.
E.g. C<:ljtbl#t> might expand to C<left join table t>.

Those starting with C<:gb> or C<:ob> may be followed by result columns numbers
from 1-9, each optionally followed by a or d for asc or desc.

Then there are the time macros, where an optional leading letter indicates a
base time, and an optional trailing letter with an optional count means the
offset.  The letters are:

=over

=item y

(this) year.  E.g. C<:y+2m> is march this year.

=item q

(this) quarter.  E.g. C<:q+0> is this quarter, C<:q+q> is next quarter.

=item m

(this) month.  E.g. C<:-3m> is whatever precedes, minus 3 months.

=item w

(this) week (starting on C<$weekstart>).  E.g. C<:w+3d> is this week thursday (or wednesday).

=item d

(this) day.  E.g. C<:d-w> is midnight one week ago.

=item h

(this) hour.  E.g. C<:h+30M> is half past current hour.

=item M

(this) minute.  E.g. C<:+10M> is whatever precedes, plus 10min.

=item s

(this) second.  E.g. C<:s-2h> is exactly 2h ago.

=back

Then it looks for C<#tbl>, C<#tbl#> or C<#tbl#alias>.  Here tbl is a key of
C<%Tables> or any abbreviation of known tables in C<@Tables>.  If followed by
C<#>, the abbrev is used as an alias, unless an alias directly follows, in
which case that is used.

Then it looks for C<.col>.  Here col is a key of C<%Columns> or any
abbreviation of columns of any table recognized in the query.

Finally it looks for C<func(>.  Here func is a key of C<%Functions> or any
abbreviation of known functions in C<@Functions>, which includes words
typically followed by an opening parenthesis, such as C<u(> for C<using(>.
C<i(> is C<in(>, so that C<in(> is free for matching C<ifnull(>, but more
importantly, because it has a smart brother: C<I(> is also C<in(>, where
quoting is applied as necessary, and unless you give an initial comma C<I(,>,
the elements are separated on space.  E.g. C<I(a 3 a's q"q)> and
C<I(,a,3,a's,q"q)> both give C<in("a",3,"a's",'q"q')>.

Finally it picks on the structure of the statement: These keywords can be
abbreviated: C<se(lect)>, C<ins(ert)>, C<upd(ate)> or C<del(ete)>.  If none of
these or C<set> is present, C<select> is assumed as default (more keywords
need to be recognized in the future).

For C<select>, semicolons are alternately replaced by C<from> (the 1st being
optional if it starts with a table name) and C<where>.  If no result columns
are given, they default to C<*>, see L</SYNOPSIS>.  For C<update>, semicolons
are frst replaced by C<set> and then C<where>.

=cut

sub convert {
    # Handle I(str1 str2 str3)
    s<\bI\((, ?)?(.+?)\)> { 'i('.join(',', map { /"/ ? "'$_'" : /^\d+$/ ? $_ : qq+"$_"+ } split $1||' +', $2, -1).')' }ge;

    my @strings;		# extract strings to prevent following replacements inside.
    while( /\G.*?(['"])/gc ) {
	my $quote = $1;
	my $pos = pos;
	while( /\G.*?([\\$quote])/gc ) {
	    if( $1 eq '\\' ) {
		++pos;		# skip next
	    } elsif( ! /\G$quote/gc ) { # skip double quote
		push @strings, substr $_, $pos - 1, 1 - $pos + pos, # get string
		    "\cA".@strings."\cB"; # and replace with counter
		last;
	    }
	}
    }

    # \todo (?(?<=\w)\b)
    s&(?<!\\):($timespec_re[+-]\d*$timespec_re(?(?<=\w)\b)|l?j\w+(?:#(\w*))|\w+)&find $1, ':', '', %Macros&ego unless $error;

    unless( $table_re ) {
# \todo ?: help
	$table_re = join '|', keys %Table_Columns;
	$table_re = $table_re ? qr/\b(?:$table_re)\b/ : qr/\s\b\s/;
    }
    s&^(?=#|$table_re)&;&;		# Assume empty fieldlist before table name
    &convert_table_column;

    s&\b(\w+)(?=\()&find $1, '', '(', %Functions, @Functions or $1&eg unless $error;

    return if $error;
    s/\A\s*;/*;/;
    s/;\s*\Z//;
    if( s/^upd(?:a(?:t(?:e)?)?)?\b/update/i ) {
	s/(?<!\\);(?:\s*set\s*)?/ set / && s/(?<!\\);(?:\s*where\s*)?/ where /;
    } else {
	s/(?<!\\);(?:\s*where\s*)?/ where / while s/(?<!\\);(?:\s*from\s*)?/ from /;
	s/^ins(?:e(?:r(?:t)?)?)?\b/insert/i ||
	    s/^del(?:e(?:t(?:e)?)?)?\b/delete/i ||
	    s/^(?!se(?:lec)?t)/select /i;
    }

    s/ {2,}/ /g;
    s/\cA(\d+)\cB/$strings[$1]/g; # put back the strings

    1;
}


my %ctrl =
    ("\t", '\t',
     "\n", '\n',
     "\r", '\r');
my $lasttime = time;

sub run($$;$$$) {
    my( $dbh, $sql, $re, $fh, $csv ) = @_;
    my $t0 = [gettimeofday];
    unless( $t0->[0] - $lasttime < 3600 || $dbh->ping ) {
	printf STDOUT "Inactive for %ds, ping failed after %.03fs, your set variables are lost.\n",
	    $t0->[0] - $lasttime, tv_interval $t0;
	#$dbh->disconnect;
	$dbh = $dbh->clone;	# reconnect
	$t0 = [gettimeofday];
    }
    $lasttime = $t0->[0];
    if( my $sth = UNIVERSAL::isa( $sql, 'DBI::st' ) ? $sql : $dbh->prepare( $sql )) {
	my $t1 = [gettimeofday];
	$sth->execute;
	# \todo Steno time, optionally #rows grepped
	printf STDOUT "prepare: %.03fs   execute: %.03fs   rows: %d\n",
	    tv_interval( $t0, $t1 ), tv_interval( $t1 ), $DBI::rows;
	if( $sth->{Active} ) {
	    my @name = @{$sth->{NAME}};
	    print join( ',', @name ) . "\n" if $csv;
	    my @len = (1) x @name;
	    my( @txt, @res, @comp );
	    while( my @res1 = $sth->fetchrow_array ) {
		next if $re && join( '|', map $_ // '\@', @res1 ) !~ $re;
		if( $csv ) {
		    for( @res1 ) {
			$_ //= '';
			$_ = qq!"$_"! if
			    s/"/""/g or
			    tr/,\n// or
			    /\A=/;
			utf8::decode $_;
		    }
		    print join( ',', @res1 ) . "\n";
		    next;
		} else {
		    for my $i ( 0..$#res1 ) {
			if( !defined $res1[$i] ) {
			    $res1[$i] = '\@';
			} elsif( $res1[$i] !~ /^\d+(?:\.\d+)?$/ ) {
			    $txt[$i] = 1;
			    $res1[$i] =~ s/\r\n/\\R/g;
			    $res1[$i] =~ s/([\t\n\r])/$ctrl{$1}/g;
			    no warnings 'uninitialized';
			    $res1[$i] =~ s/^(?:(0000-)00-00|(1970-)01-01)(?:( 00:)00:00)?$/$1$2$3/ or
				$res1[$i] =~ s/^(\d{4}-\d\d-\d\d )?(?:00:00:00|23:59:5(9))$/$1 . ($2 ? '24:' : '00:')/e or
				$res1[$i] =~ s/^((\d{4}-\d\d-\d\d )?\d\d:\d\d):00$/$1/;
			    utf8::decode $res1[$i];
			}
			$txt[$i] = 0 if @txt < $i;
			my $len = length $res1[$i];
			$len[$i] = $len if $len[$i] < $len;
		    }
		    if( @comp ) {
			for my $i ( 0..$#comp ) {
			    undef $comp[$i] if defined $comp[$i] && $comp[$i] ne $res1[$i];
			}
		    } else {
			@comp = @res1;
		    }
		    push @res, \@res1;
		}
	    }
	    if( @res ) {
		@comp = () if @res == 1;
		my $fmt = '';
		for( my $i = 0; $i < @name; ++$i ) {
		    $name[$i] =~ s/\r\n/\\R/g;
		    $name[$i] =~ s/([\t\n\r])/$ctrl{$1}/g;
		    if( defined $comp[$i] ) {
			my $more;
			while( defined $comp[$i] ) {
			    printf $fmt, @name[0..$i-1] unless $more;
			    $more = 1;
			    printf "[%s=%s]", $name[$i], $comp[$i];
			    @name[0..$i] = ('') x ($i+1);
			    for my $row ( \@comp, \@name, \@len, \@txt, @res ) {
				splice @$row, $i, 1;
			    }
			}
			print "\n";
			--$i, next;
		    }
		    if( $len[$i] < length $name[$i] ) {
			printf "$fmt%s\n", @name[0..$i];
			@name[0..$i] = ('') x ($i+1);
		    }
		    $fmt .= '%' . ($txt[$i] ? -$len[$i] : $len[$i]) . 's|';
		}
		$fmt .= "\n";
		printf $fmt, @name if $name[-1];
		printf $fmt, map '-'x$_, @len;
		my $cnt = 0;
		my $i = 100;
		for my $row ( @res ) {
		    printf $fmt, @$row;
		    ++$cnt;
		    if( !$fh && --$i <= 0 && $cnt < @res ) {
			printf STDERR "How many more, or * for all? (%d of %d) [default: 100] ",
			    $cnt, scalar @res;
			$i = <>;
			if( defined $i ) {
			    $i =~ tr/ \t\n\r//d;
			    $i = (0 == length $i) ? 100 :
				$i eq '*' ? ~0 :
				$i == 0 ? last :
				$i;
			} else {
			    print "\n";
			    last;
			}
		    }
		}
	    }
	}
    }
}


=head2 shell

This function reads, converts and (if C<$dbh> is set) runs in an end-less loop
(i.e. till end of file or C<^D>).  Reading is a single line affair, unless you
request otherwise.  This can happen either, as in Unix Shell, by using
continuation lines as long as you put a backslash at the end of your lines.
Or there is a special case, if the 1st line starts with C<\\>, then everything
up to C<\\> at the end of one of the next lines, constitutes one entry.

In addition to converting it offers a few extra features, performed in this
order (i.e. C<&xyz> can return C</regexp/=literal sql> etc.):

=over

=item &query arg, ...

=item &query( arg, ... ) following text

These allow canned entries and are more complex than macros, in that they take
arguments and replacement can depend on the argument.

=item /regexp/...

This will treat the statement ... normally, but will join each output row with
'|' characters and check that against the regexp.  Only matching output rows
are considered.

=item =literal sql

A preceding C<=> prevents conversion, useful for hitherto untreated keywords
or where the conversion doesn't play well with your intention.

=item ?

Help prefix.  Alone it will give an overview.  You can follow up with any of
the special syntaxes, with or without an abbreviation.  E.g. C<?(> will show
all function abbreviations, whereas C<?abbrev(> will show only those functions
matching abbrev or C<?#abbrev> only those tables matching abbrev.

=item ??statemment

Will convert and show, but not perform statement.  If C<$dbh> is not set, this
is the default behaviour.

=item !Unix Shell code

Run it.

=item {Perl code}

Run it.  If it returns a DBI statement handle also run that.

=item >filename

Redirect next statement to filename.  If it has a suffix C<.csv>, an according
format is used.

=back

=cut

our $prompt = 'steno> ';
sub shell() {
    print STDERR $prompt;
    my( $fh, $csv );
    while( <> ) {
	undef $error;
	goto NEXT unless /\S/;
	if( s/^\s*\\\\\s*// ) {
	    s/\s*\Z/\n/s;
	    local $/ = "\\\\\n";	# leading \n gets chopped below
	    $_ .= <>;
	    chomp;
	} else {
	    while( s/(?<!\\)((?:\\\\)*)\\(?=\n\Z)/$1/ ) {	# join continuation lines
		print STDERR '...> ';
		$_ .= <>;
	    }
	    s/\A\s+//;
	}
	s/\s+\Z//;

	s!^\&(\w+)(\(((?:(?>[^()]+)|(?2))*)\))!convert_Queries $1, $3!e
	    or s!^\&(\w+) *(.*)!convert_Queries $1, $2!e unless $error;

	my $re = $1 ? qr/$2/i : qr/$2/ if s!^(i?)/(.+?)/\s*!!;
	goto RUN if s/^\s*=//;	# run literally

	my $skip = 0;
	if( /^\s*\?\s*(?:([?&#.:])(\w*)|(\w*)\()?/ ) { # help
	    if( $1 && $1 eq '?' ) {
		s/^\s*\?\s*\?//;
		$skip = 1;
	    } else {
		help( $1, $2, $3 );
		goto NEXT;
	    }
	}
	if( s/^\s*!// ) {
	    system $_;
	    if( $? == -1 ) {
		print STDERR "failed to execute: $!\n";
	    } elsif( my $exit = $? & 0b111_1111 ) {
		printf STDERR "child died with signal %d, with%s coredump\n",
		    $exit, ($? & 0b1000_0000) ? '' : 'out';
	    } else {
		printf STDERR "child exited with value %d %d\n", $?, $? >> 8;
	    }
	    goto NEXT;
	}
	if( s/^\s*(\{(?:(?>[^{}]+)|(?1))*\})// ) {
	    my $ret = eval $1;
	    warn $@ if $@;
	    if( UNIVERSAL::isa $ret, 'DBI::st' ) {
		$_ = $ret;
		goto RUN;
	    }
	    local $| = 1;	# flush to avoid stderr prompt overtaking last output line.
	    goto NEXT;
	}
	s/^\s*()//;			# dummy because $1 survives loop iterations :-o
	if( /\A>\s*(.+?(\.csv)?)\s*\Z/ ) {	# redirect output
	    $csv = 1 if $2;
	    open $fh, '>:utf8', (glob $1)[0];
	    select $fh;
	    goto NEXT;
	}

	undef $error;

	goto NEXT unless $_ && &convert;

	print STDOUT "$_;\n";
	goto NEXT if $skip;

      RUN:
	run $dbh, $_, $re, $fh, $csv if $dbh;
	if( $fh ) {
	    close;
	    select STDOUT;
	    undef $fh;
	    undef $csv;
	}
      NEXT:
	print STDERR $prompt;
    }
    print STDERR "\n";
}



sub helphashalt(\%@) {
    my $hash = shift;
    if( @_ ) {
	my $ret = $hash->{''};
	print "for *ptr, *cr, *cp, ...:\n";
	printf "%-5s %s\n", $_, &$ret( $_ )
	    for @_;
	print "\n";
    }
    $_ eq '' or printf "%-5s %s\n", $_, $hash->{$_}
	for sort keys %$hash;
}
sub helphash($$$\%;\@) {
    #my( $str, $prefix, $suffix, $hash, $list ) = @_;
    if( $_[0] ) {
	undef $error;
	$error or printf "%-7s %s\n", "$_[1]$_[0]$_[2]", $_ if $_ = &find;
    } else {
	my %hash = %{$_[3]};
	if( my $sub = delete $hash{''} ) {
	    my @list = $sub->();
	    for my $elt ( @list ) {
		$hash{$elt->[0]} = $sub->( my $name = $elt->[0] ) . '    ' . $elt->[1];
	    }
	}
	printf "%-7s %s\n", "$_[1]$_$_[2]", $hash{$_}
	    for sort { lc( $a ) cmp lc( $b ) or  $a cmp $b } keys %hash;
	return unless $_[4];
	my $i = 0;
	my @list = sort { lc( $a ) cmp lc( $b ) or  $a cmp $b } @{$_[4]};
	while( @list ) {
	    if( ($i += length $list[0]) < 80 ) {
		print ' ', shift @list;
	    } else {
		$i = 0;
		print "\n";
	    }
	}
	print "\n" if $i;
    }
}

sub help {
    if( defined $_[2] ) {
	local $Functions{I} = 'in  but quotes strings itself, splits on space, or with beginning if I(, ... or I(,...';
	helphash $_[2], '', '(', %Functions, @Functions;
    } elsif( !$_[0] ) {
	print <<\HELP;
All entries are single line unless \\wrapped at 1st bol and last eol\\ or continued.\
Queries have the form: {{i}/regexp/}{=}query
The query has lots of short-hands expanded, unless it is prefixed by the optional =.
The fields joined with '|' are grepped if regexp is given, case-insensitively if i is given.

??query		Only shows massaged query.
!perl-code	Runs perl-code.
>file		Next query's output to file.  In csv format if filename has .csv suffix.

Query has the form {select|update|insert|delete}{fieldlist};tablelist{;clause} or set ...
'select' is prepended if none of these initial keywords.
fieldlist defaults to '*', also if Query starts with '#'.
';' is alternately replaced by 'from' and 'where' except '\;'.

Abbreviations, more help with ?&{abbrev}, ?#{abbrev}, ?.{abbrev}, ?{abbrev}(, ?:{abbrev}
&query $1,$2,...	# only at bol
&query($1,$2,...)...	# only at bol, only replace upto )
#table
.column			# for any table recognized in statement
function(
:macro

Characters \t\n\r get masked in output, \r\n as \R.
Date or time 0000-00-00 -> 0000-  1970-01-01 -> 1970-  00:00:00 -> 00:  23:59:59 -> 24:
HELP
    } elsif( $_[0] eq '#' ) {
	@keys_Table_Columns = keys %Table_Columns unless @keys_Table_Columns;
	helphash $_[1], '#', '', %Tables, @keys_Table_Columns;
    } elsif( $_[0] eq '.' ) {
	helphashalt %Columns, 'ptr' unless $_[1];
	$error or print "$_\n" if
	    $_[1] and $_ = find $_[1], '.', '', %Columns; # \todo, @column;
    } elsif( $_[0] eq '&' ) {
	helphash $_[1], '&', '', %Queries_help;
    } else {
	local $Tables{TBL} = 'TABLE';
	helphash $_[1], ':', '', %Macros;
    }
}

=head1 YOUR SCRIPT

    package SQL::Steno;		# doesn't export yet, so get the functions easily
    use SQL::Steno;
    use DBI;
    our $sql = DBI->connect( ... ); # preferably mysql, but other DBs should work (with limitations).
    # If you want #tbl and .col to work, (only) one of:
    init_from_query;		# fast, defaults to mysql information_schema, for which you need read permission
    init;			# slow, using DBI dbh methods.
    # Set any of the variables mentioned above to get you favourite abbreviations.
    shell;

=head1 LICENSE

This program is free software; you may redistribute it and/or modify it under
the same terms as Perl itself.

=head1 SEE ALSO

L<DBI>, L<SQL::Interp>, L<SQL::Preproc>, L<SQL::Yapp>

=head1 AUTHOR

(C) 2015 by Daniel Pfeiffer <occitan@esperanto.org>.