diff options
author | Sergey Poznyakoff <gray@gnu.org> | 2020-03-31 12:23:57 +0300 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org> | 2020-03-31 12:35:34 +0300 |
commit | ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2 (patch) | |
tree | 21859006c35f8e20732e36743972f6ddad372f57 /lib/Example | |
download | foobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.gz foobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.bz2 |
Initial commit
Diffstat (limited to 'lib/Example')
-rw-r--r-- | lib/Example/Foobar.pm | 74 | ||||
-rw-r--r-- | lib/Example/Foobar/args.pm | 43 | ||||
-rw-r--r-- | lib/Example/Foobar/limerick.pm | 36 | ||||
-rw-r--r-- | lib/Example/Foobar/list.pm | 87 | ||||
-rw-r--r-- | lib/Example/Foobar/proverb.pm | 44 |
5 files changed, 284 insertions, 0 deletions
diff --git a/lib/Example/Foobar.pm b/lib/Example/Foobar.pm new file mode 100644 index 0000000..3ba4824 --- /dev/null +++ b/lib/Example/Foobar.pm @@ -0,0 +1,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; diff --git a/lib/Example/Foobar/args.pm b/lib/Example/Foobar/args.pm new file mode 100644 index 0000000..8a0c765 --- /dev/null +++ b/lib/Example/Foobar/args.pm @@ -0,0 +1,43 @@ +package Example::Foobar::args; + +=head1 NAME + +args - prints its arguments + +=cut + +use strict; +use warnings; + +=head1 METHODS + +Each loadable module must provide at least two method: the +cosntructor B<new> and runtime method B<run>. + +=head2 new + +Creates an instance of the class and saves a reference to its +arguments for further use. + +=cut + +sub new { + my $class = shift; + bless { args => \@_ }, $class; +} + +=head2 run + +Displays the full package name and arguments it's been called with. + +=cut + +sub run { + my $self = shift; + print __PACKAGE__ . " called with arguments " + . join(',', @{$self->{args}}) . "\n"; +} + +1; + + diff --git a/lib/Example/Foobar/limerick.pm b/lib/Example/Foobar/limerick.pm new file mode 100644 index 0000000..790210c --- /dev/null +++ b/lib/Example/Foobar/limerick.pm @@ -0,0 +1,36 @@ +package Example::Foobar::limerick; + +=head1 NAME + +limerick - prints a limerick + +=cut + +use strict; +use warnings; + +=head1 DESCRIPTION + +There's hardly any need to comment. The code is pretty straightforward. +The constructor is trivial. The B<run> method prints a limerick of +questionable quality and returns. + +=cut + +sub new { + bless {}, shift +} + +sub run { + my $self = shift; + print <<EOT +There was a young man of high station +Who was found by a pious relation + Making love in a ditch + To -- I won't say a bitch -- +But a woman of no reputation. +EOT +; +} + +1; diff --git a/lib/Example/Foobar/list.pm b/lib/Example/Foobar/list.pm new file mode 100644 index 0000000..ebf2efc --- /dev/null +++ b/lib/Example/Foobar/list.pm @@ -0,0 +1,87 @@ +package Example::Foobar::list; + +=head1 NAME + +list - prints all available commands with short descriptions + +=cut + +use strict; +use warnings; +use Carp; +use File::Basename; +use File::Spec; +use Pod::Usage; + +=head1 METHODS + +=head2 new + +Creates new class and saves a "classpath" for further use. Classpath +is a list of class name components minus the last one. + +=cut + +sub new { + my $class = shift; + my @classpath = split(/::/, $class); + pop @classpath; + bless { classpath => \@classpath }, $class +} + +=head2 classpath + +Auxiliary method. Returns classpath as a list. + +=cut + +sub classpath { @{shift->{classpath}} } + +=head2 run + +Lists available commands on the stdout. For each command an attempt is +made to load it, to ensure the module is usable. If so, its description +is extracted from the NAME section of its pod. + +=cut + +sub run { + my $self = shift; + print "\nAvailable commands are:\n"; + + foreach my $mod (sort + map { + my $name = basename($_); + if (exists($INC{File::Spec->catfile($self->classpath, + $name)})) { + () + } else { + eval { + require $_; + }; + $name =~ s/\.pm$//; + $@ ? () : [$name, $_]; + } + } + map { + glob File::Spec->catfile($_, $self->classpath, + '*.pm') + } @INC) { + my $s; + open(my $fh, '>', \$s); + pod2usage(-input => $mod->[1], + -output => $fh, + -verbose => 99, + -sections => ['NAME'], + -exitstatus => 'NOEXIT'); + close $fh; + my (undef,$descr) = split("\n", $s||''); + unless ($descr) { + $descr = ' ' . $mod->[0] + } + print "$descr\n"; + } +} + +1; + diff --git a/lib/Example/Foobar/proverb.pm b/lib/Example/Foobar/proverb.pm new file mode 100644 index 0000000..8679f77 --- /dev/null +++ b/lib/Example/Foobar/proverb.pm @@ -0,0 +1,44 @@ +package Example::Foobar::proverb; +use strict; +use warnings; + +my @proverbs = ( + 'Scintillate, scintillate, asteroid minikin.', + 'Members of an avian species of identical plumage congregate.', + 'Surveillance should precede saltation.', + 'Pulchritude possesses solely cutaneous profundity.', + "It is fruitless to become lachrymose over precipitately departed\n" + ." lacteal fluid.", + 'Freedom from incrustations of grime is contiguous to rectitude.', + "It is fruitless to attempt to indoctrinate a superannuated\n" + ." canine with innovative maneuvers.", + 'Eschew the implement of correction and vitiate the scion.', + "The temperature of the aqueous content of an unremittingly\n" + ." galled saucepan does not reach 212 degrees Farenheit." +); + +sub new { + my $class = shift; + bless { selection => int(rand(@proverbs)) }, $class; +} + + +sub run { + my $self = shift; + print $proverbs[$self->{selection}],"\n"; +} + +1; +=head1 NAME + +proverb - prints a rephrased proverb + +=head1 SYNOPSIS + +B<foobar proverb> + +=head1 DESCRIPTION + +Displays an arbitrary proverb. + +=cut |