--- 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);
     }
     }
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.