Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Additional ctags' Perl support

by dmitri (Priest)
on Feb 03, 2004 at 05:13 UTC ( [id://326112]=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info Dmitri
Description: This patch adds several nice features to ctags' support of Perl. More are likely to come. Summary: New feature support in perl parser:
  - support for 'use constant ABC => "xyz";' construct (ABC
    tag is created);
  - support for label constructs:
      EXIT:
    will produce a tag for EXIT;
  - support for full (package name + name) tags for
    constants and subroutines:
      package ABC::XYZ;
      sub hello {         # will create tags
                          # 'ABC::XYZ::hello'
                          # and 'hello', in case hello is
                          # called in the first way.
      }

Update: Now patch is provided instead of a link to it.

Update 2: This node 444294 provides a newer patch against ctags 5.5.4.

--- ctags-5.5.2/perl.c    Mon Mar 31 23:55:27 2003
+++ ctags-5.5.2-mod/perl.c    Wed Jan 14 16:08:41 2004
@@ -15,6 +15,7 @@
 */
 #include "general.h"    /* must always come first */
 
+#include <ctype.h>
 #include <string.h>
 
 #include "read.h"
@@ -25,14 +26,26 @@
 */
 typedef enum {
     K_SUBROUTINE,
-    K_PACKAGE
+    K_PACKAGE,
+    K_CONSTANT,
+    K_LABEL,
 } perlKind;
 
 static kindOption PerlKinds [] = {
     { TRUE, 's', "subroutine", "subroutines" },
-    { TRUE, 'p', "package",    "packages" }
+    { TRUE, 'p', "package",    "packages" },
+    { TRUE, 'c', "constant",   "constants" },
+    { TRUE, 'l', "label",      "labels" },
 };
 
+static struct {
+    char str[1024];
+    int set;
+} package = { "", 0 };
+
+#define NOLABEL_STR "{(;="
+#define LABEL_STR ":"
+
 /*
 *   FUNCTION DEFINITIONS
 */
@@ -48,9 +61,12 @@
     const unsigned char *line;
     perlKind kind;
 
+    package.set = 0;
+
     while ((line = fileReadLine ()) != NULL)
     {
-    const unsigned char *cp = line;
+        const unsigned char *cp = line, *aux;
+        int sub = 0, use = 0, lbl = 0;  /* This will save up strcmps 
+later */
 
     if (skipPodDoc)
     {
@@ -74,31 +90,77 @@
     while (isspace (*cp))
         cp++;
 
-    if (strncmp((const char*) cp, "sub", (size_t) 3) == 0 ||
+        /* Try to find a label here */
+        for (aux = cp; *aux && isalnum(*aux); ++aux)
+            ;
+        if (aux > cp) {
+            while (isspace(*aux))
+                ++aux;
+            if (':' == *aux && (aux[1] ? ':' != aux[1] : 1))
+                lbl = 1;
+        }
+
+        if (lbl                                                      
+        ||
+            (strncmp((const char*) cp, "sub", (size_t) 3) == 0 && (su
+b = 1)) ||
+            (strncmp((const char*) cp, "use", (size_t) 3) == 0 && (us
+e = 1)) ||
         strncmp((const char*) cp, "package", (size_t) 7) == 0)
     {
-        if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
+            if (sub)
         {
             cp += 3;
         kind = K_SUBROUTINE;
+            } else if (use) {
+                cp += 3;
+                if (!isspace(*cp))
+                    continue;
+                while (*cp && isspace(*cp))
+                    ++cp;
+                if (0 != strncmp((const char*) cp, "constant", (size_
+t) 8)) {
+                    cp += 8;
+                    continue;
+                }
+                cp += 8;
+                kind = K_CONSTANT;
+            } else if (lbl) {
+                kind = K_LABEL;
         } else {
             cp += 7;
         kind = K_PACKAGE;
         }
-        if (!isspace(*cp))        /* woops, not followed by a space *
+/
+
+            /* This check is only performed if not a label */
+            if (!(lbl || isspace(*cp))) /* woops, not followed by a s
+pace */
             continue;
 
         while (isspace (*cp))
         cp++;
         while (! isspace ((int) *cp) && *cp != '\0' &&
-           strchr ("{(;", (int) *cp) == NULL)
+                   strchr ((lbl ? LABEL_STR : NOLABEL_STR), (int) *cp
+) == NULL)
         {
         vStringPut (name, (int) *cp);
         cp++;
         }
         vStringTerminate (name);
-        if (vStringLength (name) > 0)
+
+            if (vStringLength (name) > 0) {
         makeSimpleTag (name, PerlKinds, kind);
+                if (K_PACKAGE == kind &&
+                    vStringLength(name) < sizeof(package.str))
+                {
+                    strcpy(package.str, vStringValue(name));
+                    package.set = 1;
+                } else if ((K_SUBROUTINE == kind || K_CONSTANT == kin
+d)
+                           && package.set)
+                {
+                    vString *fname = vStringNew();
+                    vStringCatS(fname, package.str);
+                    vStringCatS(fname, "::");
+                    vStringCatS(fname, vStringValue(name));
+                    makeSimpleTag(fname, PerlKinds, kind);
+                    vStringDelete(fname);
+                }
+            }
+
         vStringClear (name);
     }
     }
Replies are listed 'Best First'.
Re: Additional ctags' Perl support
by knowmad (Monk) on Jan 19, 2005 at 02:28 UTC
      I am not sure exactly what bugs were found in my patch, as Darren's response does not seem to indicate this. I believe Perl support in 5.5.4 is not up to par (pretty crippled, actually), compared to my patch.

      I am working on the next patch, which I will post on ctags mailing list and on perlmonks. New features include support for generating tags for exceptions definitions, method calls (ABC::XYZ->new(), for instance), et al.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://326112]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2024-03-28 20:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found