|
7
|
1 #!/usr/bin/env perl
|
|
|
2
|
|
|
3 # pltags - create a tags file for Perl code, for use by vi(m)
|
|
|
4 #
|
|
|
5 # Distributed with Vim <http://www.vim.org/>, latest version always available
|
|
|
6 # at <http://www.mscha.com/mscha.html?pltags#tools>
|
|
|
7 #
|
|
|
8 # Version 2.3, 28 February 2002
|
|
|
9 #
|
|
|
10 # Written by Michael Schaap <pltags@mscha.com>. Suggestions for improvement
|
|
|
11 # are very welcome!
|
|
|
12 #
|
|
|
13 # This script will not work with Perl 4 or below!
|
|
|
14 #
|
|
|
15 # Revision history:
|
|
|
16 # 1.0 1997? Original version, quickly hacked together
|
|
|
17 # 2.0 1999? Completely rewritten, better structured and documented,
|
|
|
18 # support for variables, packages, Exuberant Ctags extensions
|
|
|
19 # 2.1 Jun 2000 Fixed critical bug (typo in comment) ;-)
|
|
|
20 # Support multiple level packages (e.g. Archive::Zip::Member)
|
|
|
21 # 2.2 Jul 2001 'Glob' wildcards - especially useful under Windows
|
|
|
22 # (thanks to Serge Sivkov and Jason King)
|
|
|
23 # Bug fix: reset package name for each file
|
|
|
24 # 2.21 Jul 2001 Oops... bug in variable detection (/local../ -> /^local.../)
|
|
|
25 # 2.3 Feb 2002 Support variables declared with "our"
|
|
|
26 # (thanks to Lutz Mende)
|
|
|
27
|
|
|
28 # Complain about undeclared variables
|
|
|
29 use strict;
|
|
|
30
|
|
|
31 # Used modules
|
|
|
32 use Getopt::Long;
|
|
|
33
|
|
|
34 # Options with their defaults
|
|
|
35 my $do_subs = 1; # --subs, --nosubs include subs in tags file?
|
|
|
36 my $do_vars = 1; # --vars, --novars include variables in tags file?
|
|
|
37 my $do_pkgs = 1; # --pkgs, --nopkgs include packages in tags file?
|
|
|
38 my $do_exts = 1; # --extensions, --noextensions
|
|
|
39 # include Exuberant Ctags extensions
|
|
|
40
|
|
|
41 # Global variables
|
|
|
42 my $VERSION = "2.21"; # pltags version
|
|
|
43 my $status = 0; # GetOptions return value
|
|
|
44 my $file = ""; # File being processed
|
|
|
45 my @tags = (); # List of produced tags
|
|
|
46 my $is_pkg = 0; # Are we tagging a package?
|
|
|
47 my $has_subs = 0; # Has this file any subs yet?
|
|
|
48 my $package_name = ""; # Name of current package
|
|
|
49 my $var_continues = 0; # Variable declaration continues on last line
|
|
|
50 my $line = ""; # Current line in file
|
|
|
51 my $stmt = ""; # Current Perl statement
|
|
|
52 my @vars = (); # List of variables in declaration
|
|
|
53 my $var = ""; # Variable in declaration
|
|
|
54 my $tagline = ""; # Tag file line
|
|
|
55
|
|
|
56 # Create a tag file line and push it on the list of found tags
|
|
|
57 sub MakeTag($$$$$)
|
|
|
58 {
|
|
|
59 my ($tag, # Tag name
|
|
|
60 $type, # Type of tag
|
|
|
61 $is_static, # Is this a static tag?
|
|
|
62 $file, # File in which tag appears
|
|
|
63 $line) = @_; # Line in which tag appears
|
|
|
64
|
|
|
65 my $tagline = ""; # Created tag line
|
|
|
66
|
|
|
67 # Only process tag if not empty
|
|
|
68 if ($tag)
|
|
|
69 {
|
|
|
70 # Get rid of \n, and escape / and \ in line
|
|
|
71 chomp $line;
|
|
|
72 $line =~ s/\\/\\\\/g;
|
|
|
73 $line =~ s/\//\\\//g;
|
|
|
74
|
|
|
75 # Create a tag line
|
|
|
76 $tagline = "$tag\t$file\t/^$line\$/";
|
|
|
77
|
|
|
78 # If we're told to do so, add extensions
|
|
|
79 if ($do_exts)
|
|
|
80 {
|
|
|
81 $tagline .= ";\"\t$type"
|
|
|
82 . ($is_static ? "\tfile:" : "")
|
|
|
83 . ($package_name ? "\tclass:$package_name" : "");
|
|
|
84 }
|
|
|
85
|
|
|
86 # Push it on the stack
|
|
|
87 push (@tags, $tagline);
|
|
|
88 }
|
|
|
89 }
|
|
|
90
|
|
|
91 # Parse package name from statement
|
|
|
92 sub PackageName($)
|
|
|
93 {
|
|
|
94 my ($stmt) = @_; # Statement
|
|
|
95
|
|
|
96 # Look for the argument to "package". Return it if found, else return ""
|
|
|
97 if ($stmt =~ /^package\s+([\w:]+)/)
|
|
|
98 {
|
|
|
99 my $pkgname = $1;
|
|
|
100
|
|
|
101 # Remove any parent package name(s)
|
|
|
102 $pkgname =~ s/.*://;
|
|
|
103 return $pkgname;
|
|
|
104 }
|
|
|
105 else
|
|
|
106 {
|
|
|
107 return "";
|
|
|
108 }
|
|
|
109 }
|
|
|
110
|
|
|
111 # Parse sub name from statement
|
|
|
112 sub SubName($)
|
|
|
113 {
|
|
|
114 my ($stmt) = @_; # Statement
|
|
|
115
|
|
|
116 # Look for the argument to "sub". Return it if found, else return ""
|
|
|
117 if ($stmt =~ /^sub\s+([\w:]+)/)
|
|
|
118 {
|
|
|
119 my $subname = $1;
|
|
|
120
|
|
|
121 # Remove any parent package name(s)
|
|
|
122 $subname =~ s/.*://;
|
|
|
123 return $subname;
|
|
|
124 }
|
|
|
125 else
|
|
|
126 {
|
|
|
127 return "";
|
|
|
128 }
|
|
|
129 }
|
|
|
130
|
|
|
131 # Parse all variable names from statement
|
|
|
132 sub VarNames($)
|
|
|
133 {
|
|
|
134 my ($stmt) = @_;
|
|
|
135
|
|
|
136 # Remove my or local from statement, if present
|
|
|
137 $stmt =~ s/^(my|our|local)\s+//;
|
|
|
138
|
|
|
139 # Remove any assignment piece
|
|
|
140 $stmt =~ s/\s*=.*//;
|
|
|
141
|
|
|
142 # Now find all variable names, i.e. "words" preceded by $, @ or %
|
|
|
143 @vars = ($stmt =~ /[\$\@\%]([\w:]+)\b/g);
|
|
|
144
|
|
|
145 # Remove any parent package name(s)
|
|
|
146 map(s/.*://, @vars);
|
|
|
147
|
|
|
148 return (@vars);
|
|
|
149 }
|
|
|
150
|
|
|
151 ############### Start ###############
|
|
|
152
|
|
|
153 print "\npltags $VERSION by Michael Schaap <mscha\@mscha.com>\n\n";
|
|
|
154
|
|
|
155 # Get options
|
|
|
156 $status = GetOptions("subs!" => \$do_subs,
|
|
|
157 "vars!" => \$do_vars,
|
|
|
158 "pkgs!" => \$do_pkgs,
|
|
|
159 "extensions!" => \$do_exts);
|
|
|
160
|
|
|
161 # Usage if error in options or no arguments given
|
|
|
162 unless ($status && @ARGV)
|
|
|
163 {
|
|
|
164 print "\n" unless ($status);
|
|
|
165 print " Usage: $0 [options] filename ...\n\n";
|
|
|
166 print " Where options can be:\n";
|
|
|
167 print " --subs (--nosubs) (don't) include sub declarations in tag file\n";
|
|
|
168 print " --vars (--novars) (don't) include variable declarations in tag file\n";
|
|
|
169 print " --pkgs (--nopkgs) (don't) include package declarations in tag file\n";
|
|
|
170 print " --extensions (--noextensions)\n";
|
|
|
171 print " (don't) include Exuberant Ctags / Vim style\n";
|
|
|
172 print " extensions in tag file\n\n";
|
|
|
173 print " Default options: ";
|
|
|
174 print ($do_subs ? "--subs " : "--nosubs ");
|
|
|
175 print ($do_vars ? "--vars " : "--novars ");
|
|
|
176 print ($do_pkgs ? "--pkgs " : "--nopkgs ");
|
|
|
177 print ($do_exts ? "--extensions\n\n" : "--noextensions\n\n");
|
|
|
178 print " Example: $0 *.pl *.pm ../shared/*.pm\n\n";
|
|
|
179 exit;
|
|
|
180 }
|
|
|
181
|
|
|
182 # Loop through files on command line - 'glob' any wildcards, since Windows
|
|
|
183 # doesn't do this for us
|
|
|
184 foreach $file (map { glob } @ARGV)
|
|
|
185 {
|
|
|
186 # Skip if this is not a file we can open. Also skip tags files and backup
|
|
|
187 # files
|
|
|
188 next unless ((-f $file) && (-r $file) && ($file !~ /tags$/)
|
|
|
189 && ($file !~ /~$/));
|
|
|
190
|
|
|
191 print "Tagging file $file...\n";
|
|
|
192
|
|
|
193 $is_pkg = 0;
|
|
|
194 $package_name = "";
|
|
|
195 $has_subs = 0;
|
|
|
196 $var_continues = 0;
|
|
|
197
|
|
|
198 open (IN, $file) or die "Can't open file '$file': $!";
|
|
|
199
|
|
|
200 # Loop through file
|
|
|
201 foreach $line (<IN>)
|
|
|
202 {
|
|
|
203 # Statement is line with comments and whitespace trimmed
|
|
|
204 ($stmt = $line) =~ s/#.*//;
|
|
|
205 $stmt =~ s/^\s*//;
|
|
|
206 $stmt =~ s/\s*$//;
|
|
|
207
|
|
|
208 # Nothing left? Never mind.
|
|
|
209 next unless ($stmt);
|
|
|
210
|
|
|
211 # This is a variable declaration if one was started on the previous
|
|
|
212 # line, or if this line starts with my or local
|
|
|
213 if ($var_continues or ($stmt =~/^my\b/)
|
|
|
214 or ($stmt =~/^our\b/) or ($stmt =~/^local\b/))
|
|
|
215 {
|
|
|
216 # The declaration continues if the line does not end with ;
|
|
|
217 $var_continues = ($stmt !~ /;$/);
|
|
|
218
|
|
|
219 # Loop through all variable names in the declaration
|
|
|
220 foreach $var (VarNames($stmt))
|
|
|
221 {
|
|
|
222 # Make a tag for this variable unless we're told not to. We
|
|
|
223 # assume that a variable is always static, unless it appears
|
|
|
224 # in a package before any sub. (Not necessarily true, but
|
|
|
225 # it's ok for most purposes and Vim works fine even if it is
|
|
|
226 # incorrect)
|
|
|
227 if ($do_vars)
|
|
|
228 {
|
|
|
229 MakeTag($var, "v", (!$is_pkg or $has_subs), $file, $line);
|
|
|
230 }
|
|
|
231 }
|
|
|
232 }
|
|
|
233
|
|
|
234 # This is a package declaration if the line starts with package
|
|
|
235 elsif ($stmt =~/^package\b/)
|
|
|
236 {
|
|
|
237 # Get name of the package
|
|
|
238 $package_name = PackageName($stmt);
|
|
|
239
|
|
|
240 if ($package_name)
|
|
|
241 {
|
|
|
242 # Remember that we're doing a package
|
|
|
243 $is_pkg = 1;
|
|
|
244
|
|
|
245 # Make a tag for this package unless we're told not to. A
|
|
|
246 # package is never static.
|
|
|
247 if ($do_pkgs)
|
|
|
248 {
|
|
|
249 MakeTag($package_name, "p", 0, $file, $line);
|
|
|
250 }
|
|
|
251 }
|
|
|
252 }
|
|
|
253
|
|
|
254 # This is a sub declaration if the line starts with sub
|
|
|
255 elsif ($stmt =~/^sub\b/)
|
|
|
256 {
|
|
|
257 # Remember that this file has subs
|
|
|
258 $has_subs = 1;
|
|
|
259
|
|
|
260 # Make a tag for this sub unless we're told not to. We assume
|
|
|
261 # that a sub is static, unless it appears in a package. (Not
|
|
|
262 # necessarily true, but it's ok for most purposes and Vim works
|
|
|
263 # fine even if it is incorrect)
|
|
|
264 if ($do_subs)
|
|
|
265 {
|
|
|
266 MakeTag(SubName($stmt), "s", (!$is_pkg), $file, $line);
|
|
|
267 }
|
|
|
268 }
|
|
|
269 }
|
|
|
270 close (IN);
|
|
|
271 }
|
|
|
272
|
|
|
273 # Do we have any tags? If so, write them to the tags file
|
|
|
274 if (@tags)
|
|
|
275 {
|
|
|
276 # Add some tag file extensions if we're told to
|
|
|
277 if ($do_exts)
|
|
|
278 {
|
|
|
279 push (@tags, "!_TAG_FILE_FORMAT\t2\t/extended format/");
|
|
|
280 push (@tags, "!_TAG_FILE_SORTED\t1\t/0=unsorted, 1=sorted/");
|
|
|
281 push (@tags, "!_TAG_PROGRAM_AUTHOR\tMichael Schaap\t/mscha\@mscha.com/");
|
|
|
282 push (@tags, "!_TAG_PROGRAM_NAME\tpltags\t//");
|
|
|
283 push (@tags, "!_TAG_PROGRAM_VERSION\t$VERSION\t/supports multiple tags and extended format/");
|
|
|
284 }
|
|
|
285
|
|
|
286 print "\nWriting tags file.\n";
|
|
|
287
|
|
|
288 open (OUT, ">tags") or die "Can't open tags file: $!";
|
|
|
289
|
|
|
290 foreach $tagline (sort @tags)
|
|
|
291 {
|
|
|
292 print OUT "$tagline\n";
|
|
|
293 }
|
|
|
294
|
|
|
295 close (OUT);
|
|
|
296 }
|
|
|
297 else
|
|
|
298 {
|
|
|
299 print "\nNo tags found.\n";
|
|
|
300 }
|
