Commit | Line | Data |
59aedffc |
1 | package Devel::REPL::Script; |
2 | |
3 | use Moose; |
4 | use Devel::REPL; |
5 | use File::HomeDir; |
6 | use File::Spec; |
4d33251a |
7 | use vars qw($CURRENT_SCRIPT); |
59aedffc |
8 | use namespace::clean -except => [ qw(meta) ]; |
9 | |
10 | with 'MooseX::Getopt'; |
11 | |
12 | has 'rcfile' => ( |
13 | is => 'ro', isa => 'Str', required => 1, default => sub { 'repl.rc' }, |
14 | ); |
15 | |
4d33251a |
16 | has 'profile' => ( |
17 | is => 'ro', isa => 'Str', required => 1, default => sub { 'Default' }, |
18 | ); |
19 | |
59aedffc |
20 | has '_repl' => ( |
21 | is => 'ro', isa => 'Devel::REPL', required => 1, |
22 | default => sub { Devel::REPL->new() } |
23 | ); |
24 | |
25 | sub BUILD { |
26 | my ($self) = @_; |
4d33251a |
27 | $self->load_profile($self->profile); |
28 | $self->load_rcfile($self->rcfile); |
59aedffc |
29 | } |
30 | |
4d33251a |
31 | sub load_profile { |
32 | my ($self, $profile) = @_; |
33 | $profile = "Devel::REPL::Profile::${profile}" unless $profile =~ /::/; |
34 | Class::MOP::load_class($profile); |
35 | $profile->new->apply_profile($self->_repl); |
36 | } |
59aedffc |
37 | |
4d33251a |
38 | sub load_rcfile { |
39 | my ($self, $rc_file) = @_; |
59aedffc |
40 | |
41 | # plain name => ~/.re.pl/${rc_file} |
42 | if ($rc_file !~ m!/!) { |
43 | $rc_file = File::Spec->catfile(File::HomeDir->my_home, '.re.pl', $rc_file); |
44 | } |
45 | |
46 | if (-r $rc_file) { |
47 | open RCFILE, '<', $rc_file || die "Couldn't open ${rc_file}: $!"; |
48 | my $rc_data; |
49 | { local $/; $rc_data = <RCFILE>; } |
50 | close RCFILE; # Don't care if this fails |
51 | $self->eval_rcdata($rc_data); |
52 | warn "Error executing rc file ${rc_file}: $@\n" if $@; |
53 | } |
54 | } |
55 | |
56 | sub eval_rcdata { |
4d33251a |
57 | my ($self, $data) = @_; |
58 | local $CURRENT_SCRIPT = $self; |
59 | $self->_repl->eval($data); |
59aedffc |
60 | } |
61 | |
62 | sub run { |
63 | my ($self) = @_; |
64 | $self->_repl->run; |
65 | } |
66 | |
67 | sub import { |
68 | my ($class, @opts) = @_; |
69 | return unless (@opts == 1 && $opts[0] eq 'run'); |
70 | $class->new_with_options->run; |
71 | } |
72 | |
4d33251a |
73 | sub current { |
74 | confess "->current should only be called as class method" if ref($_[0]); |
75 | confess "No current instance (valid only during rc parse)" |
76 | unless $CURRENT_SCRIPT; |
77 | return $CURRENT_SCRIPT; |
78 | } |
79 | |
59aedffc |
80 | 1; |