#!/usr/bin/perl

use strict;
use warnings;

my $VERSION = '1.0';

use File::Temp      qw( tempfile                 );
use List::Util      qw( max sum                  );
use Time::HiRes     qw( gettimeofday tv_interval );
use Term::ReadKey;
use Term::ReadLine;
use DBI;

die "Usage: $0 <username>@<host>\n" unless scalar @ARGV;

my $term              = new Term::ReadLine;
my ($username, $host) = split '@', $ARGV[0];
my ($rows, $cols)     = GetTerminalSize();

$term->Features->{autohistory} = 0;

my $password;

{
    local $SIG{INT} = sub { ReadMode(0); exit; };
    ReadMode('noecho');
    print "Enter password: ";
    chomp( $password = ReadLine() );
    print "\n";
    ReadMode(0);
}

my $params = {
    RaiseError => 0,
    PrintError => 0,
    AutoCommit => 0,
};

my $dbh = db_connect();

my %constraints = (
    C => 'Check constraint',
    P => 'Primary key',
    U => 'Unique key',
    R => 'Referential integrity',
    V => 'With check option',
    O => 'With readonly',
);

my %programs = (
    editor => $ENV{EDITOR} || $ENV{VISUAL} || 'vim',
    pager  => $ENV{PAGER}  || 'less',
);

my $default_prompt = sprintf '%s@%s> ', $username, $host;
my $cont_prompt    = (' ' x ( length($username) + length($host) + 1 )) . '> ';
my $help_file      = join q{}, <DATA>;

my $last_query     = q{};
my $query          = q{};

my %conf_options = (
    use_tee    => 0,
    use_editor => 0,
    use_pager  => 0,
    max_cols   => $cols || 80,
    tee_file   => undef,
);

my %shortcuts = (
    q => sub { exit },
    h => sub { print $help_file; return },
    o => \&toggle,
    t => \&toggle,
    p => \&toggle,
    e => \&edit_query,
    c => sub {
            ($conf_options{max_cols}) = $1 if $_[0] =~ /^\S+\s+(\S+)/;
            print "Max cols before editor is run: $conf_options{max_cols}\n";
            return;
         },
    d => sub {q{
             SELECT
                TABLE_NAME as "table", OWNER as "owner"
             FROM
                all_tables
         }},
);

my %commands = (
    quit     => sub { exit },
    describe => \&desc_table,
    desc     => \&desc_table,
    help     => sub { print $help_file; return; },
);

my %messages = (
    commit   => "Commit completed.",
    rollback => "Rollback completed.",
);

my $prompt = $default_prompt;

COMMAND:
while (defined(my $command = $term->readline($prompt))) {
    my $ret_query = q{};

    if (   $command =~ /^\s*(\S+)[;\s]*(.*)$/
        && defined $commands{lc $1}
        && $prompt eq $default_prompt )
    {
        $ret_query = $commands{lc $1}->($2);
        next COMMAND unless $ret_query;
    }
    elsif ($command =~ /^\s*\\(.)/ && defined $shortcuts{lc $1}) {
        $ret_query = $shortcuts{lc $1}->($command);
        next COMMAND unless $ret_query;
    }

    if ($command !~ /(.*);\s*$/ && !$ret_query) {
        $query .= "$command ";
        $prompt = $cont_prompt;
        next COMMAND;
    }
    elsif ($ret_query) {
        $prompt  = $default_prompt;
        $query   = $ret_query;
        $command = q{};
    }

    my $run_all = $command =~ /;\s*$/;
    my @results = split ';', $command;

    $query .= shift @results if @results;

    if (!$dbh->ping()) {
        print "Connection appears to have gone away -- reconnecting.\n";
        $dbh = db_connect();
    }

    run_query($query);

    $term->addhistory("$query;");
    $last_query = $query;

    if ($command =~ /^\s*(\S+?);?\s*$/ && $messages{lc $1}) {
        print STDERR $messages{lc $1} . "\n";
    }

    $prompt = $default_prompt;
    $query  = q{};
}

sub run_query {
    my ($query) = @_;

    my $t0  = [gettimeofday];
    my $sth = $dbh->prepare($query);

    my $total_rows = 0;
    my $time_taken;

    if ($sth && $sth->execute()) {
        $time_taken = tv_interval($t0);

        if ($sth->rows) {
            printf STDERR "Query successful.  %d rows affected.\n", $sth->rows;
        }
        else {
            my @results = $sth->{NAME};

            return if !@{ $results[0] };

            while (my @row = $sth->fetchrow_array()) {
                push @results, [ map { defined $_ ? $_ : '\N' } @row ];
                $total_rows++;
            }

            display_results(@results);

        }
    }
    else {
        print STDERR "Query failed: ", DBI->errstr, "\n";
    }

    printf STDERR "\nQuery finished: %.2fs", $time_taken if $time_taken;
    print  STDERR " ($total_rows rows returned)" if $total_rows;
    print  STDERR "\n";

}

