From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 12 Mar 2016 06:11:26 +0000 (+0000)
Subject: basic trace level control from the shell
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d294025edf555fdda7d3798159754d0cc4ee7feb;p=scpubgit%2FDX.git

basic trace level control from the shell
---

diff --git a/bin/dx b/bin/dx
index cd65e0a..8abbd9c 100644
--- a/bin/dx
+++ b/bin/dx
@@ -26,6 +26,7 @@ use_module('DX::ShellFrontend')->new(
         proposition_sequence
           => use_module('DX::PropositionSequence')->new_empty,
       ),
+      trace_these => {},
     ),
   ),
   (@ARGV
diff --git a/lib/DX/ShellSession.pm b/lib/DX/ShellSession.pm
index a24a106..fa6cb32 100644
--- a/lib/DX/ShellSession.pm
+++ b/lib/DX/ShellSession.pm
@@ -31,7 +31,7 @@ has tcl => (is => 'lazy', builder => sub {
   });
   $tcl->CreateCommand('...' => sub {
     $self->apply_to_state([ mode => 'shell' ]);
-    my ($cur) = $self->shell_state->current_query_state;
+    my $orig = my $cur = $self->shell_state->current_query_state;
     while ($cur) {
       $self->_set_shell_state(
         $self->shell_state->but(current_query_state => $cur)
@@ -40,6 +40,12 @@ has tcl => (is => 'lazy', builder => sub {
       $cur = eval { $cur->with_forced_backtrack };
       push our @Result, [ output => $@ ] if $@;
     }
+    $self->_set_shell_state(
+      $self->shell_state->but(
+        current_query_state => $orig
+      ),
+    );
+    return;
   });
   $tcl->CreateCommand(qlist => sub {
     push our @Result, map [ output => $_ ], @{
@@ -87,6 +93,12 @@ has tcl => (is => 'lazy', builder => sub {
       ),
     );
   });
+  $tcl->CreateCommand(trace => sub {
+    my (undef, undef, undef, @trace) = @_;
+    $self->_set_shell_state(
+      $self->shell_state->with_trace_changes(@trace)
+    );
+  });
   return $tcl;
 });
 
diff --git a/lib/DX/ShellState.pm b/lib/DX/ShellState.pm
index 884696a..118b7cf 100644
--- a/lib/DX/ShellState.pm
+++ b/lib/DX/ShellState.pm
@@ -11,19 +11,39 @@ has current_query_state => (
   is => 'lazy', builder => 'new_query_state'
 );
 
+has trace_these => (
+  is => 'ro', required => 1,
+);
+
 has mode => (is => 'ro', required => 1);
 
 sub new_query_state { $_[0]->template_query_state }
 
 sub trace_sub {
+  my ($self) = @_;
   sub {
     my ($tag, $thing) = @_;
+    my ($part) = split /\./, $tag;
+    return unless $self->trace_these->{$part};
     my $dp = deparse($thing);
     $dp =~ s/\n$//;
     warn "${tag}: ${dp}\n";
   }
 }
 
+sub with_trace_changes {
+  my ($self, @changes) = @_;
+  my %trace = %{$self->trace_these};
+  foreach my $change (@changes) {
+    if ($change =~ /^\+?(\w+)/) {
+      $trace{$1} = 1;
+    } elsif ($change =~ /^-(\w+)/) {
+      delete $trace{$1};
+    }
+  }
+  return $self->but(trace_these => \%trace);
+}
+
 sub with_new_query_state {
   my ($self) = @_;
   $self->but(