The 2004 Perl Advent Calendar
[about] | [archives] | [contact] | [home]

On the 6th day of Advent my True Language brought to me..
Module::Pluggable

When we write some code to do something, we often find another use for the same code later on. We want the code to be extensible, changeable, and easily modifiable. To this end most software packages has the concept of plugins, hooks for extra code that can be installed to add functionality to an existing piece of software.

While plugin frameworks aren't hard to write, they are tedious and it's all too easy to use this as an excuse not to provide such a system - which is a real shame, as if there's anything we've learned from the Internet it's that people will take existing tools and do wonderful and totally unexpected things with them if given half the chance.

Removing this excuse is Module::Pluggable - a very simple, but very effective, framework for providing plugin support to your code which can be added with the minimum of fuss to your application.

I want to create a little language for drawing graphics. A simple script like this:

  # create the image
  create 400 300
  # draw a rectangle
  color white
  rect 10 10 380 280
  # save the image
  save test.png

The script consists of comments, blanks lines or lines with commands on them. The first word of a command line is the command and the following words after it are the arguments. We start writing our interpreter by giving it a constructor and a get/set method for the image and colour we're currently drawing in:

  package Image::MiniLib;
  # turn on perl's safety features
  use strict;
  use warnings;
  # create a few methods
  use base qw(Class::Accessor::Chained);
  __PACKAGE__->mk_accessors(qw( image color ));
  # and the accessor
  sub new
  {
    my $class = shift;
    my $self = bless {}, $class;
    $self->init;
    return $self;
  }
  # and a (for now) empty init routine
  sub init {}

We then write a couple of methods to parse a string containing the script and break it up into lines, and then break those lines up into words, and call the method for each command:

  sub parse_string
  {
     my $self   = shift;
     my $string = shift;
     # for each line of the script
     foreach my $line (split /\n/, $string)
     {
       # ignore whitespace and comments
       next if $line =~ /^\s*$/;
       next if $line =~ /^\s*#/;
       # process the line
       $self->process_args(split /\s+/, $line);
     }
  }
  sub process_args
  {
    my $self = shift;
    my $command = shift;
    # commands are implemented by methods named after
    # the commands prepended with 'command_'
    my $method = "command_$method";
    # do we have a method with the right name?
    unless ($self->can($method))
      { die "Don't understand command '$command'" }
    # run the method for that command
    $self->$method(@_);
  }

Finally we need to implement the commands themselves. We add a bunch of methods starting with command_ to indicate that they're commands we can run. The actual graphics work is done by the Imager module.

  # create <width> <height>
  sub command_create
  {
    my $self = shift;
    my $width = shift;
    my $height = shift;
    $self->image(Imager->new(xsize => $width, ysize => $height));
  }
  # save <filename>
  sub command_save
  {
    my $self = shift;
    my $filename = shift;
    $self->image->write(file => $filename)
      or die $self->image->errstr;
  }
  my $cols = {
    white => Imager::Color->new(255,255,255),
    red   => Imager::Color->new(255,0,0),
    green => Imager::Color->new(0,255,0),
    blue  => Imager::Color->new(0,0,255),
    black => Imager::Color->new(0,0,0),
  };
  # color <name>
  sub command_color
  {
    my $self = shift;
    my $col  = shift;
    die "Uknown color '$col'"
      unless $cols->{ $col };
    $self->color($cols->{ $col });
  }
  # rect <x> <y> <width> <height>
  sub command_rect
  {
    my $self = shift;
    my ($x, $y, $w, $h) = @_;
    $self->image->box(
      xmin  => $x,      ymin => $y,
      xmax  => $x + $w, ymax => $y + $h,
      color => $self->color,
    );
  }

And we're done. A simple perl program can be written to read the input from STDIN and pass it to the module

  #!/usr/bin/perl
  # turn on perl's safety features
  use strict;
  use warnings;
  # load the module, and pass STDIN to it
  use Image::MiniLib;
  Image::MiniLib->new->parse_string(join '', <>));

Extending the Scripting Language

