ctags/parsers/perl.c

   1 /*
   2 *   Copyright (c) 2000-2003, Darren Hiebert
   3 *
   4 *   This source code is released for free distribution under the terms of the
   5 *   GNU General Public License version 2 or (at your option) any later version.
   6 *
   7 *   This module contains functions for generating tags for PERL language
   8 *   files.
   9 */
  10
  11 /*
  12 *   INCLUDE FILES
  13 */
  14 #include "general.h"  /* must always come first */
  15 #include "debug.h"
  16
  17 #include <string.h>
  18
  19 #include "entry.h"
  20 #include "promise.h"
  21 #include "options.h"
  22 #include "read.h"
  23 #include "routines.h"
  24 #include "vstring.h"
  25 #include "xtag.h"
  26
  27 #define TRACE_PERL_C 0
  28 #define TRACE if (TRACE_PERL_C) printf("perl.c:%d: ", __LINE__), printf
  29
  30 /*
  31 *   DATA DEFINITIONS
  32 */
  33 typedef enum {
  34         K_NONE = -1,
  35         K_CONSTANT,
  36         K_FORMAT,
  37         K_LABEL,
  38         K_PACKAGE,
  39         K_SUBROUTINE,
  40         K_SUBROUTINE_DECLARATION
  41 } perlKind;
  42
  43 static kindDefinition PerlKinds [] = {
  44         { true,  'c', "constant",               "constants" },
  45         { true,  'f', "format",                 "formats" },
  46         { true,  'l', "label",                  "labels" },
  47         { true,  'p', "package",                "packages" },
  48         { true,  's', "subroutine",             "subroutines" },
  49         { false, 'd', "subroutineDeclaration",  "subroutine declarations" },
  50 };
  51
  52 /*
  53 *   FUNCTION DEFINITIONS
  54 */
  55
  56 static bool isIdentifier1 (int c)
  57 {
  58         return (bool) (isalpha (c) || c == '_');
  59 }
  60
  61 static bool isIdentifier (int c)
  62 {
  63         return (bool) (isalnum (c) || c == '_');
  64 }
  65
  66 static bool isPodWord (const char *word)
  67 {
  68         bool result = false;
  69         if (isalpha (*word))
  70         {
  71                 const char *const pods [] = {
  72                         "head1", "head2", "head3", "head4", "over", "item", "back",
  73                         "pod", "begin", "end", "for"
  74                 };
  75                 const size_t count = ARRAY_SIZE (pods);
  76                 const char *white = strpbrk (word, " \t");
  77                 const size_t len = (white!=NULL) ? (size_t)(white-word) : strlen (word);
  78                 char *const id = (char*) eMalloc (len + 1);
  79                 size_t i;
  80                 strncpy (id, word, len);
  81                 id [len] = '\0';
  82                 for (i = 0  ;  i < count  &&  ! result  ;  ++i)
  83                 {
  84                         if (strcmp (id, pods [i]) == 0)
  85                                 result = true;
  86                 }
  87                 eFree (id);
  88         }
  89         return result;
  90 }
  91
  92 /*
  93  * Perl subroutine declaration may look like one of the following:
  94  *
  95  *  sub abc;
  96  *  sub abc :attr;
  97  *  sub abc (proto);
  98  *  sub abc (proto) :attr;
  99  *
 100  * Note that there may be more than one attribute.  Attributes may
 101  * have things in parentheses (they look like arguments).  Anything
 102  * inside of those parentheses goes.  Prototypes may contain semi-colons.
 103  * The matching end when we encounter (outside of any parentheses) either
 104  * a semi-colon (that'd be a declaration) or an left curly brace
 105  * (definition).
 106  *
 107  * This is pretty complicated parsing (plus we all know that only perl can
 108  * parse Perl), so we are only promising best effort here.
 109  *
 110  * If we can't determine what this is (due to a file ending, for example),
 111  * we will return false.
 112  */
 113 static bool isSubroutineDeclaration (const unsigned char *cp)
 114 {
 115         bool attr = false;
 116         int nparens = 0;
 117
 118         do {
 119                 for ( ; *cp; ++cp) {
 120 SUB_DECL_SWITCH:
 121                         switch (*cp) {
 122                                 case ':':
 123                                         if (nparens)
 124                                                 break;
 125                                         else if (true == attr)
 126                                                 return false;    /* Invalid attribute name */
 127                                         else
 128                                                 attr = true;
 129                                         break;
 130                                 case '(':
 131                                         ++nparens;
 132                                         break;
 133                                 case ')':
 134                                         --nparens;
 135                                         break;
 136                                 case ' ':
 137                                 case '\t':
 138                                         break;
 139                                 case ';':
 140                                         if (!nparens)
 141                                                 return true;
 142                                         /* fall through */
 143                                 case '{':
 144                                         if (!nparens)
 145                                                 return false;
 146                                         /* fall through */
 147                                 default:
 148                                         if (attr) {
 149                                                 if (isIdentifier1(*cp)) {
 150                                                         cp++;
 151                                                         while (isIdentifier (*cp))
 152                                                                 cp++;
 153                                                         attr = false;
 154                                                         goto SUB_DECL_SWITCH; /* Instead of --cp; */
 155                                                 } else {
 156                                                         return false;
 157                                                 }
 158                                         } else if (nparens) {
 159                                                 break;
 160                                         } else {
 161                                                 return false;
 162                                         }
 163                         }
 164                 }
 165         } while (NULL != (cp = readLineFromInputFile ()));
 166
 167         return false;
 168 }
 169
 170 /* Algorithm adapted from from GNU etags.
 171  * Perl support by Bart Robinson <lomew@cs.utah.edu>
 172  * Perl sub names: look for /^ [ \t\n]sub [ \t\n]+ [^ \t\n{ (]+/
 173  */
 174 static void findPerlTags (void)
 175 {
 176         vString *name = vStringNew ();
 177         vString *package = NULL;
 178         bool skipPodDoc = false;
 179         const unsigned char *line;
 180
 181         while ((line = readLineFromInputFile ()) != NULL)
 182         {
 183                 bool spaceRequired = false;
 184                 bool qualified = false;
 185                 const unsigned char *cp = line;
 186                 perlKind kind = K_NONE;
 187                 tagEntryInfo e;
 188
 189                 if (skipPodDoc)
 190                 {
 191                         if (strncmp ((const char*) line, "=cut", (size_t) 4) == 0)
 192                                 skipPodDoc = false;
 193                         continue;
 194                 }
 195                 else if (line [0] == '=')
 196                 {
 197                         skipPodDoc = isPodWord ((const char*)line + 1);
 198                         continue;
 199                 }
 200                 else if (strcmp ((const char*) line, "__DATA__") == 0)
 201                         break;
 202                 else if (strcmp ((const char*) line, "__END__") == 0)
 203                         break;
 204                 else if (line [0] == '#')
 205                         continue;
 206
 207                 while (isspace (*cp))
 208                         cp++;
 209
 210                 if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
 211                 {
 212                         TRACE("this looks like a sub\n");
 213                         cp += 3;
 214                         kind = K_SUBROUTINE;
 215                         spaceRequired = true;
 216                         qualified = true;
 217                 }
 218                 else if (strncmp((const char*) cp, "use", (size_t) 3) == 0)
 219                 {
 220                         cp += 3;
 221                         if (!isspace(*cp))
 222                                 continue;
 223                         while (*cp && isspace (*cp))
 224                                 ++cp;
 225                         if (strncmp((const char*) cp, "constant", (size_t) 8) != 0)
 226                                 continue;
 227                         cp += 8;
 228                         kind = K_CONSTANT;
 229                         spaceRequired = true;
 230                         qualified = true;
 231                 }
 232                 else if (strncmp((const char*) cp, "package", (size_t) 7) == 0)
 233                 {
 234                         /* This will point to space after 'package' so that a tag
 235                            can be made */
 236                         const unsigned char *space = cp += 7;
 237
 238                         if (package == NULL)
 239                                 package = vStringNew ();
 240                         else
 241                                 vStringClear (package);
 242                         while (isspace (*cp))
 243                                 cp++;
 244                         while ((int) *cp != ';'  &&  !isspace ((int) *cp))
 245                         {
 246                                 vStringPut (package, (int) *cp);
 247                                 cp++;
 248                         }
 249                         vStringCatS (package, "::");
 250
 251                         cp = space;      /* Rewind */
 252                         kind = K_PACKAGE;
 253                         spaceRequired = true;
 254                         qualified = true;
 255                 }
 256                 else if (strncmp((const char*) cp, "format", (size_t) 6) == 0)
 257                 {
 258                         cp += 6;
 259                         kind = K_FORMAT;
 260                         spaceRequired = true;
 261                         qualified = true;
 262                 }
 263                 else
 264                 {
 265                         if (isIdentifier1 (*cp))
 266                         {
 267                                 const unsigned char *p = cp;
 268                                 while (isIdentifier (*p))
 269                                         ++p;
 270                                 while (isspace (*p))
 271                                         ++p;
 272                                 if ((int) *p == ':' && (int) *(p + 1) != ':')
 273                                         kind = K_LABEL;
 274                         }
 275                 }
 276                 if (kind != K_NONE)
 277                 {
 278                         TRACE("cp0: %s\n", (const char *) cp);
 279                         if (spaceRequired && *cp && !isspace (*cp))
 280                                 continue;
 281
 282                         TRACE("cp1: %s\n", (const char *) cp);
 283                         while (isspace (*cp))
 284                                 cp++;
 285
 286                         while (!*cp || '#' == *cp) { /* Gobble up empty lines
 287                                                             and comments */
 288                                 cp = readLineFromInputFile ();
 289                                 if (!cp)
 290                                         goto END_MAIN_WHILE;
 291                                 while (isspace (*cp))
 292                                         cp++;
 293                         }
 294
 295                         while (isIdentifier (*cp) || (K_PACKAGE == kind && ':' == *cp))
 296                         {
 297                                 vStringPut (name, (int) *cp);
 298                                 cp++;
 299                         }
 300
 301                         if (K_FORMAT == kind &&
 302                                 vStringLength (name) == 0 && /* cp did not advance */
 303                                 '=' == *cp)
 304                         {
 305                                 /* format's name is optional.  If it's omitted, 'STDOUT'
 306                                    is assumed. */
 307                                 vStringCatS (name, "STDOUT");
 308                         }
 309
 310                         TRACE("name: %s\n", name->buffer);
 311
 312                         if (0 == vStringLength(name)) {
 313                                 vStringClear(name);
 314                                 continue;
 315                         }
 316
 317                         if (K_SUBROUTINE == kind)
 318                         {
 319                                 /*
 320                                  * isSubroutineDeclaration() may consume several lines.  So
 321                                  * we record line positions.
 322                                  */
 323                                 initTagEntry(&e, vStringValue(name), kind);
 324
 325                                 if (true == isSubroutineDeclaration(cp)) {
 326                                         if (true == PerlKinds[K_SUBROUTINE_DECLARATION].enabled) {
 327                                                 kind = K_SUBROUTINE_DECLARATION;
 328                                                 e.kindIndex = kind;
 329                                         } else {
 330                                                 vStringClear (name);
 331                                                 continue;
 332                                         }
 333                                 }
 334
 335                                 makeTagEntry(&e);
 336
 337                                 if (isXtagEnabled(XTAG_QUALIFIED_TAGS) && qualified &&
 338                                         package != NULL  && vStringLength (package) > 0)
 339                                 {
 340                                         vString *const qualifiedName = vStringNew ();
 341                                         vStringCopy (qualifiedName, package);
 342                                         vStringCat (qualifiedName, name);
 343                                         e.name = vStringValue(qualifiedName);
 344                                         makeTagEntry(&e);
 345                                         vStringDelete (qualifiedName);
 346                                 }
 347                         } else if (vStringLength (name) > 0)
 348                         {
 349                                 makeSimpleTag (name, kind);
 350                                 if (isXtagEnabled(XTAG_QUALIFIED_TAGS) && qualified &&
 351                                         K_PACKAGE != kind &&
 352                                         package != NULL  && vStringLength (package) > 0)
 353                                 {
 354                                         vString *const qualifiedName = vStringNew ();
 355                                         vStringCopy (qualifiedName, package);
 356                                         vStringCat (qualifiedName, name);
 357                                         makeSimpleTag (qualifiedName, kind);
 358                                         vStringDelete (qualifiedName);
 359                                 }
 360                         }
 361                         vStringClear (name);
 362                 }
 363         }
 364
 365 END_MAIN_WHILE:
 366         vStringDelete (name);
 367         if (package != NULL)
 368                 vStringDelete (package);
 369 }
 370
 371 extern parserDefinition* PerlParser (void)
 372 {
 373         static const char *const extensions [] = { "pl", "pm", "plx", "perl", NULL };
 374         parserDefinition* def = parserNew ("Perl");
 375         def->kindTable  = PerlKinds;
 376         def->kindCount  = ARRAY_SIZE (PerlKinds);
 377         def->extensions = extensions;
 378         def->parser     = findPerlTags;
 379         return def;
 380 }