Commit | Line | Data |
59aedffc |
1 | package Devel::REPL::Script; |
2 | |
e2d0b019 |
3 | use Moo; |
59aedffc |
4 | use Devel::REPL; |
5 | use File::HomeDir; |
6 | use File::Spec; |
4d33251a |
7 | use vars qw($CURRENT_SCRIPT); |
e2d0b019 |
8 | use namespace::sweep; |
9 | use Getopt::Long; |
10 | use MooX::Types::MooseLike::Base qw(Str InstanceOf); |
11 | use Module::Load (); |
12 | use Carp qw(confess); |
59aedffc |
13 | |
14 | has 'rcfile' => ( |
e2d0b019 |
15 | is => 'rw', |
16 | isa => Str, |
17 | required => 1, |
59aedffc |
18 | ); |
19 | |
4d33251a |
20 | has 'profile' => ( |
e2d0b019 |
21 | is => 'rw', |
22 | isa => Str, |
cdbe3d31 |
23 | required => 1, |
4d33251a |
24 | ); |
25 | |
59aedffc |
26 | has '_repl' => ( |
e2d0b019 |
27 | is => 'ro', isa => InstanceOf('Devel::REPL'), required => 1, |
59aedffc |
28 | default => sub { Devel::REPL->new() } |
29 | ); |
30 | |
e2d0b019 |
31 | sub new_with_options { |
32 | my ($class) = @_; |
33 | |
34 | my $rcfile = 'repl.rc'; |
35 | my $profile = $ENV{DEVEL_REPL_PROFILE} || 'Default'; |
36 | GetOptions( |
37 | 'rcfile=s' => \$rcfile, |
38 | 'profile=s' => \$profile, |
39 | ); |
40 | $class->new(profile => $profile, rcfile => $rcfile); |
41 | } |
42 | |
59aedffc |
43 | sub BUILD { |
44 | my ($self) = @_; |
4d33251a |
45 | $self->load_profile($self->profile); |
46 | $self->load_rcfile($self->rcfile); |
59aedffc |
47 | } |
48 | |
4d33251a |
49 | sub load_profile { |
50 | my ($self, $profile) = @_; |
51 | $profile = "Devel::REPL::Profile::${profile}" unless $profile =~ /::/; |
e2d0b019 |
52 | Module::Load::load($profile); |
3bcf4eb8 |
53 | confess "Profile class ${profile} doesn't do 'Devel::REPL::Profile'" |
54 | unless $profile->does('Devel::REPL::Profile'); |
4d33251a |
55 | $profile->new->apply_profile($self->_repl); |
56 | } |
59aedffc |
57 | |
4d33251a |
58 | sub load_rcfile { |
59 | my ($self, $rc_file) = @_; |
59aedffc |
60 | |
61 | # plain name => ~/.re.pl/${rc_file} |
62 | if ($rc_file !~ m!/!) { |
63 | $rc_file = File::Spec->catfile(File::HomeDir->my_home, '.re.pl', $rc_file); |
64 | } |
65 | |
cb3b891f |
66 | $self->apply_script($rc_file); |
59aedffc |
67 | } |
68 | |
cb3b891f |
69 | sub apply_script { |
70 | my ($self, $script, $warn_on_unreadable) = @_; |
fa626608 |
71 | |
cb3b891f |
72 | if (!-e $script) { |
73 | warn "File '$script' does not exist" if $warn_on_unreadable; |
74 | return; |
fa626608 |
75 | } |
cb3b891f |
76 | elsif (!-r _) { |
77 | warn "File '$script' is unreadable" if $warn_on_unreadable; |
78 | return; |
79 | } |
80 | |
81 | open RCFILE, '<', $script or die "Couldn't open ${script}: $!"; |
82 | my $rc_data; |
83 | { local $/; $rc_data = <RCFILE>; } |
84 | close RCFILE; # Don't care if this fails |
85 | $self->eval_script($rc_data); |
86 | warn "Error executing script ${script}: $@\n" if $@; |
fa626608 |
87 | } |
88 | |
cb3b891f |
89 | sub eval_script { |
4d33251a |
90 | my ($self, $data) = @_; |
91 | local $CURRENT_SCRIPT = $self; |
92 | $self->_repl->eval($data); |
59aedffc |
93 | } |
94 | |
95 | sub run { |
96 | my ($self) = @_; |
97 | $self->_repl->run; |
98 | } |
99 | |
100 | sub import { |
101 | my ($class, @opts) = @_; |
102 | return unless (@opts == 1 && $opts[0] eq 'run'); |
103 | $class->new_with_options->run; |
104 | } |
105 | |
4d33251a |
106 | sub current { |
107 | confess "->current should only be called as class method" if ref($_[0]); |
108 | confess "No current instance (valid only during rc parse)" |
109 | unless $CURRENT_SCRIPT; |
110 | return $CURRENT_SCRIPT; |
111 | } |
112 | |
59aedffc |
113 | 1; |