blob: 3ba48243a867e6e07432d032a79f699fc1f46a7c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
package Example::Foobar;
=head1 NAME
Example::Foobar - an example of module loader
=head1 DESCRIPTION
This module provides an example implementation of arbitrary module
loader. Suppose you need to implement a command line utility that
takes as its arguments a subcommand name (think of git) and its
arguments. The subcommand should be implemented as an arbitrary
Perl module that is saved somewhere in the Perl path. When the
utility is called as, e.g.
foobar A one two three
the modue Example::Foobar::A will be loaded. It must implement
two methods: B<new> and B<run>. The constructor B<new> is called
with the classname and command line arguments as its parameters.
It is supposed to return an object of the class A prepared to do
its job. Once the object is returned, its B<run> method will be
called to do the right thing.
The actual implementation of the B<foobar> command is as simple as
use Example::Foobar;
Example::Foobar->new(@ARGV)->run;
See the B<Example/Foobar> directory for examples of working command
modules. Notice, that in real life each module would perhaps inherit
from some common parent module. Here, for the purpose of clarity, each
module is self-contained.
=cut
use strict;
use warnings;
use Carp;
our $VERSION = '1.00';
=head1 CONSTRUCTOR
=head2 new($class, ...)
A command object fabric. Looks for a perl module for B<$class>, loads
it and returns an instance of that class. Surplus arguments (B<...>)
are passed as parameters to the underlying class constructor.
=cut
sub new {
my ($class, $command, @args) = @_;
croak "command not supplied" unless $command;
my $modname = __PACKAGE__ . '::' . $command;
my $modpath = $modname;
$modpath =~ s{::}{/}g;
$modpath .= '.pm';
my $cmd;
eval {
require $modpath;
$cmd = $modname->new(@args);
};
if ($@) {
if ($@ =~ /Can't locate $modpath/) {
die "unknown command: $command\n"
}
croak $@;
}
return $cmd;
}
1;
|
