lib/DX/ShellState.pm

   1 package DX::ShellState;
   2
   3 use DX::Utils qw(deparse);
   4 use DX::Class;
   5
   6 has template_query_state => (
   7   is => 'ro', required => 1, isa => QueryState
   8 );
   9
  10 has current_query_state => (
  11   is => 'lazy', builder => 'new_query_state', isa => QueryState
  12 );
  13
  14 has trace_these => (
  15   is => 'ro', required => 1, isa => HashRef[Str],
  16 );
  17
  18 has mode => (is => 'ro', required => 1, isa => ShellMode);
  19
  20 sub new_query_state { $_[0]->template_query_state }
  21
  22 sub trace_sub {
  23   my ($self) = @_;
  24   sub {
  25     my ($tag, $thing) = @_;
  26     my ($part) = split /\./, $tag;
  27     my $traces = $self->trace_these;
  28     return unless $traces->{$part} or $traces->{'*'} or $ENV{DX_TRACE};
  29     my $dp = deparse($thing);
  30     $dp =~ s/\n$//;
  31     warn "${dp}\n";
  32   }
  33 }
  34
  35 sub with_trace_changes {
  36   my ($self, @changes) = @_;
  37   my %trace = %{$self->trace_these};
  38   foreach my $change (@changes) {
  39     if ($change =~ /^\+?(\S+)/) {
  40       $trace{$1} = 1;
  41     } elsif ($change =~ /^-(\S+)/) {
  42       delete $trace{$1};
  43     }
  44   }
  45   return $self->but(trace_these => \%trace);
  46 }
  47
  48 sub with_new_query_state {
  49   my ($self) = @_;
  50   $self->but(
  51     current_query_state => $self->new_query_state
  52   );
  53 }
  54
  55 sub with_mode {
  56   my ($self, $new_mode) = @_;
  57   return (
  58     $self->but(mode => $new_mode),
  59     [ mode => $new_mode ],
  60   );
  61 }
  62
  63 1;