tagmanager/perl.c

   1 /*
   2 *   $Id$
   3 *
   4 *   Copyright (c) 2000-2003, Darren Hiebert
   5 *
   6 *   This source code is released for free distribution under the terms of the
   7 *   GNU General Public License.
   8 *
   9 *   This module contains functions for generating tags for PERL language
  10 *   files.
  11 */
  12
  13 /*
  14 *   INCLUDE FILES
  15 */
  16 #include "general.h"  /* must always come first */
  17
  18 #include <string.h>
  19
  20 #include "options.h"
  21 #include "read.h"
  22 #include "routines.h"
  23 #include "vstring.h"
  24
  25 /*
  26 *   DATA DEFINITIONS
  27 */
  28 typedef enum {
  29         K_NONE = -1,
  30         K_CONSTANT,
  31         K_LABEL,
  32         K_SUBROUTINE
  33 } perlKind;
  34
  35 static kindOption PerlKinds [] = {
  36         { TRUE, 'c', "constant",   "constants" },
  37         { TRUE, 'l', "label",      "labels" },
  38         { TRUE, 's', "subroutine", "subroutines" }
  39 };
  40
  41 /*
  42 *   FUNCTION DEFINITIONS
  43 */
  44
  45 static boolean isIdentifier1 (int c)
  46 {
  47         return (boolean) (isalpha (c) || c == '_');
  48 }
  49
  50 static boolean isIdentifier (int c)
  51 {
  52         return (boolean) (isalnum (c) || c == '_');
  53 }
  54
  55 static boolean isPodWord (const char *word)
  56 {
  57         boolean result = FALSE;
  58         if (isalpha (*word))
  59         {
  60                 const char *const pods [] = {
  61                         "head1", "head2", "head3", "head4", "over", "item", "back",
  62                         "pod", "begin", "end", "for"
  63                 };
  64                 const size_t count = sizeof (pods) / sizeof (pods [0]);
  65                 const char *white = strpbrk (word, " \t");
  66                 const size_t len = (white!=NULL) ? (size_t)(white-word) : strlen (word);
  67                 char *const id = (char*) eMalloc (len + 1);
  68                 size_t i;
  69                 strncpy (id, word, len);
  70                 id [len] = '\0';
  71                 for (i = 0  ;  i < count  &&  ! result  ;  ++i)
  72                 {
  73                         if (strcmp (id, pods [i]) == 0)
  74                                 result = TRUE;
  75                 }
  76                 eFree (id);
  77         }
  78         return result;
  79 }
  80
  81 /* Algorithm adapted from from GNU etags.
  82  * Perl support by Bart Robinson <lomew@cs.utah.edu>
  83  * Perl sub names: look for /^ [ \t\n]sub [ \t\n]+ [^ \t\n{ (]+/
  84  */
  85 static void findPerlTags (void)
  86 {
  87         vString *name = vStringNew ();
  88         vString *package = NULL;
  89         boolean skipPodDoc = FALSE;
  90         const unsigned char *line;
  91
  92         while ((line = fileReadLine ()) != NULL)
  93         {
  94                 boolean spaceRequired = FALSE;
  95                 boolean qualified = FALSE;
  96                 const unsigned char *cp = line;
  97                 perlKind kind = K_NONE;
  98
  99                 if (skipPodDoc)
 100                 {
 101                         if (strncmp ((const char*) line, "=cut", (size_t) 4) == 0)
 102                                 skipPodDoc = FALSE;
 103                         continue;
 104                 }
 105                 else if (line [0] == '=')
 106                 {
 107                         skipPodDoc = isPodWord ((const char*)line + 1);
 108                         continue;
 109                 }
 110                 else if (strcmp ((const char*) line, "__DATA__") == 0)
 111                         break;
 112                 else if (strcmp ((const char*) line, "__END__") == 0)
 113                         break;
 114                 else if (line [0] == '#')
 115                         continue;
 116
 117                 while (isspace (*cp))
 118                         cp++;
 119
 120                 if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
 121                 {
 122                         cp += 3;
 123                         kind = K_SUBROUTINE;
 124                         spaceRequired = TRUE;
 125                         qualified = TRUE;
 126                 }
 127                 else if (strncmp((const char*) cp, "use", (size_t) 3) == 0)
 128                 {
 129                         cp += 3;
 130                         if (!isspace(*cp))
 131                                 continue;
 132                         while (*cp && isspace (*cp))
 133                                 ++cp;
 134                         if (strncmp((const char*) cp, "constant", (size_t) 8) != 0)
 135                                 continue;
 136                         cp += 8;
 137                         kind = K_CONSTANT;
 138                         spaceRequired = TRUE;
 139                         qualified = TRUE;
 140                 }
 141                 else if (strncmp((const char*) cp, "package", (size_t) 7) == 0)
 142                 {
 143                         cp += 7;
 144                         if (package == NULL)
 145                                 package = vStringNew ();
 146                         else
 147                                 vStringClear (package);
 148                         while (isspace (*cp))
 149                                 cp++;
 150                         while ((int) *cp != ';'  &&  !isspace ((int) *cp))
 151                         {
 152                                 vStringPut (package, (int) *cp);
 153                                 cp++;
 154                         }
 155                         vStringCatS (package, "::");
 156                 }
 157                 else
 158                 {
 159                         if (isIdentifier1 (*cp))
 160                         {
 161                                 const unsigned char *p = cp;
 162                                 while (isIdentifier (*p))
 163                                         ++p;
 164                                 if ((int) *p == ':')
 165                                         kind = K_LABEL;
 166                         }
 167                 }
 168                 if (kind != K_NONE)
 169                 {
 170                         if (spaceRequired && !isspace (*cp))
 171                                 continue;
 172
 173                         while (isspace (*cp))
 174                                 cp++;
 175                         while (isIdentifier (*cp))
 176                         {
 177                                 vStringPut (name, (int) *cp);
 178                                 cp++;
 179                         }
 180                         vStringTerminate (name);
 181                         if (vStringLength (name) > 0)
 182                         {
 183                                 makeSimpleTag (name, PerlKinds, kind);
 184                                 if (Option.include.qualifiedTags && qualified &&
 185                                         package != NULL  && vStringLength (package) > 0)
 186                                 {
 187                                         vString *const qualifiedName = vStringNew ();
 188                                         vStringCopy (qualifiedName, package);
 189                                         vStringCat (qualifiedName, name);
 190                                         makeSimpleTag (qualifiedName, PerlKinds, kind);
 191                                         vStringDelete (qualifiedName);
 192                                 }
 193                         }
 194                         vStringClear (name);
 195                 }
 196         }
 197         vStringDelete (name);
 198         if (package != NULL)
 199                 vStringDelete (package);
 200 }
 201
 202 extern parserDefinition* PerlParser (void)
 203 {
 204         static const char *const extensions [] = { "pl", "pm", "plx", "perl", NULL };
 205         parserDefinition* def = parserNew ("Perl");
 206         def->kinds      = PerlKinds;
 207         def->kindCount  = KIND_COUNT (PerlKinds);
 208         def->extensions = extensions;
 209         def->parser     = findPerlTags;
 210         return def;
 211 }
 212
 213 /* vi:set tabstop=4 shiftwidth=4: */