Commit | Line | Data |
afe61f9c |
1 | package Devel::REPL; |
2 | |
3 | use Term::ReadLine; |
4 | use Moose; |
5 | use namespace::clean; |
6 | |
7 | with 'MooseX::Object::Pluggable'; |
8 | |
9 | has 'term' => ( |
10 | is => 'rw', required => 1, |
11 | default => sub { Term::ReadLine->new('Perl REPL') } |
12 | ); |
13 | |
14 | has 'prompt' => ( |
15 | is => 'rw', required => 1, |
16 | default => sub { '$ ' } |
17 | ); |
18 | |
19 | has 'out_fh' => ( |
20 | is => 'rw', required => 1, lazy => 1, |
21 | default => sub { shift->term->OUT || \*STDOUT; } |
22 | ); |
23 | |
24 | sub run { |
25 | my ($self) = @_; |
26 | while ($self->run_once) { |
27 | # keep looping |
28 | } |
29 | } |
30 | |
31 | sub run_once { |
32 | my ($self) = @_; |
33 | my $line = $self->read; |
34 | return unless defined($line); # undefined value == EOF |
911a1c24 |
35 | my @ret = $self->eval($line); |
afe61f9c |
36 | $self->print(@ret); |
37 | return 1; |
38 | } |
39 | |
40 | sub read { |
41 | my ($self) = @_; |
42 | return $self->term->readline($self->prompt); |
43 | } |
44 | |
911a1c24 |
45 | sub eval { |
46 | my ($self, $line) = @_; |
47 | my ($to_exec, @rest) = $self->compile($line); |
48 | return @rest unless defined($to_exec); |
49 | my @ret = $self->execute($to_exec); |
50 | return @ret; |
51 | } |
52 | |
53 | sub compile { |
54 | my ($self, $line) = @_; |
55 | my $compiled = eval $self->wrap_as_sub($line); |
56 | return (undef, $self->error_return("Compile error", $@)) if $@; |
57 | return $compiled; |
58 | } |
59 | |
60 | sub wrap_as_sub { |
61 | my ($self, $line) = @_; |
62 | return qq!sub {\n!.$self->mangle_line($line).qq!\n}\n!; |
63 | } |
64 | |
65 | sub mangle_line { |
66 | my ($self, $line) = @_; |
67 | return $line; |
68 | } |
69 | |
afe61f9c |
70 | sub execute { |
911a1c24 |
71 | my ($self, $to_exec, @args) = @_; |
72 | my @ret = eval { $to_exec->(@args) }; |
73 | return $self->error_return("Runtime error", $@) if $@; |
afe61f9c |
74 | return @ret; |
75 | } |
76 | |
911a1c24 |
77 | sub error_return { |
78 | my ($self, $type, $error) = @_; |
79 | return "${type}: ${error}"; |
80 | } |
81 | |
afe61f9c |
82 | sub print { |
83 | my ($self, @ret) = @_; |
84 | my $fh = $self->out_fh; |
85 | print $fh "@ret"; |
86 | } |
87 | |
88 | 1; |