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 | |
6edfdc07 |
8 | our $VERSION = '1.002001'; # 1.2.1 |
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); |
a66625d6 |
39 | eval { |
40 | $self->print(@ret); |
41 | }; |
42 | if ($@) { |
43 | my $error = $@; |
44 | eval { $self->print("Error printing! - $error\n"); }; |
45 | } |
afe61f9c |
46 | return 1; |
47 | } |
48 | |
49 | sub read { |
50 | my ($self) = @_; |
51 | return $self->term->readline($self->prompt); |
52 | } |
53 | |
911a1c24 |
54 | sub eval { |
55 | my ($self, $line) = @_; |
56 | my ($to_exec, @rest) = $self->compile($line); |
57 | return @rest unless defined($to_exec); |
58 | my @ret = $self->execute($to_exec); |
59 | return @ret; |
60 | } |
61 | |
62 | sub compile { |
85cd2780 |
63 | my $_REPL = shift; |
64 | my $compiled = eval $_REPL->wrap_as_sub($_[0]); |
65 | return (undef, $_REPL->error_return("Compile error", $@)) if $@; |
911a1c24 |
66 | return $compiled; |
67 | } |
68 | |
69 | sub wrap_as_sub { |
70 | my ($self, $line) = @_; |
71 | return qq!sub {\n!.$self->mangle_line($line).qq!\n}\n!; |
72 | } |
73 | |
74 | sub mangle_line { |
75 | my ($self, $line) = @_; |
76 | return $line; |
77 | } |
78 | |
afe61f9c |
79 | sub execute { |
48ddfeae |
80 | my ($self, $to_exec, @args) = @_; |
81 | my @ret = eval { $to_exec->(@args) }; |
82 | return $self->error_return("Runtime error", $@) if $@; |
afe61f9c |
83 | return @ret; |
84 | } |
85 | |
911a1c24 |
86 | sub error_return { |
87 | my ($self, $type, $error) = @_; |
88 | return "${type}: ${error}"; |
89 | } |
90 | |
afe61f9c |
91 | sub print { |
92 | my ($self, @ret) = @_; |
93 | my $fh = $self->out_fh; |
59aedffc |
94 | no warnings 'uninitialized'; |
afe61f9c |
95 | print $fh "@ret"; |
a66625d6 |
96 | print $fh "\n" if $self->term->ReadLine =~ /Gnu/; |
afe61f9c |
97 | } |
98 | |
59aedffc |
99 | =head1 NAME |
100 | |
101 | Devel::REPL - a modern perl interactive shell |
102 | |
103 | =head1 SYNOPSIS |
104 | |
105 | my $repl = Devel::REPL->new; |
106 | $repl->load_plugin($_) for qw(History LexEnv); |
107 | $repl->run |
108 | |
109 | Alternatively, use the 're.pl' script installed with the distribution |
110 | |
950232b2 |
111 | system$ re.pl |
112 | |
59aedffc |
113 | =head1 AUTHOR |
114 | |
115 | Matt S Trout - mst (at) shadowcatsystems.co.uk (L<http://www.shadowcatsystems.co.uk/>) |
116 | |
c1d5d500 |
117 | =head1 CONTRIBUTORS |
118 | |
119 | =over 4 |
120 | |
121 | =item Stevan Little - stevan (at) iinteractive.com |
122 | |
123 | =item Alexis Sukrieh - sukria+perl (at) sukria.net |
124 | |
125 | =item epitaph |
126 | |
127 | =item mgrimes - mgrimes (at) cpan dot org |
128 | |
129 | =item Shawn M Moore - sartak (at) gmail.com |
130 | |
131 | =back |
132 | |
59aedffc |
133 | =head1 LICENSE |
134 | |
135 | This library is free software under the same terms as perl itself |
136 | |
137 | =cut |
138 | |
afe61f9c |
139 | 1; |