/*
* Perl subroutine declaration may look like one of the following:
*
* sub abc;
* sub abc :attr;
* sub abc (proto);
* sub abc (proto) :attr;
*
* Note that there may be more than one attribute. Attributes may
* have things in parentheses (they look like arguments). Anything
* inside of those parentheses goes. Prototypes may contain semi-colons.
* The matching end when we encounter (outside of any parentheses) either
* a semi-colon (that'd be a declaration) or an left curly brace
* (definition).
*
* This is pretty complicated parsing (plus we all know that only perl can
* parse Perl), so we are only promising best effort here.
*
* If we can't determine what this is (due to a file ending, for example),
* we will return FALSE.
*/
static boolean isSubroutineDeclaration (const unsigned char *cp)
{
boolean attr = FALSE;
int nparens = 0;
do {
for ( ; *cp; ++cp) {
SUB_DECL_SWITCH:
switch (*cp) {
case ':':
if (nparens)
break;
else if (TRUE == attr)
return FALSE; /* Invalid attribute name */
else
attr = TRUE;
break;
case '(':
++nparens;
break;
case ')':
--nparens;
break;
case ' ':
case '\t':
break;
case ';':
if (!nparens)
return TRUE;
case '{':
if (!nparens)
return FALSE;
default:
if (attr) {
if (isIdentifier1(*cp)) {
cp++;
while (isIdentifier (*cp))
cp++;
attr = FALSE;
goto SUB_DECL_SWITCH; /* Instead of --cp; */
} else {
return FALSE;
}
} else if (nparens) {
break;
} else {
return FALSE;
}
}
}
} while (NULL != (cp = fileReadLine ()));
return FALSE;
}
/*
* Perl subroutine declaration may look like one of the following:
*
* sub abc;
* sub abc :attr;
* sub abc (proto);
* sub abc (proto) :attr;
*
* Note that there may be more than one attribute. Attributes may
* have things in parentheses (they look like arguments). Anything
* inside of those parentheses goes. Prototypes may contain semi-colons.
* The matching end when we encounter (outside of any parentheses) either
* a semi-colon (that'd be a declaration) or an left curly brace
* (definition).
*
* This is pretty complicated parsing (plus we all know that only perl can
* parse Perl), so we are only promising best effort here.
*
* If we can't determine what this is (due to a file ending, for example),
* we will return false.
*/
static bool isSubroutineDeclaration (const unsigned char *cp)
{
bool attr = false;
int nparens = 0;
do {
for ( ; *cp; ++cp) {
SUB_DECL_SWITCH:
switch (*cp) {
case ':':
if (nparens)
break;
else if (true == attr)
return false; /* Invalid attribute name */
else
attr = true;
break;
case '(':
++nparens;
break;
case ')':
--nparens;
break;
case ' ':
case '\t':
break;
case ';':
if (!nparens)
return true;
case '{':
if (!nparens)
return false;
default:
if (attr) {
if (isIdentifier1(*cp)) {
cp++;
while (isIdentifier (*cp))
cp++;
attr = false;
goto SUB_DECL_SWITCH; /* Instead of --cp; */
} else {
return false;
}
} else if (nparens) {
break;
} else {
return false;
}
}
}
} while (NULL != (cp = readLineFromInputFile ()));
return false;
}
/* Algorithm adapted from from GNU etags.
* Perl support by Bart Robinson <*****@*****.**>
* Perl sub names: look for /^ [ \t\n]sub [ \t\n]+ [^ \t\n{ (]+/
*/
static void findPerlTags (void)
{
vString *name = vStringNew ();
vString *package = NULL;
boolean skipPodDoc = FALSE;
const unsigned char *line;
/* Core modules AutoLoader and SelfLoader support delayed compilation
* by allowing Perl code that follows __END__ and __DATA__ tokens,
* respectively. When we detect that one of these modules is used
* in the file, we continue processing even after we see the
* corresponding token that would usually terminate parsing of the
* file.
*/
enum {
RESPECT_END = (1 << 0),
RESPECT_DATA = (1 << 1),
} respect_token = RESPECT_END | RESPECT_DATA;
while ((line = fileReadLine ()) != NULL)
{
boolean spaceRequired = FALSE;
boolean qualified = FALSE;
const unsigned char *cp = line;
perlKind kind = K_NONE;
tagEntryInfo e;
if (skipPodDoc)
{
if (strncmp ((const char*) line, "=cut", (size_t) 4) == 0)
skipPodDoc = FALSE;
continue;
}
else if (line [0] == '=')
{
skipPodDoc = isPodWord ((const char*)line + 1);
continue;
}
else if (strcmp ((const char*) line, "__DATA__") == 0)
{
if (respect_token & RESPECT_DATA)
break;
else
continue;
}
else if (strcmp ((const char*) line, "__END__") == 0)
{
if (respect_token & RESPECT_END)
break;
else
continue;
}
else if (line [0] == '#')
continue;
while (isspace (*cp))
cp++;
if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
{
TRACE("this looks like a sub\n");
cp += 3;
kind = K_SUBROUTINE;
spaceRequired = TRUE;
qualified = TRUE;
}
else if (strncmp((const char*) cp, "use", (size_t) 3) == 0)
{
cp += 3;
if (!isspace(*cp))
continue;
while (*cp && isspace (*cp))
++cp;
if (strncmp((const char*) cp, "AutoLoader", (size_t) 10) == 0) {
respect_token &= ~RESPECT_END;
continue;
}
if (strncmp((const char*) cp, "SelfLoader", (size_t) 10) == 0) {
respect_token &= ~RESPECT_DATA;
continue;
}
if (strncmp((const char*) cp, "constant", (size_t) 8) != 0)
continue;
cp += 8;
/* Skip up to the first non-space character, skipping empty
* and comment lines.
*/
while (isspace(*cp))
cp++;
while (!*cp || '#' == *cp) {
cp = fileReadLine ();
if (!cp)
goto END_MAIN_WHILE;
while (isspace (*cp))
cp++;
}
if ('{' == *cp) {
++cp;
if (0 == parseConstantsFromHashRef(cp, name, package)) {
vStringClear(name);
continue;
} else
goto END_MAIN_WHILE;
}
kind = K_CONSTANT;
spaceRequired = FALSE;
qualified = TRUE;
}
else if (strncmp((const char*) cp, "package", (size_t) 7) == 0 &&
('\0' == cp[7] || isspace(cp[7])))
{
cp += 7;
while (isspace (*cp))
cp++;
while (!*cp || '#' == *cp) {
cp = fileReadLine ();
if (!cp)
goto END_MAIN_WHILE;
while (isspace (*cp))
cp++;
}
if (package == NULL)
package = vStringNew ();
else
vStringClear (package);
const unsigned char *const first = cp;
while (*cp && (int) *cp != ';' && !isspace ((int) *cp))
{
vStringPut (package, (int) *cp);
cp++;
}
vStringCatS (package, "::");
cp = first; /* Rewind */
kind = K_PACKAGE;
spaceRequired = FALSE;
qualified = TRUE;
}
else if (strncmp((const char*) cp, "format", (size_t) 6) == 0)
{
cp += 6;
kind = K_FORMAT;
spaceRequired = TRUE;
qualified = TRUE;
}
else
{
if (isIdentifier1 (*cp))
{
const unsigned char *p = cp;
while (isIdentifier (*p))
++p;
while (isspace (*p))
++p;
if ((int) *p == ':' && (int) *(p + 1) != ':')
kind = K_LABEL;
}
}
if (kind != K_NONE)
{
TRACE("cp0: %s\n", (const char *) cp);
if (spaceRequired && *cp && !isspace (*cp))
continue;
TRACE("cp1: %s\n", (const char *) cp);
while (isspace (*cp))
cp++;
while (!*cp || '#' == *cp) { /* Gobble up empty lines
and comments */
cp = fileReadLine ();
if (!cp)
goto END_MAIN_WHILE;
while (isspace (*cp))
cp++;
}
while (isIdentifier (*cp) || (K_PACKAGE == kind && ':' == *cp))
{
vStringPut (name, (int) *cp);
cp++;
}
if (K_FORMAT == kind &&
vStringLength (name) == 0 && /* cp did not advance */
'=' == *cp)
{
/* format's name is optional. If it's omitted, 'STDOUT'
is assumed. */
vStringCatS (name, "STDOUT");
}
vStringTerminate (name);
TRACE("name: %s\n", name->buffer);
if (0 == vStringLength(name)) {
vStringClear(name);
continue;
}
if (K_SUBROUTINE == kind)
{
/*
* isSubroutineDeclaration() may consume several lines. So
* we record line positions.
*/
initTagEntry(&e, vStringValue(name), NULL);
if (TRUE == isSubroutineDeclaration(cp)) {
if (TRUE == PerlKinds[K_SUBROUTINE_DECLARATION].enabled) {
kind = K_SUBROUTINE_DECLARATION;
} else {
vStringClear (name);
continue;
}
} else if (! PerlKinds[kind].enabled) {
continue;
}
e.kind = &(PerlKinds[kind]);
makeTagEntry(&e);
if (Option.include.qualifiedTags && qualified &&
package != NULL && vStringLength (package) > 0)
{
vString *const qualifiedName = vStringNew ();
vStringCopy (qualifiedName, package);
vStringCat (qualifiedName, name);
e.name = vStringValue(qualifiedName);
makeTagEntry(&e);
vStringDelete (qualifiedName);
}
} else if (vStringLength (name) > 0)
{
makeSimpleTag (name, PerlKinds, kind);
if (Option.include.qualifiedTags && qualified &&
K_PACKAGE != kind &&
package != NULL && vStringLength (package) > 0)
{
vString *const qualifiedName = vStringNew ();
vStringCopy (qualifiedName, package);
vStringCat (qualifiedName, name);
makeSimpleTag (qualifiedName, PerlKinds, kind);
vStringDelete (qualifiedName);
}
}
vStringClear (name);
}
}
END_MAIN_WHILE:
vStringDelete (name);
if (package != NULL)
vStringDelete (package);
}
/* Algorithm adapted from from GNU etags.
* Perl support by Bart Robinson <*****@*****.**>
* Perl sub names: look for /^ [ \t\n]sub [ \t\n]+ [^ \t\n{ (]+/
*/
static void findPerlTags (void)
{
vString *name = vStringNew ();
vString *package = NULL;
bool skipPodDoc = false;
const unsigned char *line;
while ((line = readLineFromInputFile ()) != NULL)
{
bool spaceRequired = false;
bool qualified = false;
const unsigned char *cp = line;
perlKind kind = K_NONE;
tagEntryInfo e;
if (skipPodDoc)
{
if (strncmp ((const char*) line, "=cut", (size_t) 4) == 0)
skipPodDoc = false;
continue;
}
else if (line [0] == '=')
{
skipPodDoc = isPodWord ((const char*)line + 1);
continue;
}
else if (strcmp ((const char*) line, "__DATA__") == 0)
break;
else if (strcmp ((const char*) line, "__END__") == 0)
break;
else if (line [0] == '#')
continue;
while (isspace (*cp))
cp++;
if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
{
TRACE("this looks like a sub\n");
cp += 3;
kind = K_SUBROUTINE;
spaceRequired = true;
qualified = true;
}
else if (strncmp((const char*) cp, "use", (size_t) 3) == 0)
{
cp += 3;
if (!isspace(*cp))
continue;
while (*cp && isspace (*cp))
++cp;
if (strncmp((const char*) cp, "constant", (size_t) 8) != 0)
continue;
cp += 8;
kind = K_CONSTANT;
spaceRequired = true;
qualified = true;
}
else if (strncmp((const char*) cp, "package", (size_t) 7) == 0)
{
/* This will point to space after 'package' so that a tag
can be made */
const unsigned char *space = cp += 7;
if (package == NULL)
package = vStringNew ();
else
vStringClear (package);
while (isspace (*cp))
cp++;
while ((int) *cp != ';' && !isspace ((int) *cp))
{
vStringPut (package, (int) *cp);
cp++;
}
vStringCatS (package, "::");
cp = space; /* Rewind */
kind = K_PACKAGE;
spaceRequired = true;
qualified = true;
}
else if (strncmp((const char*) cp, "format", (size_t) 6) == 0)
{
cp += 6;
kind = K_FORMAT;
spaceRequired = true;
qualified = true;
}
else
{
if (isIdentifier1 (*cp))
{
const unsigned char *p = cp;
while (isIdentifier (*p))
++p;
while (isspace (*p))
++p;
if ((int) *p == ':' && (int) *(p + 1) != ':')
kind = K_LABEL;
}
}
if (kind != K_NONE)
{
TRACE("cp0: %s\n", (const char *) cp);
if (spaceRequired && *cp && !isspace (*cp))
continue;
TRACE("cp1: %s\n", (const char *) cp);
while (isspace (*cp))
cp++;
while (!*cp || '#' == *cp) { /* Gobble up empty lines
and comments */
cp = readLineFromInputFile ();
if (!cp)
goto END_MAIN_WHILE;
while (isspace (*cp))
cp++;
}
while (isIdentifier (*cp) || (K_PACKAGE == kind && ':' == *cp))
{
vStringPut (name, (int) *cp);
cp++;
}
if (K_FORMAT == kind &&
vStringLength (name) == 0 && /* cp did not advance */
'=' == *cp)
{
/* format's name is optional. If it's omitted, 'STDOUT'
is assumed. */
vStringCatS (name, "STDOUT");
}
TRACE("name: %s\n", name->buffer);
if (0 == vStringLength(name)) {
vStringClear(name);
continue;
}
if (K_SUBROUTINE == kind)
{
/*
* isSubroutineDeclaration() may consume several lines. So
* we record line positions.
*/
initTagEntry(&e, vStringValue(name), &(PerlKinds[kind]));
if (true == isSubroutineDeclaration(cp)) {
if (true == PerlKinds[K_SUBROUTINE_DECLARATION].enabled) {
kind = K_SUBROUTINE_DECLARATION;
} else {
vStringClear (name);
continue;
}
}
makeTagEntry(&e);
if (isXtagEnabled(XTAG_QUALIFIED_TAGS) && qualified &&
package != NULL && vStringLength (package) > 0)
{
vString *const qualifiedName = vStringNew ();
vStringCopy (qualifiedName, package);
vStringCat (qualifiedName, name);
e.name = vStringValue(qualifiedName);
makeTagEntry(&e);
vStringDelete (qualifiedName);
}
} else if (vStringLength (name) > 0)
{
makeSimpleTag (name, PerlKinds, kind);
if (isXtagEnabled(XTAG_QUALIFIED_TAGS) && qualified &&
K_PACKAGE != kind &&
package != NULL && vStringLength (package) > 0)
{
vString *const qualifiedName = vStringNew ();
vStringCopy (qualifiedName, package);
vStringCat (qualifiedName, name);
makeSimpleTag (qualifiedName, PerlKinds, kind);
vStringDelete (qualifiedName);
}
}
vStringClear (name);
}
}
END_MAIN_WHILE:
vStringDelete (name);
if (package != NULL)
vStringDelete (package);
}
/* Algorithm adapted from from GNU etags.
* Perl support by Bart Robinson <*****@*****.**>
* Perl sub names: look for /^ [ \t\n]sub [ \t\n]+ [^ \t\n{ (]+/
*/
static void findPerlTags (void)
{
vString *name = vStringNew ();
vString *package = NULL;
boolean skipPodDoc = FALSE;
const unsigned char *line;
while ((line = fileReadLine ()) != NULL)
{
boolean spaceRequired = FALSE;
boolean qualified = FALSE;
const unsigned char *cp = line;
perlKind kind = K_NONE;
tagEntryInfo e;
if (skipPodDoc)
{
if (strncmp ((const char*) line, "=cut", (size_t) 4) == 0)
skipPodDoc = FALSE;
continue;
}
else if (line [0] == '=')
{
skipPodDoc = isPodWord ((const char*)line + 1);
continue;
}
else if (strcmp ((const char*) line, "__DATA__") == 0)
break;
else if (strcmp ((const char*) line, "__END__") == 0)
break;
else if (line [0] == '#')
continue;
while (isspace (*cp))
cp++;
if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
{
TRACE("this looks like a sub\n");
cp += 3;
kind = K_SUBROUTINE;
spaceRequired = TRUE;
qualified = TRUE;
}
else if (strncmp((const char*) cp, "use", (size_t) 3) == 0)
{
cp += 3;
if (!isspace(*cp))
continue;
while (*cp && isspace (*cp))
++cp;
if (strncmp((const char*) cp, "constant", (size_t) 8) != 0)
continue;
cp += 8;
/* <<<<<<< HEAD */
/* kind = K_CONSTANT; */
/* spaceRequired = TRUE; */
/* ======= */
/* Skip up to the first non-space character, skipping empty
* and comment lines.
*/
while (isspace(*cp))
cp++;
while (!*cp || '#' == *cp) {
cp = fileReadLine ();
if (!cp)
goto END_MAIN_WHILE;
while (isspace (*cp))
cp++;
}
if ('{' == *cp) {
++cp;
if (0 == parseConstantsFromHashRef(cp, name, package)) {
vStringClear(name);
continue;
} else
goto END_MAIN_WHILE;
}
kind = K_CONSTANT;
spaceRequired = FALSE;
/* >>>>>>> f039977edb44f3d46aacd26cc486ce153b879b0e */
qualified = TRUE;
}
else if (strncmp((const char*) cp, "package", (size_t) 7) == 0)
{
/* This will point to space after 'package' so that a tag
can be made */
const unsigned char *space = cp += 7;
if (package == NULL)
package = vStringNew ();
else
vStringClear (package);
while (isspace (*cp))
cp++;
/* <<<<<<< HEAD */
/* while ((int) *cp != ';' && !isspace ((int) *cp)) */
/* ======= */
while (*cp && (int) *cp != ';' && !isspace ((int) *cp))
/* >>>>>>> f039977edb44f3d46aacd26cc486ce153b879b0e */
{
vStringPut (package, (int) *cp);
cp++;
}
vStringCatS (package, "::");
cp = space; /* Rewind */
kind = K_PACKAGE;
spaceRequired = TRUE;
qualified = TRUE;
}
else if (strncmp((const char*) cp, "format", (size_t) 6) == 0)
{
cp += 6;
kind = K_FORMAT;
spaceRequired = TRUE;
qualified = TRUE;
}
else
{
if (isIdentifier1 (*cp))
{
const unsigned char *p = cp;
while (isIdentifier (*p))
++p;
while (isspace (*p))
++p;
if ((int) *p == ':' && (int) *(p + 1) != ':')
kind = K_LABEL;
}
}
if (kind != K_NONE)
{
TRACE("cp0: %s\n", (const char *) cp);
if (spaceRequired && *cp && !isspace (*cp))
continue;
TRACE("cp1: %s\n", (const char *) cp);
while (isspace (*cp))
cp++;
while (!*cp || '#' == *cp) { /* Gobble up empty lines
and comments */
cp = fileReadLine ();
if (!cp)
goto END_MAIN_WHILE;
while (isspace (*cp))
cp++;
}
while (isIdentifier (*cp) || (K_PACKAGE == kind && ':' == *cp))
{
vStringPut (name, (int) *cp);
cp++;
}
if (K_FORMAT == kind &&
vStringLength (name) == 0 && /* cp did not advance */
'=' == *cp)
{
/* format's name is optional. If it's omitted, 'STDOUT'
is assumed. */
vStringCatS (name, "STDOUT");
}
vStringTerminate (name);
TRACE("name: %s\n", name->buffer);
if (0 == vStringLength(name)) {
vStringClear(name);
continue;
}
if (K_SUBROUTINE == kind)
{
/*
* isSubroutineDeclaration() may consume several lines. So
* we record line positions.
*/
initTagEntry(&e, vStringValue(name));
if (TRUE == isSubroutineDeclaration(cp)) {
if (TRUE == PerlKinds[K_SUBROUTINE_DECLARATION].enabled) {
kind = K_SUBROUTINE_DECLARATION;
} else {
vStringClear (name);
continue;
}
}
e.kind = PerlKinds[kind].letter;
e.kindName = PerlKinds[kind].name;
makeTagEntry(&e);
if (Option.include.qualifiedTags && qualified &&
package != NULL && vStringLength (package) > 0)
{
vString *const qualifiedName = vStringNew ();
vStringCopy (qualifiedName, package);
vStringCat (qualifiedName, name);
e.name = vStringValue(qualifiedName);
makeTagEntry(&e);
vStringDelete (qualifiedName);
}
} else if (vStringLength (name) > 0)
{
makeSimpleTag (name, PerlKinds, kind);
if (Option.include.qualifiedTags && qualified &&
K_PACKAGE != kind &&
package != NULL && vStringLength (package) > 0)
{
vString *const qualifiedName = vStringNew ();
vStringCopy (qualifiedName, package);
vStringCat (qualifiedName, name);
makeSimpleTag (qualifiedName, PerlKinds, kind);
vStringDelete (qualifiedName);
}
}
vStringClear (name);
}
}
END_MAIN_WHILE:
vStringDelete (name);
if (package != NULL)
vStringDelete (package);
}
