Commit | Line | Data |
59aedffc |
1 | package Devel::REPL::Script; |
2 | |
77327851 |
3 | our $VERSION = '1.003030'; |
54beb05d |
4 | |
59aedffc |
5 | use Moose; |
6 | use Devel::REPL; |
59aedffc |
7 | use File::Spec; |
8456006f |
8 | use Module::Runtime 'use_module'; |
aa8b7647 |
9 | use namespace::autoclean; |
59aedffc |
10 | |
28e93f31 |
11 | our $CURRENT_SCRIPT; |
12 | |
59aedffc |
13 | with 'MooseX::Getopt'; |
14 | |
15 | has 'rcfile' => ( |
b595a818 |
16 | is => 'ro', isa => 'Str', |
17 | default => sub { 'repl.rc' }, |
59aedffc |
18 | ); |
19 | |
4d33251a |
20 | has 'profile' => ( |
cdbe3d31 |
21 | is => 'ro', |
22 | isa => 'Str', |
584978c9 |
23 | default => sub { $ENV{DEVEL_REPL_PROFILE} || 'Minimal' }, |
4d33251a |
24 | ); |
25 | |
59aedffc |
26 | has '_repl' => ( |
b595a818 |
27 | is => 'ro', isa => 'Devel::REPL', |
59aedffc |
28 | default => sub { Devel::REPL->new() } |
29 | ); |
30 | |
31 | sub BUILD { |
32 | my ($self) = @_; |
4d33251a |
33 | $self->load_profile($self->profile); |
34 | $self->load_rcfile($self->rcfile); |
59aedffc |
35 | } |
36 | |
4d33251a |
37 | sub load_profile { |
38 | my ($self, $profile) = @_; |
39 | $profile = "Devel::REPL::Profile::${profile}" unless $profile =~ /::/; |
8456006f |
40 | use_module $profile; |
3bcf4eb8 |
41 | confess "Profile class ${profile} doesn't do 'Devel::REPL::Profile'" |
42 | unless $profile->does('Devel::REPL::Profile'); |
4d33251a |
43 | $profile->new->apply_profile($self->_repl); |
44 | } |
59aedffc |
45 | |
4d33251a |
46 | sub load_rcfile { |
47 | my ($self, $rc_file) = @_; |
59aedffc |
48 | |
49 | # plain name => ~/.re.pl/${rc_file} |
50 | if ($rc_file !~ m!/!) { |
0b5d2430 |
51 | $rc_file = File::Spec->catfile(($^O eq 'MSWin32' && "$]" < 5.016 ? $ENV{HOME} || $ENV{USERPROFILE} : (<~>)[0]), '.re.pl', $rc_file); |
59aedffc |
52 | } |
53 | |
cb3b891f |
54 | $self->apply_script($rc_file); |
59aedffc |
55 | } |
56 | |
cb3b891f |
57 | sub apply_script { |
58 | my ($self, $script, $warn_on_unreadable) = @_; |
fa626608 |
59 | |
cb3b891f |
60 | if (!-e $script) { |
61 | warn "File '$script' does not exist" if $warn_on_unreadable; |
62 | return; |
fa626608 |
63 | } |
cb3b891f |
64 | elsif (!-r _) { |
65 | warn "File '$script' is unreadable" if $warn_on_unreadable; |
66 | return; |
67 | } |
68 | |
69 | open RCFILE, '<', $script or die "Couldn't open ${script}: $!"; |
70 | my $rc_data; |
71 | { local $/; $rc_data = <RCFILE>; } |
72 | close RCFILE; # Don't care if this fails |
73 | $self->eval_script($rc_data); |
74 | warn "Error executing script ${script}: $@\n" if $@; |
fa626608 |
75 | } |
76 | |
cb3b891f |
77 | sub eval_script { |
4d33251a |
78 | my ($self, $data) = @_; |
79 | local $CURRENT_SCRIPT = $self; |
80 | $self->_repl->eval($data); |
59aedffc |
81 | } |
82 | |
83 | sub run { |
84 | my ($self) = @_; |
85 | $self->_repl->run; |
86 | } |
87 | |
88 | sub import { |
89 | my ($class, @opts) = @_; |
90 | return unless (@opts == 1 && $opts[0] eq 'run'); |
91 | $class->new_with_options->run; |
92 | } |
93 | |
4d33251a |
94 | sub current { |
95 | confess "->current should only be called as class method" if ref($_[0]); |
96 | confess "No current instance (valid only during rc parse)" |
97 | unless $CURRENT_SCRIPT; |
98 | return $CURRENT_SCRIPT; |
99 | } |
100 | |
59aedffc |
101 | 1; |