Let's face it, the ability to just create images with boxes on it isn't that interesting. Let's write another module - a plugin - when loaded adds extra commands to the set. In this example we're going to implement a logo type command set, meaning we can move a cursor around by screen by rotating and moving forward and back.

  package Image::MiniLib::Plugin::Logo;
  use base qw(Class::Accessor::Chained);
  # turn on perl's safety features
  use strict;
  use warnings;
  # create some new accessor methods directly in the
  # Image::MiniLib namespace
  Image::MiniLib->mk_accessors(qw(logo_x logo_y logo_angle logo_pen_up));
  # and one for the angle that makes sure the angle wraps round
  # between 0 and 360 degrees
  sub Image::MiniLib::logo_angle
  {
    my $self = shift;
    return $self->{logo_angle} || 0 unless @_;
    # set the angle, making sure it's in bounds
    my $angle = shift;
    $angle += 360 while $angle < 0;
    $angle -= 360 while $angle > 360;
    $self->{logo_angle} = $angle;
  } 

Now we need to create a whole bunch of commands for moving the turtle:

  # rotate right: rt <angle>
  sub Image::MiniLib::command_rt
  {
    my $self = shift;
    $self->logo_angle($self->logo_angle(shift))
  }
  # rotate left: lt <angle>
  sub Image::MiniLib::command_lt
  {
    my $self = shift;
    $self->command_rt(- shift); # opposite of right
  }
  # turn off drawing: pu
  sub Image::MiniLib::command_pu
  {
    my $self = shift;
    $self->logo_pen_up(1);
  }
  # turn on drawing: pd
  sub Image::MiniLib::command_pd
  {
    my $self = shift;
    $self->logo_pen_up(0);
  }
  use constant PI => 3.141;
  # move the turtle forward
  # fd <pixels>
  sub Image::MiniLib::command_fd
  {
    my $self = shift;
    my $pixels = shift;
    print $self->logo_angle, "\n";
    # work out the new location
    my $new_x = $self->logo_x + $pixels * cos($self->logo_angle / 180 * PI );
    my $new_y = $self->logo_y + $pixels * sin($self->logo_angle / 180 * PI );
    # draw unless the pen's up
    unless ($self->logo_pen_up)
    {
      print "no $new_x $new_y\n";
      $self->image->line(
        color => $self->color,
        x1 => $self->logo_x, y1 => $self->logo_y,
        x2 => $new_x,        y2 => $new_y,
      );
    }
    # move the 'turtle' to the new location
    $self->logo_x($new_x);
    $self->logo_y($new_y);
  }
  # move the turtle backwards
  # bk <pixels>
  sub Image::MiniLib::command_bk
  {
    my $self = shift;
    $self->command_fd(- shift);  # opposite of forwards
  }

Finally we need to have some new init code to set the default values for the turtle location or angle.

  sub init
  {
    my $self = shift;
    $self->logo_x(0);
    $self->logo_y(0);
    $self->logo_angle(0);
  }

Right, now we need to plumb this in. The simplest thing to do would be to explicitly code a bunch of code in Image::MiniLib

  package Image::MiniLib;
  use strict;
  use warnings;
  # load the module
  use Image::MiniLib::Plugin::Logo;
  # and change init so that we 
  sub init
  {
    my $self = shift;
    $self->Image::MiniLib::Plugin::Logo::init(@_);
    return $self;
  }
  ...

Of course this is a bad idea. We'll have to do this alteration for each and every module that we write that adds a command. This means that if I release this to CPAN then someone wanting to add any module of extra commands will need me to make changes to my code before their extension would be generally useful. Not exactly quick and easy and will stifle development.

Instead what we need to do is take advantage of Module::Pluggable. Using Module::Pluggable in your code exports a method plugins in your code:

  package Foo;
  use Module::Pluggable;
  print join "\n",__PACKAGE__->plugins;

This prints a list of all modules that are installed on the system that are called Foo::Plugin::*. We can even tell Module::Pluggable to load all the modules by using the require flag;

  package Foo;
  use Module::Pluggable require => 1;
  __PACKAGE__->plugins;

So let's make the changes we need to make to our code. We want to load all our plugins automatically, and we want all the init methods for all the plugins to be called for each and every module we're creating:

   package Image::MiniLib;
   ...
   # load all the modules
   use Module::Pluggable require => 1;
   sub init
   {
     my $self = shift;
     # call all the inits (if defined) in all our 
     # plugins so they can all set up their defaults
     foreach my $plugin ($self->plugins)
     {
       my $init = $plugin . "::init";
      $self->$init if defined &$init;
     }
   }
   ...

And there we go. Now whenever someone installs a plugin it will automatically be used by the main Image::MiniLib code, and it's init method will be called for each new object.

  • Module::Pluggable::Ordered
  • Imager
  • Logo Foundation