Commit | Line | Data |
afe61f9c |
1 | package Devel::REPL; |
2 | |
3 | use Term::ReadLine; |
4 | use Moose; |
48ddfeae |
5 | use namespace::clean -except => [ 'meta' ]; |
59aedffc |
6 | use 5.8.1; # might work with earlier perls but probably not |
7 | |
950232b2 |
8 | our $VERSION = '1.001000'; # 1.1.0 |
afe61f9c |
9 | |
10 | with 'MooseX::Object::Pluggable'; |
11 | |
12 | has 'term' => ( |
13 | is => 'rw', required => 1, |
14 | default => sub { Term::ReadLine->new('Perl REPL') } |
15 | ); |
16 | |
17 | has 'prompt' => ( |
18 | is => 'rw', required => 1, |
19 | default => sub { '$ ' } |
20 | ); |
21 | |
22 | has 'out_fh' => ( |
23 | is => 'rw', required => 1, lazy => 1, |
24 | default => sub { shift->term->OUT || \*STDOUT; } |
25 | ); |
26 | |
27 | sub run { |
28 | my ($self) = @_; |
29 | while ($self->run_once) { |
30 | # keep looping |
31 | } |
32 | } |
33 | |
34 | sub run_once { |
35 | my ($self) = @_; |
36 | my $line = $self->read; |
37 | return unless defined($line); # undefined value == EOF |
911a1c24 |
38 | my @ret = $self->eval($line); |
afe61f9c |
39 | $self->print(@ret); |
40 | return 1; |
41 | } |
42 | |
43 | sub read { |
44 | my ($self) = @_; |
45 | return $self->term->readline($self->prompt); |
46 | } |
47 | |
911a1c24 |
48 | sub eval { |
49 | my ($self, $line) = @_; |
50 | my ($to_exec, @rest) = $self->compile($line); |
51 | return @rest unless defined($to_exec); |
52 | my @ret = $self->execute($to_exec); |
53 | return @ret; |
54 | } |
55 | |
56 | sub compile { |
85cd2780 |
57 | my $_REPL = shift; |
58 | my $compiled = eval $_REPL->wrap_as_sub($_[0]); |
59 | return (undef, $_REPL->error_return("Compile error", $@)) if $@; |
911a1c24 |
60 | return $compiled; |
61 | } |
62 | |
63 | sub wrap_as_sub { |
64 | my ($self, $line) = @_; |
65 | return qq!sub {\n!.$self->mangle_line($line).qq!\n}\n!; |
66 | } |
67 | |
68 | sub mangle_line { |
69 | my ($self, $line) = @_; |
70 | return $line; |
71 | } |
72 | |
afe61f9c |
73 | sub execute { |
48ddfeae |
74 | my ($self, $to_exec, @args) = @_; |
75 | my @ret = eval { $to_exec->(@args) }; |
76 | return $self->error_return("Runtime error", $@) if $@; |
afe61f9c |
77 | return @ret; |
78 | } |
79 | |
911a1c24 |
80 | sub error_return { |
81 | my ($self, $type, $error) = @_; |
82 | return "${type}: ${error}"; |
83 | } |
84 | |
afe61f9c |
85 | sub print { |
86 | my ($self, @ret) = @_; |
87 | my $fh = $self->out_fh; |
59aedffc |
88 | no warnings 'uninitialized'; |
afe61f9c |
89 | print $fh "@ret"; |
90 | } |
91 | |
59aedffc |
92 | =head1 NAME |
93 | |
94 | Devel::REPL - a modern perl interactive shell |
95 | |
96 | =head1 SYNOPSIS |
97 | |
98 | my $repl = Devel::REPL->new; |
99 | $repl->load_plugin($_) for qw(History LexEnv); |
100 | $repl->run |
101 | |
102 | Alternatively, use the 're.pl' script installed with the distribution |
103 | |
950232b2 |
104 | system$ re.pl |
105 | |
59aedffc |
106 | =head1 AUTHOR |
107 | |
108 | Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>) |
109 | |
c1d5d500 |
110 | =head1 CONTRIBUTORS |
111 | |
112 | =over 4 |
113 | |
114 | =item Stevan Little - stevan (at) iinteractive.com |
115 | |
116 | =item Alexis Sukrieh - sukria+perl (at) sukria.net |
117 | |
118 | =item epitaph |
119 | |
120 | =item mgrimes - mgrimes (at) cpan dot org |
121 | |
122 | =item Shawn M Moore - sartak (at) gmail.com |
123 | |
124 | =back |
125 | |
59aedffc |
126 | =head1 LICENSE |
127 | |
128 | This library is free software under the same terms as perl itself |
129 | |
130 | =cut |
131 | |
afe61f9c |
132 | 1; |