Author: spadkins
Date: Thu Mar 26 09:48:42 2009
New Revision: 12636
Added:
p5ee/trunk/App-Repository/lib/App/RepositoryShell.pm
Log:
new
Added: p5ee/trunk/App-Repository/lib/App/RepositoryShell.pm
==============================================================================
--- (empty file)
+++ p5ee/trunk/App-Repository/lib/App/RepositoryShell.pm Thu Mar 26
09:48:42 2009
@@ -0,0 +1,593 @@
+
+#############################################################################
+## $Id: RepositoryShell.pm 12569 2009-03-05 05:08:58Z spadkins $
+#############################################################################
+
+package App::RepositoryShell;
+$VERSION = (q$Revision: 12569 $ =~ /(\d[\d\.]*)/)[0]; # VERSION numbers
generated by svn
+
+use strict;
+
+use App;
+use File::Temp qw(tempfile);
+use Fcntl; # For O_RDWR, O_CREAT, etc.
+use SDBM_File;
+
+$| = 1; # autoflush stdout
+
+=head1 NAME
+
+App::RepositoryShell - The core logic for "dash", the Data Access Shell
+
+=head1 SYNOPSIS
+
+ use App::RepositoryShell;
+
+ my $shell = App::RepositoryShell->new();
+ $shell->run();
+
+=cut
+
+=head1 DESCRIPTION
+
+The core logic for "dash", the Data Access Shell.
+
+=cut
+
+sub new {
+ &App::sub_entry if ($App::trace);
+ my ($this) = @_;
+ my $class = ref($this) || $this;
+ my $self = bless {}, $class;
+
+ my $context = App->context();
+ $self->{context} = $context;
+ my $options = $context->{options};
+ my $prefix = $options->{prefix};
+
+ $self->{interactive} = (-t STDIN) ? 1 : 0;
+
+ if ($self->{interactive}) {
+ eval { use Term::ReadLine; };
+ if ($@) {
+ $self->{loaded_term_readline} = 0;
+ }
+ else {
+ $self->{loaded_term_readline} = 1;
+ my $terminal = Term::ReadLine->new($options->{app});
+ # us,ue,md,me
+ #$terminal->ornaments(",,,");
+ #my @foo = $terminal->ornaments();
+ #print "ornaments:[...@foo]\n";
+ #$terminal->ornaments(0);
+ $self->{terminal} = $terminal;
+ }
+ my $silent = $options->{silent};
+ $silent = 0 if (!defined $silent);
+ $self->{silent} = $silent;
+ }
+ else {
+ $self->{loaded_term_readline} = 0;
+
+ my $silent = $options->{silent};
+ $silent = 1 if (!defined $silent);
+ $self->{silent} = $silent;
+ }
+
+
################################################################################
+ # tempdir
+
################################################################################
+ my ($tempdir);
+ if ($ENV{HOME}) {
+ my $homedir = $ENV{HOME};
+ mkdir("$homedir/.dash") if (! -d "$homedir/.dash");
+ mkdir("$homedir/.dash/tmp") if (! -d "$homedir/.dash/tmp");
+ mkdir("$homedir/.dash/command") if (! -d "$homedir/.dash/command");
+ mkdir("$homedir/.dash/report") if (! -d "$homedir/.dash/report");
+ $tempdir = "$homedir/.dash/tmp" if (-d "$homedir/.dash/tmp");
+ }
+ if (!$tempdir) {
+ mkdir("$prefix/tmp") if (! -d "$prefix/tmp");
+ $tempdir = "$prefix/tmp" if (-d "$prefix/tmp");
+ }
+ if (!$tempdir) {
+ mkdir("/tmp") if (! -d "/tmp");
+ $tempdir = "/tmp" if (-d "/tmp");
+ }
+ if (!$tempdir) {
+ die "Can't create a temporary directory";
+ }
+ $self->{tempdir} = $tempdir;
+
+
################################################################################
+ # DBM Database to Store Index Info
+
################################################################################
+ my (%dbm);
+ my $dbmfile = "$ENV{HOME}/.dash/info";
+ my $dbmfile_needs_initialization = (! -f "$dbmfile.dir");
+ tie(%dbm, 'SDBM_File', $dbmfile, O_RDWR|O_CREAT, 0664)
+ or die "Couldn't tie SDBM file '$dbmfile': $!; aborting";
+ $self->{dbm} = \%dbm;
+ $self->init_dbmfile() if ($dbmfile_needs_initialization);
+
+ &App::sub_exit($self) if ($App::trace);
+ return($self);
+}
+
+sub run {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @_;
+ my $context = $self->{context};
+ my $options = $context->{options};
+ my $prefix = $context->{prefix};
+ my $silent = $self->{silent};
+ my $done = 0;
+ my ($command, $command_entry);
+ my $repository = $options->{repository} || "default";
+
+ $self->{repository} = $repository;
+ $self->{pager} = "default";
+ $self->{results} = [];
+ $self->{params} = {};
+
+ my ($prompt);
+
+ if (!$silent) {
+ print
"#####################################################################################\n";
+ print "# Welcome to 'dash', the Data Access Shell\n";
+ print "# >>> Type 'help' at the command line for help. <<<\n";
+ print
"#####################################################################################\n";
+ }
+ while (!$done) {
+ $repository = $self->{repository};
+ $prompt = $repository;
+
+ $command_entry = $self->get_command_entry($prompt, $options);
+ $done = $self->execute($command_entry, $options);
+ }
+ $self->shutdown();
+ print "Goodbye\n" if (!$silent);
+ &App::sub_exit() if ($App::trace);
+}
+
+sub shutdown {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @_;
+
+ my $dbm = $self->{dbm};
+ untie %$dbm;
+
+ &App::sub_exit() if ($App::trace);
+}
+
+sub init_dbmfile {
+ &App::sub_entry if ($App::trace);
+ my ($self) = @_;
+
+ my $dbm = $self->{dbm};
+ # ... do stuff here ...
+
+ &App::sub_exit() if ($App::trace);
+}
+
+sub execute {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ my $done = 0;
+ my $command = $self->get_command_from_command_entry($command_entry);
+ if (!$command) {
+ #print "I didn't understand that.\n";
+ #print "Please try 'help' for help on the available commands and their
use\n";
+ }
+ elsif ($command eq "help" || $command eq "?") {
+ $self->execute_help_command($command_entry, $options);
+ }
+ elsif ($command eq "repository") {
+ $self->execute_repository_command($command_entry, $options);
+ }
+ elsif ($command eq "select") {
+ $self->execute_select_command($command_entry, $options);
+ $self->save_sql($command_entry);
+ }
+ elsif ($command eq "edit") {
+ $self->execute_edit_command($command_entry, $options);
+ $self->execute_run_command("run", $options);
+ }
+ elsif ($command eq "exit") {
+ $done = 1;
+ }
+ else {
+ print "I don't know the '$command' command.\n";
+ print "Please try 'help' for help on the available commands and their
use\n";
+ }
+ &App::sub_exit($done) if ($App::trace);
+ return($done);
+}
+
+sub get_command_entry {
+ &App::sub_entry if ($App::trace);
+ my ($self, $prompt, $options) = @_;
+ my ($command_entry);
+ if ($self->{loaded_term_readline}) {
+ $command_entry = $self->get_command_entry_readline($prompt, $options);
+ }
+ else {
+ $command_entry = $self->get_command_entry_std($prompt, $options);
+ }
+ &App::sub_exit($command_entry) if ($App::trace);
+ return($command_entry);
+}
+
+sub get_multiline_command_entry {
+ &App::sub_entry if ($App::trace);
+ my ($self, $prompt, $ml_command_entry, $terminator, $options) = @_;
+ $prompt = "" if ($options->{silent});
+ my ($line);
+ while ($ml_command_entry !~ s/\s*$terminator\s*$//) {
+ $line = $self->get_command_entry($prompt, $options);
+ if (!$line || $line eq "exit") {
+ last;
+ }
+ else {
+ $ml_command_entry .= "\n" . $line;
+ }
+ }
+ &App::sub_exit($ml_command_entry) if ($App::trace);
+ return($ml_command_entry);
+}
+
+sub get_command_entry_std {
+ &App::sub_entry if ($App::trace);
+ my ($self, $prompt, $options) = @_;
+ print "$prompt> " if (!$options->{silent});
+ my $command_entry = <STDIN>;
+ $command_entry = "exit" if (!$command_entry && eof(STDIN));
+ &App::sub_exit($command_entry) if ($App::trace);
+ return($command_entry);
+}
+
+sub get_command_entry_readline {
+ &App::sub_entry if ($App::trace);
+ my ($self, $prompt, $options) = @_;
+ my $readline_prompt = $options->{silent} ? "" : "$prompt> ";
+ my $command_entry = $self->{terminal}->readline($readline_prompt);
+ &App::sub_exit($command_entry) if ($App::trace);
+ return($command_entry);
+}
+
+sub get_command_from_command_entry {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry) = @_;
+ my ($command);
+ if ($command_entry =~ /^([a-zA-Z_\?]+)/) {
+ $command = lc($1);
+ }
+ &App::sub_exit($command) if ($App::trace);
+ return($command);
+}
+
+sub execute_help_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ print "============================================================\n";
+ print "COMMANDS:\n";
+ print "============================================================\n";
+ print "help - [synonym: ?] show this list of commands\n";
+ print "select ... - run a select statement and make it the active
statement\n";
+ print "repository [<name>] - set or show the current repository\n";
+ #print "table [<name>] - set or show the current table\n";
+ #print "param [<name>] - set or show the current params\n";
+ #print "save [<name>] - save the active statement to a file\n";
+ #print "load [<name>] - load a file as the active statement\n";
+ #print "result [<name>] - redisplay a recently shown result set\n";
+ #print "show [<name>] - redisplay a recently shown result set\n";
+ #print "run [<name>] - (re-)run the active statement\n";
+ print "edit - edit and run the last command on the command
stack\n";
+ print "exit - quit the program\n";
+ print ">>> for more help on any command, type 'help <command>'\n";
+ &App::sub_exit() if ($App::trace);
+}
+
+sub execute_repository_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ if ($command_entry =~ /^\s*repository\s+(\w+)/s) {
+ $self->{repository} = $1;
+ }
+ &App::sub_exit() if ($App::trace);
+}
+
+sub execute_edit_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ my $last_command_entry = $self->{last_command_entry} || "";
+ my $modified_command_entry = $self->edit($last_command_entry);
+ $self->{last_command_entry} = $modified_command_entry;
+ &App::sub_exit() if ($App::trace);
+}
+
+sub execute_run_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ my $last_command_entry = $self->{last_command_entry} || "";
+ $self->execute($last_command_entry);
+ &App::sub_exit() if ($App::trace);
+}
+
+sub execute_select_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ my $sql = $self->get_multiline_command_entry("sql", $command_entry, ";",
$options);
+ my $context = $self->{context};
+ my $db = $context->repository($self->{repository});
+ my $columns = [];
+ my ($rows);
+ eval {
+ $rows = $db->_do($sql, {columns => $columns});
+ };
+ if ($@) {
+ # [23480] 2009-03-10 23:48:55 DBI Exception (fail) in _do():
DBD::Oracle::db prepare failed: ORA-00942: table or view does not exist (DBD
ERROR: error possibly near <*> indicator at char 16 in 'select foo from
<*>boo') [for Statement "select foo from boo"] at
/usr/rubicon/spadkins/src/p5ee/App-Repository/lib/App/Repository/DBI.pm line
2556. select foo from booDBD::Oracle::db prepare failed: ORA-00942: table or
view does not exist (DBD ERROR: error possibly near <*> indicator at char 16 in
'select foo from <*>boo') [for Statement "select foo from boo"] at
/usr/rubicon/spadkins/src/p5ee/App-Repository/lib/App/Repository/DBI.pm line
2556.
+ my $e = $@;
+ #print "EXCEPTION: [$e]\n";
+ $e =~ s/ at (\S+) line .*//;
+ #print "EXCEPTION: (remove at*) [$e]\n";
+ $e =~ s/.* _do\(\): //;
+ #print "EXCEPTION: (remove _do()*) [$e]\n";
+ $e =~ s/(\(DBD ERROR:)/\n$1/;
+ #print "EXCEPTION: (newline before DBD ERROR) [$e]\n";
+ $e =~ s/(\[for Statement)/\n$1/;
+ #print "EXCEPTION: (newline before for Statement) [$e]\n";
+ print $e;
+ }
+ else {
+ my $results = $self->{results};
+ push(@$results, $rows);
+ my $formats = [];
+ my $table = "";
+ if ($sql =~ /\bfrom\s+(\w+)/is) {
+ $table = $1;
+ }
+ my $fh = $self->open_tempfile("result");
+ my $headings = $self->get_headings($db, $table, $columns, $options);
+ $self->print_table($fh, $rows, $columns, $formats, { compact =>
$options->{compact}, headings => $headings, silent => $options->{silent} });
+ system("less -Sin $self->{result}");
+ }
+ $self->{last_command_entry} = $command_entry;
+ &App::sub_exit() if ($App::trace);
+}
+
+sub edit {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry) = @_;
+ my $filename = $self->write_tempfile("edit", $command_entry);
+ system("vi $filename");
+ $command_entry = $self->read_tempfile("edit");
+ &App::sub_exit($command_entry) if ($App::trace);
+ return($command_entry);
+}
+
+sub open_tempfile {
+ &App::sub_entry if ($App::trace);
+ my ($self, $file_use) = @_;
+ my ($fh);
+ my $filename = $self->{$file_use};
+ if ($filename) {
+ open(App::RepositoryShell::FILE, "> $filename") || die "Unable to open
temporary $file_use: $!\n";
+ $fh = \*App::RepositoryShell::FILE;
+ }
+ else {
+ my $tempdir = $self->{tempdir};
+ ($fh, $filename) = tempfile("${file_use}-XXXXXX", DIR => $tempdir,
SUFFIX => ".txt", UNLINK => 1);
+ $self->{$file_use} = $filename;
+ }
+ &App::sub_exit($fh) if ($App::trace);
+ return($fh);
+}
+
+sub read_tempfile {
+ &App::sub_entry if ($App::trace);
+ my ($self, $file_use) = @_;
+ my ($fh);
+ my $data = "";
+ my $filename = $self->{$file_use};
+ if ($filename) {
+ open(App::RepositoryShell::FILE, "< $filename") || die "Unable to
write $file_use file: $!\n";
+ local($/) = undef;
+ $data = <App::RepositoryShell::FILE>;
+ close(App::RepositoryShell::FILE);
+ }
+ &App::sub_exit($data) if ($App::trace);
+ return($data);
+}
+
+sub write_tempfile {
+ &App::sub_entry if ($App::trace);
+ my ($self, $file_use, $data) = @_;
+ my $fh = $self->open_tempfile($file_use);
+ print $fh $data;
+ close($fh);
+ my $filename = $self->{$file_use};
+ &App::sub_exit($filename) if ($App::trace);
+ return($filename);
+}
+
+sub save_sql {
+ &App::sub_entry if ($App::trace);
+ my ($self, $sql) = @_;
+ # ...
+ &App::sub_exit() if ($App::trace);
+}
+
+sub get_headings {
+ &App::sub_entry if ($App::trace);
+ my ($self, $db, $table, $columns, $options) = @_;
+ my $table_def = $db->get_table_def($table);
+ my $headings = [];
+ my ($alias);
+ foreach my $column (@$columns) {
+ if (!defined $table_def->{column}{$column}) {
+ if ($columns =~ /_/) {
+ $column = $self->symbol2abbr($column);
+ }
+ push(@$headings, $column);
+ }
+ elsif ($columns =~ /^\w+$/) {
+ $alias = $table_def->{column}{$column}{alias} || "";
+ if (!$alias || $alias =~ /^c\d+$/) {
+ $alias = $self->symbol2abbr($column);
+ }
+ push(@$headings, $alias);
+ }
+ else {
+ push(@$headings, $column);
+ }
+ }
+ &App::sub_exit($headings) if ($App::trace);
+ return($headings);
+}
+
+sub symbol2abbr {
+ &App::sub_entry if ($App::trace);
+ my ($self, $symbol) = @_;
+ my ($abbr);
+ if ($symbol =~ /_/) {
+ $symbol = $self->symbol2abbr($symbol);
+ my @abbr = grep { s/^(.).*//; } split(/_/, $symbol);
+ $abbr = join("", @abbr);
+ }
+ else {
+ $abbr = $symbol;
+ }
+ &App::sub_exit($abbr) if ($App::trace);
+ return($abbr);
+}
+
+sub print_table {
+ &App::sub_entry if ($App::trace);
+ my ($self, $fh, $rows, $columns, $formats, $options) = @_;
+ my ($row, $r, $c, $elem, $format, $len, $f, $heading);
+ my (@autoformat);
+ my $headings = $options->{headings};
+
+ # compute the number of columns as the max columns of any row
+ my $max_columns = 0;
+ for ($r = 0; $r <= $#$rows; $r++) {
+ $row = $rows->[$r];
+ if ($max_columns < $#$row + 1) {
+ $max_columns = $#$row + 1;
+ }
+ }
+
+ # compute automatic sprintf formats
+ for ($c = 0; $c < $max_columns; $c++) {
+
+ if (! defined $autoformat[$c]) {
+ $autoformat[$c] = {
+ max_length => 0,
+ type => 2, # 0=string, 1=float, 2=integer
+ min => undef,
+ max => undef,
+ };
+ }
+ $f = $autoformat[$c];
+
+ # set the length of the column by the length of its heading
+ $heading = ($headings && $headings->[$c]) ? $headings->[$c] : "";
+ if ($heading) {
+ $len = length($heading);
+ if ($len > $f->{max_length}) {
+ $f->{max_length} = $len;
+ }
+ }
+ elsif (! $options->{compact}) {
+ $len = length($columns->[$c]);
+ if ($len > $f->{max_length}) {
+ $f->{max_length} = $len;
+ }
+ }
+
+ for ($r = 0; $r <= $#$rows; $r++) {
+ $row = $rows->[$r];
+ if ($c <= $#$row && defined $row->[$c]) {
+ $elem = $row->[$c];
+ $len = length($elem);
+ if ($elem =~ /^-?[0-9]*\.[0-9]+$/) { # float
+ $len = length(sprintf("%.$App::options{decimals}f",$elem));
+ $f->{type} = 1 if ($f->{type} > 1);
+ if (!defined $f->{min} || $elem < $f->{min}) {
+ $f->{min} = $elem;
+ }
+ if (!defined $f->{max} || $elem < $f->{max}) {
+ $f->{max} = $elem;
+ }
+ }
+ elsif ($elem =~ /^-?[0-9]+$/) { # integer
+ if (!defined $f->{min} || $elem < $f->{min}) {
+ $f->{min} = $elem;
+ }
+ if (!defined $f->{max} || $elem < $f->{max}) {
+ $f->{max} = $elem;
+ }
+ }
+ else {
+ $f->{type} = 0;
+ }
+ $f->{max_length} = $len if ($len > $f->{max_length});
+ }
+ }
+ $self->determine_sprintf_fmt($f);
+ }
+ if (!$options->{silent}) {
+ for ($c = 0; $c <= $#$columns; $c++) {
+ $format = $autoformat[$c]->{title_fmt} || "%s";
+ print $fh " " if ($c > 0);
+ $heading = ($headings && $headings->[$c]) ? $headings->[$c] :
$columns->[$c];
+ printf($fh $format, $heading);
+ }
+ print $fh "\n";
+ }
+ for ($r = 0; $r <= $#$rows; $r++) {
+ $row = $rows->[$r];
+ for ($c = 0; $c <= $#$row; $c++) {
+ $format = $autoformat[$c]->{fmt} || "%s";
+ print $fh " " if ($c > 0);
+ printf($fh $format, $row->[$c]);
+ }
+ print $fh "\n";
+ }
+ &App::sub_exit() if ($App::trace);
+}
+
+sub determine_sprintf_fmt {
+ &App::sub_entry if ($App::trace);
+ my ($self, $f) = @_;
+ my ($width, $int_len, $fract_len);
+ if ($f->{type} == 1) { # float
+ $f->{title_fmt} = "%$f->{max_length}.$f->{max_length}s";
+ $f->{fmt} = "%$f->{max_length}.$App::options{decimals}f";
+ }
+ elsif ($f->{type} == 2) { # integer
+ $f->{title_fmt} = "%$f->{max_length}.$f->{max_length}s";
+ $f->{fmt} = "%$f->{max_length}d";
+ }
+ else { # string
+ $f->{title_fmt} = "%-$f->{max_length}.$f->{max_length}s";
+ $f->{fmt} = "%-$f->{max_length}s";
+ }
+ &App::sub_exit($f->{fmt}) if ($App::trace);
+}
+
+=head1 ACKNOWLEDGEMENTS
+
+ * Author: Stephen Adkins <[email protected]>
+ * License: This is free software. It is licensed under the same terms as Perl
itself.
+
+=head1 SEE ALSO
+
+L<C<App::Context>|App::Context>,
+L<C<App::Repository>|App::Repository>
+
+=cut
+
+1;
+
