Devel::REPL part 4 - script options, rc files and profiles

Ok, so this post is spectacularly late. Work's been busy, my business partner got married and I got to annoy all sorts of brilliant people at OSCON (my slides are up if you care). And I -did- actually write the code that this post depends on a while back, I just haven't written it up yet because I suck.

So, anyway. This is a continuation of the series of posts begun here, but this time rather than going on a mad dash to add more features we're going to step back and clean our usage up a bit so this feels like a real tool rather than a poor excuse for a series of blog-did I type that out loud? Shit. Er. SHINY OBJECT! DISTRACTION! DISTRACTION!

Ahem.

Now, so far I've been firing the repl up using

perl -Ilib -MDevel::REPL -e 'Devel::REPL->new->run;'

which works fine, but isn't exactly elegant for command line use. Worse still, if I want a plugin or two preloaded I have to do something like

perl -Ilib -MDevel::REPL -e 'my $repl = Devel::REPL->new; $repl->load_plugin("History"); $repl->run;'

which crosses the border out of 'not exactly elegant' and doesn't stop until it passes 'ugly'. Not good.

So, time to step back and figure out what I'm wanting to do. First thing, let's make the running syntax simpler -

perl -Ilib -MDevel::REPL::Script=run -e1;

That's easy enough to implement -

package Devel::REPL::Script;

use Moose;
use Devel::REPL;
use namespace::clean -except => [ qw(meta) ];

has '_repl' => (
  is => 'ro', isa => 'Devel::REPL', required => 1,
  default => sub { Devel::REPL->new() }
);

sub run {
  my ($self) = @_;
  $self->_repl->run;
}

sub import {
  my ($class, @opts) = @_;
  return unless (@opts == 1 && $opts[0] eq 'run');
  $class->new->run;
}

So, what's happening here is that

perl -MClassName=foo,bar,baz

is equivalent to

use ClassName qw(foo bar baz);

is equivalent to

require ClassName;
ClassName->import('foo', 'bar', 'baz');

and then the -e1 just gives perl a script fragment to run after the import returns, so your interpreter doesn't hang waiting for input. So, now I can create script/re.pl -

#!/usr/bin/env perl

use Devel::REPL::Script 'run';

The /usr/bin/env should ensure we pick up whatever perl's first in $PATH rather than it being set at install-time (since I often have several perls on a system and so do other developers and this is a developer tool). This, admittedly, doesn't work on win32. Patches welcome on that front.

But this still doesn't solve the second problem, loading plugins - it just makes getting as far as a prompt I can call $_REPL->load_plugin at quicker. So, to solve this I want two approaches - Profiles, which allow you to ship a canned collection of settings as a class, and a configurable rc file to add the personal touch to your repl environment.

First, the rcfile implementation. This is fairly simple -

