File Coverage

blib/lib/Catmandu/Interactive.pm
Criterion Covered Total %
statement 68 77 88.3
branch 18 28 64.2
condition 3 5 60.0
subroutine 13 13 100.0
pod 1 7 14.2
total 103 130 79.2


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   671  
  1         2  
  1         7  
4             our $VERSION = '1.2019';
5              
6             use Catmandu;
7 1     1   376 use Moo;
  1         3  
  1         4  
8 1     1   200 use namespace::clean;
  1         2  
  1         6  
9 1     1   301  
  1         2  
  1         5  
10             has in => (
11             is => 'ro',
12             default => sub {
13             Catmandu::Util::io(\*STDIN);
14             }
15             );
16              
17             has out => (
18             is => 'ro',
19             default => sub {
20             Catmandu::Util::io(
21             \*STDOUT,
22             mode => 'w',
23             binmode => ':encoding(utf-8)'
24             );
25             }
26             );
27              
28             has silent => (is => 'ro');
29              
30             has exporter => (is => 'ro', default => sub {'YAML'});
31              
32             has exporter_args => (is => 'ro', default => sub {+{}});
33              
34             has header => (
35             is => 'ro',
36             default => sub {
37             "\e[36m\n"
38             . " A_A ____ _ _ \n"
39             . " (-.-) / ___|__ _| |_ _ __ ___ __ _ _ __ __| |_ _ \n"
40             . " |-| | | / _` | __| '_ ` _ \\ / _` | '_ \\ / _` | | | | \n"
41             . " / \\ | |__| (_| | |_| | | | | | (_| | | | | (_| | |_| | \n"
42             . " | | \\____\\__,_|\\__|_| |_| |_|\\__,_|_| |_|\\__,_|\\__,_|\n"
43             . " | || | | \\___ version: $Catmandu::VERSION \n"
44             . " \\_||_/_/ \e[0m\n"
45             . " \n"
46             . "Commands: | Interactive support is still \n"
47             . " \\h - the fix history | experimental. Run: \n"
48             . " \\r - repeat the previous fix | \$ catmandu run <your_fix_script> \n"
49             . " \\q - quit | to access all Catmandu features \n";
50             }
51             );
52              
53             has data => (is => 'rw', default => sub {+{}});
54              
55             has _history => (is => 'ro', default => sub {[]});
56              
57             my $self = shift;
58              
59 5     5 1 44 my $keep_reading = 0;
60             my $buffer = '';
61 5         7  
62 5         8 $self->head;
63              
64 5         13 $self->prompt;
65              
66 5         11 while (my $line = $self->in->getline) {
67             if ($line =~ /^\\(.*)/) {
68 5         17 next if length $buffer;
69 10 100       225  
70 3 50       10 my ($command, $args) = split(/\s+/, $1, 2);
71              
72 3         13 if ($command eq 'h') {
73             $self->cmd_history;
74 3 100       12 $self->prompt('fix');
    100          
    50          
75 1         5 next;
76 1         22 }
77 1         3 elsif ($command eq 'r') {
78             if (@{$self->_history} > 0) {
79             $line = $self->_history->[-1];
80 1 50       3 }
  1         31  
81 1         7 else {
82             $self->prompt('fix');
83             next;
84 0         0 }
85 0         0 }
86             elsif ($command eq 'q') {
87             last;
88             }
89 1         4 else {
90             $self->error("unknown command $command");
91             $self->prompt('fix');
92 0         0 next;
93 0         0 }
94 0         0 }
95              
96             $line = "$buffer$line" if length $buffer;
97              
98 8 50       20 if (length $line) {
99             my ($fixes, $keep_reading, $error)
100 8 50       18 = $self->parse_fixes($line, $keep_reading);
101 8         19  
102             if ($error) {
103             $buffer = '';
104 8 100       25 }
    50          
105 2         4 elsif ($keep_reading == 0) {
106             my $fixer = Catmandu::Fix->new(fixes => $fixes);
107              
108 6         100 $self->data($fixer->fix($self->data));
109             $self->export;
110 6         1498  
111 6         17 push(@{$self->_history}, $line);
112              
113 6         8 $buffer = '';
  6         17  
114             }
115 6         217 else {
116             $buffer = $line;
117             $self->prompt('...');
118 0         0 next;
119 0         0 }
120 0         0 }
121              
122             $self->prompt('fix');
123             }
124 8         31 }
125              
126             my ($self) = @_;
127              
128             $self->out->printf(join("", @{$self->_history}));
129 1     1 0 2 }
130              
131 1         3 my ($self) = @_;
  1         14  
132              
133             $self->out->printf("%s\n", $self->header) unless $self->silent;
134             }
135 5     5 0 10  
136             my ($self, $txt) = @_;
137 5 50       20 $self->out->print("ERROR: $txt\n") unless $self->silent;
138             }
139              
140             my ($self, $txt) = @_;
141 2     2 0 5 $txt //= 'fix';
142 2 50       8  
143             $self->out->printf("\e[35m%s > \e[0m", $txt) unless $self->silent;
144             }
145              
146 14     14 0 28 my ($self) = @_;
147 14   100     38 my $exporter = Catmandu->exporter(
148             $self->exporter,
149 14 50       55 %{$self->exporter_args},
150             fh => $self->out
151             );
152             $exporter->add($self->data);
153 6     6 0 11 $exporter->commit;
154             }
155              
156 6         13 my ($self, $string, $keep_reading) = @_;
  6         41  
157              
158             my $parser = Catmandu::Fix::Parser->new;
159 6         104  
160 6         140 my $fixes;
161             my $error = 0;
162              
163             try {
164 8     8 0 16 $fixes = $parser->parse($string);
165             $keep_reading = 0;
166 8         143 }
167             catch {
168 8         353 if (ref($_) eq 'Catmandu::FixParseError'
169 8         14 && $_->message
170             =~ /Can't use an undefined value as a SCALAR reference at/)
171             {
172 8     8   542 $keep_reading = 1;
173 6         72 }
174             else {
175             $_ =~ s/\n.*//g;
176 2 50 33 2   54 $self->error($_);
177             $error = 1;
178             }
179             };
180 0         0  
181             return ($fixes, $keep_reading, $error);
182             }
183 2         9  
184 2         10 1;
185 2         6  
186              
187 8         52 =pod
188              
189 8         131 =head1 NAME
190              
191             Catmandu::Interactive - An interactive command line interpreter of the Fix language
192              
193             =head1 SYNOPSIS
194              
195             # On the command line
196             catmandu run
197              
198             # Or, in Perl
199             use Catmandu::Interactive;
200             use Getopt::Long;
201              
202             my $exporter = 'YAML';
203              
204             GetOptions("exporter=s" => \$exporter);
205              
206             my $app = Catmandu::Interactive->new(exporter => $exporter);
207              
208             $app->run();
209              
210             =head1 DESCRIPTION
211              
212             This module provide a simple interactive interface to the Catmandu Fix language.
213              
214             =head1 CONFIGURATION
215              
216             =over
217              
218             =item in
219              
220             Read input from an IO::Handle
221              
222             =item out
223              
224             Write output to an IO::Handle
225              
226             =item silent
227              
228             If set true, then no headers or prompts are printed
229              
230             =item data
231              
232             A hash containing the input record
233              
234             =item exporter
235              
236             The name of an exporter package
237              
238             =item exporter_args
239              
240             The options for the exporter
241              
242             =back
243              
244             =head1 METHODS
245              
246             =head2 run
247              
248             Run the interactive environment.
249              
250             =head1 SEE ALSO
251              
252             L<Catmandu>
253              
254             =cut