http://qs1969.pair.com?node_id=326112
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);
     }
     }