updated shell code to register query commands with Tcl object

[scpubgit/DX.git] / lib / DX / ShellSession.pm

diff --git a/lib/DX/ShellSession.pm b/lib/DX/ShellSession.pm
index dd4c2a9..1e6cdc7 100644 (file)
--- a/lib/DX/ShellSession.pm
+++ b/lib/DX/ShellSession.pm
@@ -2,10 +2,16 @@ package DX::ShellSession;
 
 use Tcl;
 use Scalar::Util qw(weaken);
+use DX::Expander;
 use DX::Class;
 
 has shell_state => (is => 'rwp', required => 1, isa => ShellState);
 
+has expander => (
+  is => 'lazy', builder => sub { DX::Expander->new(tcl => $_[0]->tcl) },
+  handles => [ qw(expand_args) ],
+);
+
 has tcl => (is => 'lazy', builder => sub {
   my ($self) = @_;
   weaken $self;
@@ -19,6 +25,14 @@ has tcl => (is => 'lazy', builder => sub {
   $tcl->CreateCommand('.' => sub {
     $self->apply_to_state([ mode => 'shell' ])
   });
+  foreach my $pred (
+    keys %{$self->shell_state->template_query_state->predicates}
+  ) {
+    $tcl->CreateCommand($pred => sub {
+      my (undef, undef, undef, @args) = @_; # ($data, $interp, $pred)
+      $self->apply_predicate($pred => @args);
+    });
+  }
   return $tcl;
 });
 
@@ -43,8 +57,19 @@ sub is_complete_command_string {
 sub eval_command_string {
   my ($self, $string) = @_;
   local our @Result;
-  $self->tcl->Eval($string);
+  try {
+    $self->tcl->Eval($string);
+  } catch {
+    push @Result, [ output => $_ ];
+  };
   return @Result;
 }
 
+sub apply_predicate {
+  my ($self, $pred, @args) = @_;
+  die "Can't call predicate ${pred} outside a query\n"
+    unless $self->shell_state->mode eq 'query';
+use Data::Dumper::Concise; die Dumper [ $pred, $self->expand_args(@args) ];
+}
+
 1;