lib/DX/ShellSession.pm

   1 package DX::ShellSession;
   2
   3 use Tcl;
   4 use Scalar::Util qw(weaken);
   5 use DX::Expander;
   6 use DX::Class;
   7
   8 has shell_state => (is => 'rwp', required => 1, isa => ShellState);
   9
  10 has expander => (
  11   is => 'lazy', builder => sub { DX::Expander->new(tcl => $_[0]->tcl) },
  12   handles => [ qw(expand_args) ],
  13 );
  14
  15 has tcl => (is => 'lazy', builder => sub {
  16   my ($self) = @_;
  17   weaken $self;
  18   my $tcl = Tcl->new;
  19   $tcl->CreateCommand('?' => sub {
  20     $self->apply_to_state([ 'new_query_state' ], [ mode => 'query' ])
  21   });
  22   $tcl->CreateCommand('?+' => sub {
  23     $self->apply_to_state([ mode => 'query' ])
  24   });
  25   $tcl->CreateCommand('.' => sub {
  26     $self->apply_to_state([ mode => 'shell' ])
  27   });
  28   foreach my $pred (
  29     keys %{$self->shell_state->template_query_state->predicates}
  30   ) {
  31     $tcl->CreateCommand($pred => sub {
  32       my (undef, undef, undef, @args) = @_; # ($data, $interp, $pred)
  33       $self->apply_predicate($pred => @args);
  34     });
  35   }
  36   return $tcl;
  37 });
  38
  39 sub apply_to_state {
  40   my ($self, @to_apply) = @_;
  41   my $state = $self->shell_state;
  42   our @Result;
  43   foreach my $to_apply (@to_apply) {
  44     my ($change, @args) = @$to_apply;
  45     ($state, my @this_result) = $state->${\"with_${change}"}(@args);
  46     push @Result, @this_result;
  47   }
  48   $self->_set_shell_state($state);
  49   return;
  50 }
  51
  52 sub is_complete_command_string {
  53   my ($self, $string) = @_;
  54   return !!$self->tcl->icall(info => complete => $string);
  55 }
  56
  57 sub eval_command_string {
  58   my ($self, $string) = @_;
  59   local our @Result;
  60   try {
  61     $self->tcl->Eval($string);
  62   } catch {
  63     push @Result, [ output => $_ ];
  64   };
  65   return @Result;
  66 }
  67
  68 sub apply_predicate {
  69   my ($self, $pred, @args) = @_;
  70   die "Can't call predicate ${pred} outside a query\n"
  71     unless $self->shell_state->mode eq 'query';
  72 use Data::Dumper::Concise; die Dumper [ $pred, $self->expand_args(@args) ];
  73 }
  74
  75 1;