aboutsummaryrefslogtreecommitdiff
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
downloadfoobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.gz
foobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.bz2
Initial commit
-rw-r--r--.gitignore13
-rw-r--r--LICENSE5
-rw-r--r--MANIFEST.SKIP63
-rw-r--r--Makefile.PL23
-rw-r--r--README52
-rw-r--r--debug.sh2
-rwxr-xr-xfoobar8
-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
12 files changed, 450 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..62cfafe
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,13 @@
+*~
+\#*#
+.#*
+*.bak
+*.tar*
+.emacs.*
+/tmp/
+core
+/MANIFEST
+/MYMETA.*
+/Makefile
+/blib
+/pm_to_blib
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..1f4a7e0
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,5 @@
+"THE BEER-WARE LICENSE" (Revision 42):
+
+<gray@gnu.org> wrote this stuff. As long as you retain this notice you
+can do whatever you want with this stuff. If we meet some day, and you
+think this stuff is worth it, you can buy me a beer in return.
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..58696be
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,63 @@
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+\B\.cvsignore$
+
+# Avoid VMS specific MakeMaker generated files
+\bDescrip.MMS$
+\bDESCRIP.MMS$
+\bdescrip.mms$
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+\bBuild.bat$
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+\.tmp$
+\.#
+\.rej$
+
+# Avoid OS-specific files/dirs
+# Mac OSX metadata
+\B\.DS_Store
+# Mac OSX SMB mount metadata files
+\B\._
+
+# Avoid Devel::Cover and Devel::CoverX::Covered files.
+\bcover_db\b
+\bcovered\b
+
+# Avoid MYMETA files
+^MYMETA\.
+
+^debug.sh
+^tmp
+^buildreq
+^\.emacs\.*
+
+\.tar$
+\.tar\.gz$
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..94feff8
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,23 @@
+# -*- perl -*-
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Example::Foobar',
+ ABSTRACT_FROM => 'lib/Example/Foobar.pm',
+ VERSION_FROM => 'lib/Example/Foobar.pm',
+ AUTHOR => 'Sergey Poznyakoff <gray@gnu.org>',
+ LICENSE => 'unrestricted',
+ EXE_FILES => [ 'foobar' ],
+ MIN_PERL_VERSION => 5.014002,
+ PREREQ_PM => {
+ 'Getopt::Long' => 2.34,
+ 'File::Basename' => 0,
+ 'File::Spec' => 0,
+ 'File::Temp' => 0.23,
+ 'Pod::Find' => 0,
+ 'Pod::Man' => 0,
+ 'Pod::Usage' => 0
+ },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..8d7a452
--- /dev/null
+++ b/README
@@ -0,0 +1,52 @@
+* Overview
+
+This example package illustrate the implementation of dynamically
+loaded Perl modules. The word dynamically here means that the module
+name is not known beforehand to the main program. Instead, it is
+supplied by the user via command line or configuration file.
+
+For the clarity, this example implements a simple frontend program
+"foobar" that takes as its argument a command name and a list of
+arguments for that program. It looks for a Perl module for the
+given command in the Perl path, loads the module and calls its 'run'
+methods to perform the actual command.
+
+* Package contents
+
+ foobar
+ Command line utility to illustrate command loading
+ lib/Example/Foobar.pm
+ Command loader.
+ lib/Example/Foobar/*.pm
+ Example loadable commands.
+
+* Usage
+
+To simplify test usage, the debug.sh script is provided that allows
+you to try the package without installing. Run
+
+ . debug.sh
+
+Then try
+
+ foobar list
+
+This will show you the list of currently implemented commands. Run
+any of them and inspect their sources.
+
+Of course, the list command itself is also implemented as a loadable
+module (lib/Example/Foobar/list.pm).
+
+* Further reading
+
+ perldoc lib/Example/Foobar.pm et al.
+
+
+Local Variables:
+mode: outline
+paragraph-separate: "[ ]*$"
+version-control: never
+End:
+
+
+
diff --git a/debug.sh b/debug.sh
new file mode 100644
index 0000000..a528cdb
--- /dev/null
+++ b/debug.sh
@@ -0,0 +1,2 @@
+export PERL5LIB=`pwd`/lib
+export PERL5OPT=-MCarp=verbose
diff --git a/foobar b/foobar
new file mode 100755
index 0000000..7bc0a32
--- /dev/null
+++ b/foobar
@@ -0,0 +1,8 @@
+#!/bin/sh
+#! -*-perl-*-
+eval 'exec perl -x -S $0 ${1+"$@"}'
+ if 0;
+use strict;
+use warnings;
+use Example::Foobar;
+Example::Foobar->new(@ARGV)->run;
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.