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
29use strict;
30
31# Used modules
32use Getopt::Long;
33
34# Options with their defaults
35my $do_subs = 1;    # --subs, --nosubs    include subs in tags file?
36my $do_vars = 1;    # --vars, --novars    include variables in tags file?
37my $do_pkgs = 1;    # --pkgs, --nopkgs    include packages in tags file?
38my $do_exts = 1;    # --extensions, --noextensions
39		    #			  include Exuberant Ctags extensions
40
41# Global variables
42my $VERSION = "2.21";	# pltags version
43my $status = 0;		# GetOptions return value
44my $file = "";		# File being processed
45my @tags = ();		# List of produced tags
46my $is_pkg = 0;		# Are we tagging a package?
47my $has_subs = 0;	# Has this file any subs yet?
48my $package_name = "";	# Name of current package
49my $var_continues = 0;	# Variable declaration continues on last line
50my $line = "";		# Current line in file
51my $stmt = "";		# Current Perl statement
52my @vars = ();		# List of variables in declaration
53my $var = "";		# Variable in declaration
54my $tagline = "";	# Tag file line
55
56# Create a tag file line and push it on the list of found tags
57sub 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
92sub 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
112sub 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
132sub 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
153print "\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
162unless ($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
184foreach $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
274if (@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}
297else
298{
299    print "\nNo tags found.\n";
300}
301