aboutsummaryrefslogtreecommitdiff
path: root/lib/Example
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org>2020-03-31 12:23:57 +0300
committerSergey Poznyakoff <gray@gnu.org>2020-03-31 12:35:34 +0300
commitccd334f1fbdf0aefd7d53733e62fbc76a30feaf2 (patch)
tree21859006c35f8e20732e36743972f6ddad372f57 /lib/Example
downloadfoobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.gz
foobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.bz2
Initial commit
Diffstat (limited to 'lib/Example')
-rw-r--r--lib/Example/Foobar.pm74
-rw-r--r--lib/Example/Foobar/args.pm43
-rw-r--r--lib/Example/Foobar/limerick.pm36
-rw-r--r--lib/Example/Foobar/list.pm87
-rw-r--r--lib/Example/Foobar/proverb.pm44
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

Return to:

Send suggestions and report system problems to the System administrator.