From ccd334f1fbdf0aefd7d53733e62fbc76a30feaf2 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Tue, 31 Mar 2020 12:23:57 +0300 Subject: Initial commit --- .gitignore | 13 +++++++ LICENSE | 5 +++ MANIFEST.SKIP | 63 ++++++++++++++++++++++++++++++ Makefile.PL | 23 +++++++++++ README | 52 +++++++++++++++++++++++++ debug.sh | 2 + foobar | 8 ++++ lib/Example/Foobar.pm | 74 +++++++++++++++++++++++++++++++++++ lib/Example/Foobar/args.pm | 43 +++++++++++++++++++++ lib/Example/Foobar/limerick.pm | 36 +++++++++++++++++ lib/Example/Foobar/list.pm | 87 ++++++++++++++++++++++++++++++++++++++++++ lib/Example/Foobar/proverb.pm | 44 +++++++++++++++++++++ 12 files changed, 450 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 MANIFEST.SKIP create mode 100644 Makefile.PL create mode 100644 README create mode 100644 debug.sh create mode 100755 foobar create mode 100644 lib/Example/Foobar.pm create mode 100644 lib/Example/Foobar/args.pm create mode 100644 lib/Example/Foobar/limerick.pm create mode 100644 lib/Example/Foobar/list.pm create mode 100644 lib/Example/Foobar/proverb.pm 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): + + 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 ', + 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 and B. The constructor B 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 method will be +called to do the right thing. + +The actual implementation of the B command is as simple as + + use Example::Foobar; + Example::Foobar->new(@ARGV)->run; + +See the B 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 and runtime method B. + +=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 method prints a limerick of +questionable quality and returns. + +=cut + +sub new { + bless {}, shift +} + +sub run { + my $self = shift; + print < \@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 + +=head1 DESCRIPTION + +Displays an arbitrary proverb. + +=cut -- cgit v1.2.1