aboutsummaryrefslogtreecommitdiff
path: root/lib/Example/Foobar/list.pm
blob: 1096c03acf58d65a68123ef3e7261973a883184e (plain)
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;

Return to:

Send suggestions and report system problems to the System administrator.