lib/Devel/REPL/Script.pm

   1 package Devel::REPL::Script;
   2
   3 our $VERSION = '1.003029';
   4
   5 use Moose;
   6 use Devel::REPL;
   7 use File::Spec;
   8 use Module::Runtime 'use_module';
   9 use namespace::autoclean;
  10
  11 our $CURRENT_SCRIPT;
  12
  13 with 'MooseX::Getopt';
  14
  15 has 'rcfile' => (
  16   is => 'ro', isa => 'Str',
  17   default => sub { 'repl.rc' },
  18 );
  19
  20 has 'profile' => (
  21   is       => 'ro',
  22   isa      => 'Str',
  23   default  => sub { $ENV{DEVEL_REPL_PROFILE} || 'Minimal' },
  24 );
  25
  26 has '_repl' => (
  27   is => 'ro', isa => 'Devel::REPL',
  28   default => sub { Devel::REPL->new() }
  29 );
  30
  31 sub BUILD {
  32   my ($self) = @_;
  33   $self->load_profile($self->profile);
  34   $self->load_rcfile($self->rcfile);
  35 }
  36
  37 sub load_profile {
  38   my ($self, $profile) = @_;
  39   $profile = "Devel::REPL::Profile::${profile}" unless $profile =~ /::/;
  40   use_module $profile;
  41   confess "Profile class ${profile} doesn't do 'Devel::REPL::Profile'"
  42     unless $profile->does('Devel::REPL::Profile');
  43   $profile->new->apply_profile($self->_repl);
  44 }
  45
  46 sub load_rcfile {
  47   my ($self, $rc_file) = @_;
  48
  49   # plain name => ~/.re.pl/${rc_file}
  50   if ($rc_file !~ m!/!) {
  51     $rc_file = File::Spec->catfile(($^O eq 'MSWin32' && "$]" < 5.016 ? $ENV{HOME} || $ENV{USERPROFILE} : (<~>)[0]), '.re.pl', $rc_file);
  52   }
  53
  54   $self->apply_script($rc_file);
  55 }
  56
  57 sub apply_script {
  58   my ($self, $script, $warn_on_unreadable) = @_;
  59
  60   if (!-e $script) {
  61     warn "File '$script' does not exist" if $warn_on_unreadable;
  62     return;
  63   }
  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 $@;
  75 }
  76
  77 sub eval_script {
  78   my ($self, $data) = @_;
  79   local $CURRENT_SCRIPT = $self;
  80   $self->_repl->eval($data);
  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
  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
 101 1;