1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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 object 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;
|