sub display_results {
    my @results = @_;

    my @col_sizes;
    my $cur_col = 0;
    my $cols    = 0;

    foreach my $column (@{ $results[0] }) {
        $col_sizes[ $cur_col ]
            = max map { $_->[$cur_col] ||= '\N'; length $_->[$cur_col] } @results;

        $cols = sum @col_sizes  +  3 * scalar(@col_sizes)  +  1;

        $cur_col++;
    }

    my ($fh, $filename, $tee_fh);

    my $tee    = $conf_options{use_tee} && $conf_options{tee_file};

    my $editor = $conf_options{use_editor}
              && (   $conf_options{max_cols} == -1
                  || $cols >= $conf_options{max_cols});
    my $pager  = !$editor && $conf_options{use_pager};

    if ($tee) {
        if (!open $tee_fh, '>>', $conf_options{tee_file}) {
            print STDERR "Failed appending to $conf_options{tee_file}!\n";
            $conf_options{use_tee} = 0;
        }
    }

    if ($editor || $pager) {
        ($fh, $filename) = tempfile(UNLINK => 0);
        select $fh;
    }
    else {
        $fh = \*STDOUT;
    }

    if (@results > 1) {
        foreach my $handle ($fh, (defined $tee_fh
                               && fileno  $tee_fh ? $tee_fh : ()))
        {
            select $handle;

            foreach my $result (@results) {
                print_row($result, \@col_sizes);
            }

            print_separator(@col_sizes);
        }
    }

    select STDOUT;

    system($programs{editor}, $filename) if $editor;
    system($programs{pager},  $filename) if $pager;

    unlink $filename if $filename;
}

sub print_separator {
    my (@sizes) = @_;

    foreach my $size (@sizes) {
        print '+';
        print '-' x ($size + 2);
    }

    print "+\n";
}

sub print_row {
    my ($results, $sizes) = @_;

    my $cur_col = 0;

    print_separator(@{ $sizes });

    foreach my $col (@{ $results }) {
        print '| ';
        print $col;
        print ' ' x ($sizes->[$cur_col++] - length($col) + 1);
    }

    print "|\n";
}

sub desc_table {
    my ($table) = @_;

    $table    =~ tr/;//d;
    my $owner =  q{};

    ($owner, $table) = split(/[.]/, $table) if $table =~ /[.]/;

    if (!$table) {
        print STDERR "Need a table name!\n";
        return;
    }

    my ($query) = q{
        SELECT
            column_name, data_type, data_length, data_precision, data_default
        FROM
            all_tab_columns
        WHERE
            UPPER(table_name) = UPPER(?)
    };

    $query .= " AND UPPER(owner) = UPPER(?)" if $owner;

    my $sth = $dbh->prepare($query);
    $sth->execute( $table, $owner ? $owner : () );

    my @results = [ qw( NAME TYPE DEFAULT ) ];
    my $rows    = 0;

    while (my $row = $sth->fetchrow_hashref) {
        $rows++;

        push(@results, [
            $row->{COLUMN_NAME},
            $row->{DATA_TYPE} . '(' . $row->{DATA_LENGTH}
         . ($row->{DATA_PRECISION} ? ',' . $row->{DATA_PRECISION} : '')
         .  ')',
            $row->{DATA_DEFAULT}
        ]);
    }

    if ($rows == 0) {
        print STDERR "Table not found!\n";
        return;
    }

    print "Columns in " . join(q{.}, $owner, $table) . "\n";

    display_results(@results);

    my $constraint_query = q{
        SELECT
            CONSTRAINT_NAME, CONSTRAINT_TYPE, SEARCH_CONDITION
        FROM
            ALL_CONSTRAINTS
        WHERE
            STATUS = ?
        AND
            UPPER(TABLE_NAME) = UPPER(?)
    };

    $constraint_query .= " AND UPPER(OWNER) = UPPER(?)" if $owner;

    my $constraint_sth = $dbh->prepare($constraint_query);

    $constraint_sth->execute( 'ENABLED', $table, $owner ? $owner : () )
        || print "Failed: " . DBI->errstr(). "\n";

    my $constraint_msg = 0;

    while (my $constraint = $constraint_sth->fetchrow_hashref) {
        print "Constraints:\n" if $constraint_msg++ == 0;

        printf(
            "\t%s %s: %s\n",
                          $constraint->{CONSTRAINT_NAME}  ,
            $constraints{ $constraint->{CONSTRAINT_TYPE} },
                          $constraint->{SEARCH_CONDITION} || q{},
        );
    }
}

