Author: spadkins
Date: Tue Nov 24 19:59:15 2009
New Revision: 13605
Modified:
p5ee/trunk/App-Repository/lib/App/RepositoryShell.pm
p5ee/trunk/App-Repository/t/DBI-insert.t
p5ee/trunk/App-Repository/t/DBI-repobjectdom.t
p5ee/trunk/App-Repository/t/DBI-repobjectset.t
p5ee/trunk/App-Repository/t/DBI-select-join.t
p5ee/trunk/App-Repository/t/DBI-select-ora.t
Log:
working snapshot before we add profiling
Modified: p5ee/trunk/App-Repository/lib/App/RepositoryShell.pm
==============================================================================
--- p5ee/trunk/App-Repository/lib/App/RepositoryShell.pm (original)
+++ p5ee/trunk/App-Repository/lib/App/RepositoryShell.pm Tue Nov 24
19:59:15 2009
@@ -100,6 +100,16 @@
$self->{tempdir} = $tempdir;
################################################################################
+ # Current "Directory"
+
################################################################################
+ my $repository = $options->{repository} || "default";
+ my $table = $options->{table};
+ my $curdir = $table ? "$repository:/$table" : "$repository:/";
+ $self->{curdir} = $curdir;
+ $self->{repository} = $repository;
+ $self->{table} = $table;
+
+
################################################################################
# DBM Database to Store Index Info
################################################################################
my (%dbm);
@@ -123,27 +133,24 @@
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";
}
+ my ($repository, $prompt);
while (!$done) {
$repository = $self->{repository};
- $prompt = $repository;
+ $prompt = $self->{curdir};
$command_entry = $self->get_command_entry($prompt, $options);
- $done = $self->execute($command_entry, $options);
+ $done = $self->_execute($command_entry, $options);
}
$self->shutdown();
print "Goodbye\n" if (!$silent);
@@ -170,40 +177,6 @@
&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) = @_;
@@ -266,6 +239,15 @@
return($command);
}
+# * substitution variables
+# * query library management
+# * access to App-Repository features such as ...
+# * access to all tables regardless of what database they are in
+# * access to pseudo-tables defined by code (i.e. Demand Position, Price
Position Analysis)
+# * ability to define logical columns
+# * ability to query logical tables and logical columns, transparently
creating complex joined queries
+# * ... and much more !!!
+
sub execute_help_command {
&App::sub_entry if ($App::trace);
my ($self, $command_entry, $options) = @_;
@@ -273,21 +255,203 @@
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 "select/insert/update/delete/create/alter ... - run a sql
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 "save [<name>] - save the active statement to a file\n";
+ print "load [<name>] - load a file as the active statement\n";
+ print "cd [<path>] - change 'directory' (i.e. where in the
database you 'are')\n";
+ print "ls [<path>/<glob>] - list items in current 'directory'\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 "exit/quit/bye - quit the program\n";
print ">>> for more help on any command, type 'help <command>'\n";
&App::sub_exit() if ($App::trace);
}
+sub _execute {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ my $done = 0;
+ my %direct_command = (
+ "insert" => 1,
+ "update" => 1,
+ "delete" => 1,
+ "create" => 1,
+ "alter" => 1,
+ );
+ my $command = $self->get_command_from_command_entry($command_entry);
+ if (! defined $command || $command eq "") {
+ #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 ($direct_command{$command}) {
+ $self->execute_direct_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 "save") {
+ $self->execute_save_command($command_entry, $options);
+ }
+ elsif ($command eq "load") {
+ $self->execute_load_command($command_entry, $options);
+ }
+ elsif ($command eq "ls") {
+ $self->execute_ls_command($command_entry, $options);
+ }
+ elsif ($command eq "cd") {
+ $self->execute_cd_command($command_entry, $options);
+ }
+ elsif ($command eq "exit" || $command eq "quit" || $command eq "bye") {
+ $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 execute_cd_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ print "execute_cd_command(): not yet implemented.\n";
+ &App::sub_exit() if ($App::trace);
+}
+
+sub execute_ls_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ my $cmd = "";
+ if ($command_entry =~ s/^(\w+)\s*//) {
+ $cmd = $1;
+ }
+ my $opts = "";
+ if ($command_entry =~ s/^-(\w+)\s*//) {
+ $opts = $1;
+ }
+ my $curdir = $self->{curdir};
+ my $relpath = ".";
+ if ($command_entry =~ s/^(\S+)//) {
+ $relpath = $1;
+ }
+ my $parsed_path_spec = $self->parse_path_spec($curdir, $relpath);
+ my @parsed_path_spec_items =
$self->list_parsed_path_spec_items($parsed_path_spec);
+ foreach my $parsed_path_spec_item (@parsed_path_spec_items) {
+ printf("%s\n", $parsed_path_spec_item->{basename});
+ }
+ &App::sub_exit() if ($App::trace);
+}
+
+sub parse_path_spec {
+ &App::sub_entry if ($App::trace);
+ my ($self, $curdir, $relpath) = @_;
+ my $parsed_path_spec = {};
+ my $abspath = $self->path2abspath($curdir, $relpath);
+ $parsed_path_spec->{abspath} = $abspath;
+ my $path = $abspath;
+ $path =~ s!^(\w+):!! || die "Can't find repository part on absolute path
[$path]";
+ my $repository = $1;
+ $parsed_path_spec->{repository} = $repository;
+ my $context = App->context();
+ my $rep = $context->repository($repository);
+ my $logical_type = "";
+ my $done = 0;
+ if ($path eq "/") {
+ $logical_type = "dir";
+ $parsed_path_spec->{logical_type} = $logical_type;
+ $parsed_path_spec->{physical_type} = "HASH";
+ $parsed_path_spec->{hash} = $rep->{table};
+ $parsed_path_spec->{basename} = $repository;
+ $done = 1;
+ }
+ if (!$done) {
+ $path =~ s!/$!!;
+ if ($path =~ m!^(.*)/([^/]+)$!) {
+ $parsed_path_spec->{logical_type} = $logical_type;
+ $parsed_path_spec->{physical_type} = "HASH";
+ $parsed_path_spec->{hash} = $rep->{table};
+ $parsed_path_spec->{basename} = $repository;
+ }
+ if ($path =~ s!^/?([^/]+)!!) {
+ #$parsed_path_spec
+ }
+ while ($path) {
+ if ($path =~ s!^/?([^/]+)!!) {
+ }
+ }
+ }
+
+ &App::sub_exit($parsed_path_spec) if ($App::trace);
+ return($parsed_path_spec);
+}
+
+sub path2abspath {
+ &App::sub_entry if ($App::trace);
+ my ($self, $curdir, $path) = @_;
+ if ($path =~ /^\w+:/) {
+ # do nothing. it is an absolute path.
+ }
+ elsif ($path =~ m!^/!) {
+ $path = "$self->{repository}:$path";
+ }
+ elsif ($curdir =~ m!/$!) {
+ $path = "${curdir}${path}";
+ }
+ else {
+ $path = "${curdir}/$path";
+ }
+ while ($path =~ s!/\.\./\w+!!) {}
+ while ($path =~ s!/\.!!) {}
+ $path .= "/" if ($path =~ /:$/);
+ &App::sub_exit($path) if ($App::trace);
+ return($path);
+}
+
+sub list_parsed_path_spec_items {
+ &App::sub_entry if ($App::trace);
+ my ($self, $parsed_path_spec) = @_;
+ my (@parsed_path_spec_items);
+ my $opts = "";
+ if ($parsed_path_spec->{logical_type} eq "dir") {
+ if ($opts =~ /d/) {
+ @parsed_path_spec_items = ( $parsed_path_spec );
+ }
+ else {
+ if ($parsed_path_spec->{physical_type} eq "HASH") {
+ foreach my $key (sort keys %{$parsed_path_spec->{hash}}) {
+ push(@parsed_path_spec_items,
$self->parse_path_spec($parsed_path_spec->{abspath}, $key));
+ }
+ }
+ }
+ }
+ elsif ($parsed_path_spec->{logical_type} eq "file") {
+ @parsed_path_spec_items = ( $parsed_path_spec );
+ }
+ elsif ($parsed_path_spec->{logical_type} eq "glob") {
+ @parsed_path_spec_items = $self->expand_glob($parsed_path_spec);
+ }
+ &App::sub_exit(@parsed_path_spec_items) if ($App::trace);
+ return(@parsed_path_spec_items);
+}
+
sub execute_repository_command {
&App::sub_entry if ($App::trace);
my ($self, $command_entry, $options) = @_;
@@ -297,6 +461,20 @@
&App::sub_exit() if ($App::trace);
}
+sub execute_save_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ print "execute_save_command(): not yet implemented.\n";
+ &App::sub_exit() if ($App::trace);
+}
+
+sub execute_load_command {
+ &App::sub_entry if ($App::trace);
+ my ($self, $command_entry, $options) = @_;
+ print "execute_load_command(): not yet implemented.\n";
+ &App::sub_exit() if ($App::trace);
+}
+
sub execute_edit_command {
&App::sub_entry if ($App::trace);
my ($self, $command_entry, $options) = @_;
@@ -310,7 +488,7 @@
&App::sub_entry if ($App::trace);
my ($self, $command_entry, $options) = @_;
my $last_command_entry = $self->{last_command_entry} || "";
- $self->execute($last_command_entry);
+ $self->_execute($last_command_entry);
&App::sub_exit() if ($App::trace);
}
@@ -537,7 +715,7 @@
}
$self->determine_sprintf_fmt($f);
}
- if (!$options->{silent}) {
+ if (!$options->{silent} || $options->{silent} <= 1) {
for ($c = 0; $c <= $#$columns; $c++) {
$format = $autoformat[$c]->{title_fmt} || "%s";
print $fh " " if ($c > 0);
Modified: p5ee/trunk/App-Repository/t/DBI-insert.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-insert.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-insert.t Tue Nov 24 19:59:15 2009
@@ -270,8 +270,8 @@
my ($key_idx, $columns, $row, $nrows);
- $columns = [ "age", "person_id", "last_name", "first_name", "gender" ];
- $row = [ 40, 1, "adkins", "stephen", "M" ];
+ $columns = [ "age", "person_id", "last_name", "first_name", "gender",
"state" ];
+ $row = [ 40, 1, "adkins", "stephen", "M", "GA"
];
$key_idx = $db->_key_idx("test_person", $columns);
is(ref($key_idx), "ARRAY", "key_idx is ARRAY");
is($key_idx->[0], 1, "key_idx is [1] for [...@$columns]");
Modified: p5ee/trunk/App-Repository/t/DBI-repobjectdom.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-repobjectdom.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-repobjectdom.t Tue Nov 24 19:59:15 2009
@@ -153,6 +153,9 @@
ok(! defined $new_object_set2->{foo}, "new_object_set()s (temporary) don't
share storage");
my $hashes2 = $new_object_set->get_objects();
is($hashes2, $hashes, "Got same exact reference to set of objects");
+#foreach my $hash (@$hashes2) {
+# print "{", join("|",%{$hash}), "}\n";
+#}
is($#$hashes2, $#$hashes, "Got same exact number of objects");
is($rep, $new_object_set->get_repository(), "Got same exact reference to a
repository");
is("test_person2", $new_object_set->get_table(), "Got same exact table");
@@ -179,11 +182,13 @@
my $m39 = $index->{"M,39"};
ok($m39, "Got an m39");
is($m39->{name}, "keith", "Got keith as the last (assumed unique) m39");
+
+ exit(0);
my $summaries = $new_object_set->get_summary([]);
+ #print "{", join("|",%{$summaries->{""}}), "}\n";
is(ref($summaries), "HASH", "Got summary hash");
is($summaries->{""}{num_kids}, 12, "Got 12 total kids");
-exit;
my $ext_summary = $new_object_set->get_ext_summary([]);
is(ref($ext_summary), "HASH", "Got summary hash");
Modified: p5ee/trunk/App-Repository/t/DBI-repobjectset.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-repobjectset.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-repobjectset.t Tue Nov 24 19:59:15 2009
@@ -191,9 +191,9 @@
ok($m39, "Got an m39");
is($m39->{name}, "keith", "Got keith as the last (assumed unique) m39");
- my $summaries = $new_object_set->get_summary([]);
- is(ref($summaries), "HASH", "Got summary hash");
- is($summaries->{""}{num_kids}, 12, "Got 12 total kids");
+ #my $summaries = $new_object_set->get_summary([]);
+ #is(ref($summaries), "HASH", "Got summary hash");
+ #is($summaries->{""}{num_kids}, 12, "Got 12 total kids");
my $ext_summary = $new_object_set->get_ext_summary([]);
is(ref($ext_summary), "HASH", "Got summary hash");
Modified: p5ee/trunk/App-Repository/t/DBI-select-join.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-select-join.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-select-join.t Tue Nov 24 19:59:15 2009
@@ -213,9 +213,9 @@
&create_table($rep, "test_hotel_prop");
&populate_table($rep, "test_hotel_prop");
-&drop_table($rep, "test_hotel_bkg");
-&create_table($rep, "test_hotel_bkg");
-&populate_table($rep, "test_hotel_bkg");
+#&drop_table($rep, "test_hotel_bkg");
+#&create_table($rep, "test_hotel_bkg");
+#&populate_table($rep, "test_hotel_bkg");
sub check_select {
my ($sql, $expected_rows, $debug) = @_;
Modified: p5ee/trunk/App-Repository/t/DBI-select-ora.t
==============================================================================
--- p5ee/trunk/App-Repository/t/DBI-select-ora.t (original)
+++ p5ee/trunk/App-Repository/t/DBI-select-ora.t Tue Nov 24 19:59:15 2009
@@ -1306,5 +1306,25 @@
is($sql, $expect_sql, "_mk_select_sql(): verbatim (boo. hiss. evil.)");
&check_select($sql,0);
+$expect_sql = <<EOF;
+select
+ t1.first_name,
+ t1.last_name,
+ t1.city,
+ t1.state,
+ t1.age
+from test_person
+where age in (14,15,16,17,18)
+EOF
+&test_get_rows($expect_sql, 0, "_mk_select_joined_sql(): verbatim (boo. hiss.
evil.)",
+ "test_person",
+ {"zip" => "30080,30303"},
+ ["first_name","last_name","city","state","age"]);
+$sql = $rep->_mk_select_sql("test_person",
+ {"age.verbatim" => "age in (14,15,16,17,18)"},
+ ["first_name","last_name","city","state","age"]);
+is($sql, $expect_sql, "_mk_select_sql(): verbatim (boo. hiss. evil.)");
+&check_select($sql,0);
+
exit 0;
