runtime/tools/pltags.pl

   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 }