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