format aperture in backtrack trace
[scpubgit/DX.git] / 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;