sub load_rcfile {
  my ($self, $rc_file) = @_;

  # plain name => ~/.re.pl/${rc_file}
  if ($rc_file !~ m!/!) {
    $rc_file = File::Spec->catfile(File::HomeDir->my_home, '.re.pl', $rc_file);
  }

This way an rcfile of 'foo' becomes ~/.re.pl/foo but any other path like ./foo or /path/to/foo carries on untouched. File::Spec and File::HomeDir are used to try and maximise portability.

  if (-r $rc_file) {

-r is the same as the shell scripting -r test, it checks that not only the file exists but we're allowed to read it

    open RCFILE, '<', $rc_file || die "Couldn't open ${rc_file}: $!";
    my $rc_data;
    { local $/; $rc_data = <RCFILE>; }

$/ is perl's input separator; the 'local' means our changes will expire when the call stack's un-wound at the end of the block (we can't use lexical my() on perl internal variables), and not supplying a value means it becomes undef so the single <RCFILE> read operation slurps the entire file.

    close RCFILE; # Don't care if this fails
    $self->eval_rcdata($rc_data);
    warn "Error executing rc file ${rc_file}: $@\n" if $@;
  }
}

sub eval_rcdata {
  my ($self, $data) = @_;
  local $CURRENT_SCRIPT = $self;

This dynamically scopes $CURRENT_SCRIPT - here we use local rather than my because it's scoped to the call-stack, so any code we call from here on in will have this value unless there's an inner eval_rcdata call that makes another dynamic scoping level further down

  $self->_repl->eval($data);
}

sub current {
  confess "->current should only be called as class method" if ref($_[0]);
  confess "No current instance (valid only during rc parse)"
    unless $CURRENT_SCRIPT;
  return $CURRENT_SCRIPT;
}

and thanks to the local above, from within our rc file we can simply do

Devel::REPL::Script->current

to get at the currently executing script object.

So, for example, my RC file for a DBIx::Class project will usually live in /path/to/checkout/.re.pl/project.rc and contain -

Devel::REPL::Script->current->load_rcfile('repl.rc'); # load my global ~/.re.pl/repl.rc

use lib 'lib'; # to get at the lib/Project.pm, lib/Project/* perl modules
use Project::Schema; # load the DBIC schema
Project::Schema->connection('dbi:Pg:dbname=project_matthewt_test','matthewt',''); # connect to db
Project::Schema->stacktrace(1); # turn on stack traces for DBI errors

sub schema { 'Project::Schema' } # shortcut so things like schema->sources works
sub rs { Project::Schema->resultset(shift); } # shortcut so rs('Foo')->find(1); works
sub cols { Project::Schema->source(shift)->columns; } # cols('Foo') returns a column list

Now, I can happily put my load_plugin calls into my ~/.re.pl/repl.rc (I'll get to where that default turns up from later - patience, patience :) but I think pretty much -every- Devel::REPL user wants a similar base set of plugins, and there are likely common configurations for particular tasks (I'll probably parametrise and ship my DBIx::Class setup at some point for a start), so we need a way to ship a "profile". And since we happen to have CPAN handy, we might as well implement that as a perl module -

sub load_profile {
  my ($self, $profile) = @_;
  $profile = "Devel::REPL::Profile::${profile}" unless $profile =~ /::/;

This means a profile argument of 'Foo' will become 'Devel::REPL::Profile::Foo', but for e.g. a profile of 'DBIx::Class::Devel::REPL::Profile' would be left untouched. Class names can only get so long before we want to cry.

  Class::MOP::load_class($profile);

This will either load the class or throw an error - it's much like require but encapsulates the necessary faffing to go from class name to file to load safely and is already tested for us.

  confess "Profile class ${profile} doesn't do 'Devel::REPL::Profile'"
    unless $profile->does('Devel::REPL::Profile');

->does checks that the profile class has declared itself to consume the Devel::REPL::Profile role, which in this case is a pure interface role that just requires the class to have an apply_profile method

  $profile->new->apply_profile($self->_repl);

which we then call, and let the profile do whatever it wants to configure the repl object.

}

So, the ::Profile role is as simple as -

package Devel::REPL::Profile;

use Moose::Role;
use namespace::clean -except => [ 'meta' ];

requires 'apply_profile';

1;

and the 'Default' profile, aka "the stuff I'm fairly convinced everybody is going to want loaded", is just

package Devel::REPL::Profile::Default;

use Moose;
use namespace::clean -except => [ 'meta' ];

with 'Devel::REPL::Profile';

sub plugins {
  qw(History LexEnv DDS Packages Commands);
}

sub apply_profile {
  my ($self, $repl) = @_;
  $repl->load_plugin($_) for $self->plugins;
}

1;

There probably wasn't really much need to factor out the plugin list like that, but it'll make it easier for other people to subclass this one to have "these plugins plus a few more".

Now we've got the functionality together, the last thing is to make it so that we can specify the rc file and profile from the command line. So, a quick bit of code to make attributes and load them both on script init -

has 'rcfile' => (
  is => 'ro', isa => 'Str', required => 1, default => sub { 'repl.rc' },
);

has 'profile' => (
  is => 'ro', isa => 'Str', required => 1, default => sub { 'Default' },
);

sub BUILD {
  my ($self) = @_;
  $self->load_profile($self->profile);
  $self->load_rcfile($self->rcfile);
}

(and yes, that's where your default ~/.re.pl/repl.rc comes from :), and then we need to extend the run() method to parse options out of @ARGV, check for flags we understand and handles the values appropriately.

Right?

Nah. Far too much effort. Fortunately, MooseX::Getopt can save us the trouble. Just add

with 'MooseX::Getopt';

and change import to be

sub import {
  my ($class, @opts) = @_;
  return unless (@opts == 1 && $opts[0] eq 'run');
  $class->new_with_options->run;
}

and the new_with_options constructor introspects our attribute names, parses the command line args and does the right thing, so now

re.pl --rcfile ./.re.pl/projectname.rc

works as expected without any extra code required from us at all.

Now, this post is getting a bit long for its own good, so I'm going to punt the other things I was going to go over until I have time and brainpower to explore them properly, and instead I'm going to present you with a randomised perl hack to mull over in the meantime.

I keep find myself writing code that looks something like

$self->foo(
  $self->bar(
    $self->baz(
      $val
    )
  )
);

and it gets really boring after a while. So, integral@freenode#perl was talking about writing a method composition operator in perl6 and how you could syntaxify all this away. Me being me, I wondered if it was possible to produce something suitable in perl5. The answer is, indeed, yes -

sub pipeline;

sub pipeline {
  my @methods = @_;
  my $last = pop(@methods);
  if (@methods) {
    \sub {
      my ($obj, @args) = @_;
      $obj->${pipeline @methods}(
        $obj->$last(@args)
      );
    };
  } else {
    \sub {
      shift->$last(@_);
    };
  }
}

matthewt@cain ~/tmp $ re.pl --rcfile pipeline

$ { package Foo; # this was all one line but I'm being nice to your eyes :)
     sub foo { warn "foo"; -$_[1]; }
     sub bar { warn "bar"; $_[1]+2 }
     sub baz { warn "baz"; $[[1]+3 }
   }
$ my $foo = bless({}, 'Foo');                                                  
$Foo1 = Foo=HASH(0x8977a38);
$ $foo->${pipeline qw(foo bar baz)}(10);                                       
baz at (eval 78) line 6.
bar at (eval 78) line 6.
foo at (eval 78) line 6.
-15

Understanding the implementation of this one is left as an exercise for the reader. Feel free to have at it in the comments should you so desire.

mst out.

Addendum: aristotle proposes this alternative implementation -

sub pipeline {
	my $self;

	my $code = sub { @_ };

	for my $method ( reverse @_ ) {
		my $prev = $code;
		$code = sub { $self->$method( $prev->( @_ ) ) };
	}

	return \sub { $self = shift; $code->( @_ ) };
}

which he considers to be much clearer. I'm ambivalent, but the original appeals to the lisper in me; I guess his is maybe more idiomatic perl. Shrug.