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 | |
download | foobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.gz foobar-ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2.tar.bz2 |
Initial commit
-rw-r--r-- | .gitignore | 13 | ||||
-rw-r--r-- | LICENSE | 5 | ||||
-rw-r--r-- | MANIFEST.SKIP | 63 | ||||
-rw-r--r-- | Makefile.PL | 23 | ||||
-rw-r--r-- | README | 52 | ||||
-rw-r--r-- | debug.sh | 2 | ||||
-rwxr-xr-x | foobar | 8 | ||||
-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 |
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 @@ -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 + }, +); @@ -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 @@ -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 |