lib/Devel/REPL/Script.pm

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