lib/DX/ShellSession.pm

   1 package DX::ShellSession;
   2
   3 use Tcl;
   4 use Scalar::Util qw(weaken);
   5 use DX::Class;
   6
   7 has shell_state => (is => 'rwp', required => 1, isa => ShellState);
   8
   9 has tcl => (is => 'lazy', builder => sub {
  10   my ($self) = @_;
  11   weaken $self;
  12   my $tcl = Tcl->new;
  13   $tcl->CreateCommand('?' => sub {
  14     $self->apply_to_state([ 'new_query_state' ], [ mode => 'query' ])
  15   });
  16   $tcl->CreateCommand('?+' => sub {
  17     $self->apply_to_state([ mode => 'query' ])
  18   });
  19   $tcl->CreateCommand('.' => sub {
  20     $self->apply_to_state([ mode => 'shell' ])
  21   });
  22   return $tcl;
  23 });
  24
  25 sub apply_to_state {
  26   my ($self, @to_apply) = @_;
  27   my $state = $self->shell_state;
  28   our @Result;
  29   foreach my $to_apply (@to_apply) {
  30     my ($change, @args) = @$to_apply;
  31     ($state, my @this_result) = $state->${\"with_${change}"}(@args);
  32     push @Result, @this_result;
  33   }
  34   $self->_set_shell_state($state);
  35   return;
  36 }
  37
  38 sub is_complete_command_string {
  39   my ($self, $string) = @_;
  40   return !!$self->tcl->icall(info => complete => $string);
  41 }
  42
  43 sub eval_command_string {
  44   my ($self, $string) = @_;
  45   local our @Result;
  46   $self->tcl->Eval($string);
  47   return @Result;
  48 }
  49
  50 1;