Author: spadkins
Date: Thu Mar 26 06:19:36 2009
New Revision: 12633
Modified:
p5ee/trunk/App-Repository/Makefile.PL
p5ee/trunk/App-Repository/bin/dash
p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm
p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm
Log:
initial version of dash
Modified: p5ee/trunk/App-Repository/Makefile.PL
==============================================================================
--- p5ee/trunk/App-Repository/Makefile.PL (original)
+++ p5ee/trunk/App-Repository/Makefile.PL Thu Mar 26 06:19:36 2009
@@ -9,6 +9,7 @@
my @programs = (
"bin/dbget",
+ "bin/dash",
);
%opts = (
Modified: p5ee/trunk/App-Repository/bin/dash
==============================================================================
--- p5ee/trunk/App-Repository/bin/dash (original)
+++ p5ee/trunk/App-Repository/bin/dash Thu Mar 26 06:19:36 2009
@@ -1,339 +1,65 @@
#!/usr/bin/perl -w
-use Date::Format;
+use strict;
use App::Options (
- options => [ qw(dbhost dbname dbuser dbpass repository table params
columns headings compact decimals subtotal_columns totals
- distinct cache_skip cache_refresh silent) ],
+ #options => [ qw(dbhost dbname dbuser dbpass repository table params
columns headings compact decimals subtotal_columns totals
+ # distinct cache_skip cache_refresh silent) ],
+ options => [ qw(dbhost dbname dbuser dbpass dbschema repository silent) ],
option => {
repository => {
default => "default",
- description => "Name of the repository to get the rows from",
- },
- table => {
- description => "Table name (i.e. --table=customer)",
- },
- params => {
- description => "List of params (var=value pairs) (i.e.
--params=\"last_name=Jones|first_name=Mike\")",
- },
- columns => {
- description => "List of columns (comma-separated list) (i.e.
--columns=first_name,last_name)",
- },
- headings => {
- description => "List of heading abbreviations (comma-separated)
(i.e. --headings=first,last)",
- },
- compact => {
- description => "Trim titles to make compact table",
- },
- decimals => {
- description => "Number of decimal places to print on floats",
- default => "2",
- },
- subtotal_columns => {
- description => "Print sub-totals at the end",
- },
- totals => {
- description => "Print totals at the end",
- },
- cache_skip => {
- description => "Skip any cached values for the table",
- },
- cache_refresh => {
- description => "Skip any cached values for the table but save the
results in the cache",
- },
- distinct => {
- description => "Select only distinct rows",
+ description => "Name of the repository to operate on",
},
+ #table => {
+ # description => "Table name (i.e. --table=customer)",
+ #},
+ #params => {
+ # description => "List of params (var=value pairs) (i.e.
--params=\"last_name=Jones|first_name=Mike\")",
+ #},
+ #columns => {
+ # description => "List of columns (comma-separated list) (i.e.
--columns=first_name,last_name)",
+ #},
+ #headings => {
+ # description => "List of heading abbreviations (comma-separated)
(i.e. --headings=first,last)",
+ #},
+ #compact => {
+ # description => "Trim titles to make compact table",
+ #},
+ #decimals => {
+ # description => "Number of decimal places to print on floats",
+ # default => "2",
+ #},
+ #subtotal_columns => {
+ # description => "Print sub-totals at the end",
+ #},
+ #totals => {
+ # description => "Print totals at the end",
+ #},
+ #cache_skip => {
+ # description => "Skip any cached values for the table",
+ #},
+ #cache_refresh => {
+ # description => "Skip any cached values for the table but save the
results in the cache",
+ #},
+ #distinct => {
+ # description => "Select only distinct rows",
+ #},
+ #log_level => {
+ # description => "Do not emit log messages normally created by
App-Repository",
+ # default => 0,
+ #},
silent => {
- default => 0,
description => "Do not emit prompts or other messages (useful
during scripted use)",
},
},
);
-use App;
-use strict;
-
-my $LOADED_TERM_READLINE = 0;
-my $term = undef;
-
-$| = 1; # autoflush stdout
+use App::RepositoryShell;
{
- my $context = App->context();
- my $options = $context->{options};
- &init($options);
- my $silent = $options->{silent};
- my $done = 0;
- my ($command, $command_entry);
- my $prompt = "dash";
- while (!$done) {
- $command_entry = &get_command_entry($prompt, $options);
- $command = &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 "?") {
- &show_help($command_entry);
- }
- elsif ($command eq "repository") {
- &set_repository($command_entry);
- }
- elsif ($command eq "select") {
- &show_select($command_entry);
- }
- 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";
- }
- }
- print "Goodbye\n" if (!$silent);
-}
-
-sub init {
- my ($options) = @_;
- eval { use Term::ReadLine; };
- if ($@) {
- $LOADED_TERM_READLINE = 0;
- }
- else {
- $LOADED_TERM_READLINE = 1;
- $term = Term::ReadLine->new($options->{app});
- }
-}
-
-sub get_command_entry {
- my ($prompt, $options) = @_;
- my ($command_entry);
- if ($LOADED_TERM_READLINE) {
- $command_entry = &get_command_entry_readline($prompt, $options);
- }
- else {
- $command_entry = &get_command_entry_std($prompt, $options);
- }
- return($command_entry);
-}
-
-sub get_command_entry_std {
- my ($prompt, $options) = @_;
- print "$prompt> " if (!$options->{silent});
- my $command_entry = <STDIN>;
- return($command_entry);
-}
-
-sub get_command_entry_readline {
- my ($prompt, $options) = @_;
- my $readline_prompt = $options->{silent} ? "" : "$prompt> ";
- my $command_entry = $term->readline($readline_prompt);
- return($command_entry);
-}
-
-sub get_command_from_command_entry {
- my ($command_entry) = @_;
- my ($command);
- if ($command_entry =~ /^([a-zA-Z_\?]+)/) {
- $command = $1;
- }
- return($command);
-}
-
-sub show_help {
- my ($command_entry) = @_;
- print "============================================================\n";
- print "COMMANDS:\n";
- print "============================================================\n";
- print "help - [synonym: ?] show this list of commands\n";
- print "exit - quit the program\n";
-}
-
-sub set_repository {
- my ($command_entry) = @_;
-}
-
-sub show_select {
- my ($command_entry) = @_;
- my $context = App->context();
- my $db = $context->repository($App::options{repository});
- my $rows = $db->_do($command_entry);
- foreach my $row (@$rows) {
- print "ROW:[", join("|", @$row), "]\n";
- }
-}
-
-sub foo {
- my $context = App->context();
- my $db = $context->repository($App::options{repository});
- my $table = $App::options{table};
- my ($columns, $params, $headings, $get_options, $cache_rows);
- if ($table && $App::options{hashkey}) {
- my $hashkey = $App::options{hashkey};
- my $table_def = $db->get_table_def($table);
- my $cache_name = $table_def->{cache_name};
- if ($cache_name) {
- my $cache = $context->shared_datastore($cache_name);
- my $ref = $cache->get_ref($hashkey);
- if (!$ref) {
- warn "Nothing in the [$cache_name] cache for table [$table]
with hashkey [$hashkey]\n";
- }
- else {
- ($table, $params, $columns, $cache_rows, $get_options) = @$ref;
- $get_options->{cache_skip} = 1;
- print $db->dump([$table, $params, $columns, $get_options]);
- }
- }
- else {
- warn "cache_name option is not set on table $table";
- }
- }
- else {
- if ($App::options{columns}) {
- $columns = [ split(/,/, $App::options{columns}) ];
- }
- else {
- $columns = $db->_get_default_columns($table);
- }
- die "Must supply the --params option\n" if (! defined
$App::options{params});
- $params = { split(/[=>\|]+/, $App::options{params}) };
- $headings = $App::options{headings} ? [ split(/,/,
$App::options{headings}) ] : [];
- $get_options = { extend_columns => 1 };
- }
- $get_options->{distinct} = 1 if ($App::options{distinct});
- $get_options->{cache_skip} = 1 if ($App::options{cache_skip});
- $get_options->{cache_refresh} = 1 if ($App::options{cache_refresh});
- my $rows = $db->get_rows($table, $params, $columns, $get_options);
- my ($subtotal_rows, $total_rows);
- if ($App::options{subtotal_columns}) {
- my $subtotal_columns = [ split(/,/, $App::options{subtotal_columns}) ];
- $subtotal_rows = $db->summarize_rows($table, $rows, $columns,
$subtotal_columns);
- }
- if ($App::options{totals}) {
- $total_rows = $db->summarize_rows($table, $rows, $columns);
- }
- if ($subtotal_rows) {
- push(@$rows, @$subtotal_rows);
- }
- if ($total_rows) {
- push(@$rows, @$total_rows);
- }
- my $formats = [];
- &print_table($rows, $columns, $formats, { compact =>
$App::options{compact}, headings => $headings });
-}
-
-sub print_table {
- &App::sub_entry if ($App::trace);
- my ($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});
- }
- }
- &determine_sprintf_fmt($f);
- }
- for ($c = 0; $c <= $#$columns; $c++) {
- $format = $autoformat[$c]->{title_fmt} || "%s";
- print " " if ($c > 0);
- $heading = ($headings && $headings->[$c]) ? $headings->[$c] :
$columns->[$c];
- printf($format, $heading);
- }
- print "\n";
- for ($r = 0; $r <= $#$rows; $r++) {
- $row = $rows->[$r];
- for ($c = 0; $c <= $#$row; $c++) {
- $format = $autoformat[$c]->{fmt} || "%s";
- print " " if ($c > 0);
- printf($format, $row->[$c]);
- }
- print "\n";
- }
- &App::sub_exit() if ($App::trace);
-}
-
-sub determine_sprintf_fmt {
- &App::sub_entry if ($App::trace);
- my ($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);
+ my $shell = App::RepositoryShell->new();
+ $shell->run();
}
exit (0);
Modified: p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository/DBI.pm Thu Mar 26 06:19:36 2009
@@ -2470,7 +2470,7 @@
sub _do {
&App::sub_entry if ($App::trace);
- my ($self, $sql) = @_;
+ my ($self, $sql, $options) = @_;
$self->{error} = "";
$self->{sql} = $sql;
my $dbh = $self->{dbh};
@@ -2494,7 +2494,12 @@
while ($continue) {
eval {
if ($sql =~ /^select/i) {
- $retval = $dbh->selectall_arrayref($sql);
+ if ($options->{columns}) {
+ $retval = $self->_selectall_arrayref($sql, $options);
+ }
+ else {
+ $retval = $dbh->selectall_arrayref($sql);
+ }
}
else {
$retval = $dbh->do($sql)+0; # turn "0E0" into plain old "0"
@@ -2544,6 +2549,33 @@
$retval;
}
+sub _selectall_arrayref {
+ &App::sub_entry if ($App::trace);
+ my ($self, $sql, $options, $attr, @bind) = @_;
+ my $dbh = $self->{dbh};
+ my $sth = (ref $sql) ? $sql : $dbh->prepare($sql, $attr)
+ or return;
+ $sth->execute(@bind) || return;
+
+ my $columns = $options->{columns};
+ if ($columns && ref($columns) eq "ARRAY") {
+ my $sth_columns = $sth->{NAME_lc};
+ @$columns = @{$sth->{NAME_lc}};
+ }
+
+ my $slice = $attr->{Slice}; # typically undef, else hash or array ref
+ if (!$slice and $slice=$attr->{Columns}) {
+ if (ref $slice eq 'ARRAY') { # map col idx to perl array idx
+ $slice = [ @{$attr->{Columns}} ]; # take a copy
+ for (@$slice) { $_-- }
+ }
+ }
+ my $rows = $sth->fetchall_arrayref($slice, my $MaxRows = $attr->{MaxRows});
+ $sth->finish if defined $MaxRows;
+ &App::sub_exit($rows) if ($App::trace);
+ return $rows;
+}
+
#############################################################################
# begin_work()
#############################################################################
Modified: p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/Repository/Oracle.pm Thu Mar 26
06:19:36 2009
@@ -729,13 +729,13 @@
sub is_retryable_connection_error {
my ($self, $e) = @_;
- warn "Oracle-specific error messages not defined";
+ #warn "Oracle-specific error messages not defined";
return($e =~ /TBD-FOO/);
}
sub is_retryable_modify_error {
my ($self, $e) = @_;
- warn "Oracle-specific error messages not defined";
+ #warn "Oracle-specific error messages not defined";
return($e =~ /TBD-FOO/);
}