sub get_path {
    my ($binary) = @_;

    if ($binary =~ m{/} && -e $binary && -s _ && -x _) {
        return $binary;
    }
    elsif ($binary =~ m{/}) {
        return;
    }

    foreach my $path (split q{:}, $ENV{PATH}) {
        return "$path/$binary" if -e "$path/$binary" && -s _ && -x _;
    }

    return;
}

sub edit_query {
    my $edit_query;

    my ($fh, $filename) = tempfile(UNLINK => 0);

    if ($query =~ /^\s*$/) {
        $edit_query = $last_query;
    }
    else {
        $edit_query = $query;
    }

    print $fh $edit_query;
    close $fh;

    system($programs{editor}, $filename);
    my $contents = slurp($filename);

    unlink $filename;
    return $contents;
}

sub slurp {
    my ($filename) = @_;

    open my $fh, '<', $filename;

    local $/ = undef;

    my $contents = <$fh>;

    close $fh;

    return $contents;
}

sub toggle {
    my ($command) = @_;

    my ($value, $parameter) = split /\s+/, $command, 2;

    my $which = $value eq '\t' ? 'tee'
              : $value eq '\o' ? 'editor'
              :                  'pager';

    $programs{$which} = get_path($parameter) if $parameter && $which ne 'tee';

    if (!$programs{$which} && $which ne 'tee') {
        print STDERR "Cannot find $which binary!  Cannot enable!\n";
        $conf_options{"use_$which"} = 0;
        return;
    }

    if ($parameter && $which eq 'tee') {
        $conf_options{tee_file} = $parameter;
    }

    if ($which eq 'tee' && !defined $conf_options{tee_file}) {
        print STDERR "Can't enable tee without providing a tee file!\n";
        return;
    }

    $conf_options{"use_$which"} ^= 1;

    print STDERR
        "Using $which now "
      . ($conf_options{"use_$which"} ? 'ENABLED' : 'DISABLED')
      . ($which ne 'tee' ? ".  Binary: $programs{$which}" : q{.});

    print STDERR " (Outputting to: $conf_options{tee_file})"
        if $conf_options{tee_file} && $which eq 'tee';

    print STDERR "\n";

    return;
}

sub db_connect {
    return DBI->connect("DBI:Oracle:$host", $username, $password, $params)
        || die "Failed connecting to db: " . DBI->errstr . "\n";
}

END {
    if (defined $dbh) {
        $dbh->rollback();
        $dbh->disconnect();
    }
}

=head1 NAME

oracle-client - An oracle sql client that I find far more useful than sqlplus.
It doesn't have many of the features of sqlplus, but I've never needed those
features -- I've needed the ones that this client provides.

=head1 DESCRIPTION

An oracle sql client.  It tries to mimic some of the functionality of more
useful clients that can be found in the clients for the opensource RDBMS
clients out there.

=head1 PREREQUISITES

This script requires the following modules:

   * C<strict>
   * C<File::Temp>
   * C<List::Util>
   * C<Time::HiRes>
   * C<Term::ReadKey>
   * C<Term::ReadLine>
   * C<DBI>
   * C<DBD::Oracle>

=pod OSNAMES

any

=pod SCRIPT CATEGORIES

Networking

=cut

__DATA__

Simply enter your SQL query. Across one line or many.

Use a semi-colon (;) to terminate the SQL command.

This client has readline support, so CTRL-U, the end and home keys, and arrow
keys should work, as well as history.

Commands:

    desc(ribe) <tablename> - Describes the table like in other database
                             clients that don't suck.
    help                   - You're reading it.
    quit                   - Pretty self-explanatory.

Shortcut commands:

    \d                     - Gets a table listing.
    \q                     - Quits.
    \o [editor]            - Output results to [editor] if width of results is
                             wider than \c's setting.  Set to -1 to always
                             output to editor.
    \t [filename]          - Enable tee'ing output to [filename]
                              - Output filename must be provided at some
                                point.
                              - File is not clobbered, it is appended to.
    \c [columns]           - Set the max number of columns before editor is
                             invoked to view results.  Defaults to terminal
                             column width, or 80 characters.  \o must be
                             enabled for this to have any effect.
    \p [binary]            - Use [binary] as a pager.  Defaults to PAGER
                             environment variable.
    \e                     - Use editor to edit current query, or last query
                             if current query is empty.