File Coverage

blib/lib/Goo/Thing/pm/Perl6ModuleInspector.pm
Criterion Covered Total %
statement 12 23 52.1
branch 0 2 0.0
condition n/a
subroutine 4 6 66.6
pod n/a
total 16 31 51.6


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Goo::Thing::pm::Perl6ModuleInspector;
4              
5             ###############################################################################
6             # Nigel Hamilton
7             #
8             # Copyright Nigel Hamilton 2003
9             # All rights reserved
10             #
11             # Author: Nigel Hamilton
12             # Filename: Perl6ModuleInspector.pm
13             # Description: Generate documentation on a perl file based on documentation
14             # standards like this file as an example
15             #
16             # Date Change
17             # ----------------------------------------------------------------------------
18             # 22/3/2003 Version 1
19             #
20             ##############################################################################
21              
22 1     1   5 use strict;
  1         2  
  1         24  
23 1     1   5 use Goo::Object;
  1         2  
  1         13  
24 1     1   5 use Goo::Prompter;
  1         2  
  1         14  
25 1     1   6 use Goo::FileUtilities;
  1         3  
  1         625  
26              
27             # use ModuleLocations;
28              
29             our @ISA = ("Goo::Object");
30              
31             # generate an inverted index of what programs use what
32             # our $usesindex = getUsesIndex
33              
34              
35             ##############################################################################
36             #
37             # new - constructor
38             #
39             ##############################################################################
40              
41             sub new {
42              
43 0     0     my ($class, $filename) = @_;
44              
45 0           my $this = $class->SUPER::new();
46              
47             # append filename to the end if need be
48             # if ($filename !~ /\.pm$/) { $filename .= ".pm"; }
49              
50 0 0         unless (-e $filename) { die("No file found to inspect: $filename"); }
  0            
51              
52 0           $this->{filename} = $filename; # the full filename + path
53 0           $this->{program} = Goo::FileUtilities::get_file_as_string($filename);
54              
55 0           return $this;
56              
57             }
58              
59              
60             ##############################################################################
61             #
62             # get_uses_list - return a list of all the modules that this script uses
63             #
64             ##############################################################################
65              
66             sub get_uses_list {
67              
68 0     0     my ($this) = @_;
69              
70 0           my @modules = $this->{program} =~ m/^use\s+([\w\:]+)/mg;
71              
72             # don't include strict or other pragmas
73 0           return grep { $_ !~ /(strict|^[a-z])/ } @modules;
  0            
74              
75             }
76              
77              
78             ##############################################################################
79             #
80             # get_signatures - return a list of all the modules that this script uses
81             #
82             ##############################################################################
83              
84             sub get_signatures {
85              
86             my ($this) = @_;
87              
88             my @signatures;
89              
90             foreach my $feature qw(submethod method sub) {
91              
92             # look for anything after sub, submethod or method
93             while ($this->{program} =~ m/$feature(.*?)\{/msg) {
94              
95             my $line = $1;
96              
97             # Goo::Prompter::trace("found --- $1");
98              
99             $line =~ s/\s+$//; # strip trailing whitespace
100             $line =~ s/^\s+//; # strip leading whitespace
101             $line =~ s/\{//; # remove any opening brace
102              
103             my $method = {};
104              
105             $method->{type} = $feature;
106              
107             if ($line =~ /(.*?)[\s\(]/) {
108             $method->{name} = $1;
109             }
110              
111             # match anything between two parentheses
112             if ($line =~ /\((.*?)\)/s) {
113             $method->{parameters} = $1;
114             }
115              
116             if ($line =~ /is\s+(.*)/) {
117             $method->{traits} = $1;
118              
119             # strip off the is
120             $line =~ s/is\s+.*//;
121             }
122              
123             # match returns
124             if ($line =~ /returns\s+(.*)/) {
125             $method->{returns} = $1;
126             }
127              
128             push(@signatures, $method);
129              
130             }
131              
132             }
133              
134             return @signatures;
135              
136             }
137              
138              
139             ##############################################################################
140             #
141             # get_author - return the name of the author
142             #
143             ##############################################################################
144              
145             sub get_author {
146              
147             my ($this) = @_;
148              
149             $this->{program} =~ m/Author:\s+(\w+)\s+(\w+)/;
150              
151             return $1 . " " . $2;
152              
153             }
154              
155              
156             1;
157              
158              
159             __END__
160              
161             =head1 NAME
162              
163             Goo::Thing::pm::Perl6ModuleInspector - Generate documentation on a perl file based on documentation
164              
165             =head1 SYNOPSIS
166              
167             use Goo::Thing::pm::Perl6ModuleInspector;
168              
169             =head1 DESCRIPTION
170              
171              
172              
173             =head1 METHODS
174              
175             =over
176              
177             =item new
178              
179             constructor
180              
181             =item get_uses_list
182              
183             return a list of all the modules that this script uses
184              
185             =item get_signatures
186              
187             return a list of the method/sub/submethod signatures
188              
189             =item get_author
190              
191             return the name of the author
192              
193             =back
194              
195             =head1 AUTHOR
196              
197             Nigel Hamilton <nigel@trexy.com>
198              
199             =head1 SEE ALSO