Initial commit

4 files changed, 210 insertions, 0 deletions

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