← Back to branch summary

~ubuntu-branches/ubuntu/natty/geany/natty

« back to all changes in this revision

Viewing changes to tagmanager/perl.c

  • Committer: Bazaar Package Importer
  • Author(s): Chow Loong Jin
  • Date: 2010-08-07 03:23:12 UTC
  • mfrom: (1.4.3 upstream)
  • mto: This revision was merged to the branch mainline in revision 22.
  • Revision ID: james.westby@ubuntu.com-20100807032312-ot70ac9d50cn79we
Tags: upstream-0.19
Import upstream version 0.19

Show diffs side-by-side

added added

removed removed

Lines of Context:
tagmanager/perl.c
1
1
/*
 
2
*   $Id: perl.c 4420 2009-11-10 19:05:51Z ntrel $
2
3
*
3
 
*   Copyright (c) 2000-2001, Darren Hiebert
 
4
*   Copyright (c) 2000-2003, Darren Hiebert
4
5
*
5
6
*   This source code is released for free distribution under the terms of the
6
7
*   GNU General Public License.
12
13
/*
13
14
*   INCLUDE FILES
14
15
*/
15
 
#include "general.h"    /* must always come first */
 
16
#include "general.h"  /* must always come first */
16
17
 
17
18
#include <string.h>
18
19
 
 
20
#include "entry.h"
 
21
#include "options.h"
19
22
#include "read.h"
 
23
#include "main.h"
20
24
#include "vstring.h"
21
25
 
 
26
#define TRACE_PERL_C 0
 
27
#define TRACE if (TRACE_PERL_C) printf("perl.c:%d: ", __LINE__), printf
 
28
 
22
29
/*
23
30
*   DATA DEFINITIONS
24
31
*/
25
32
typedef enum {
26
 
    K_SUBROUTINE,
27
 
    K_PACKAGE,
28
 
    K_LOCAL,
29
 
    K_MY,
30
 
    K_OUR
 
33
        K_NONE = -1,
 
34
        K_CONSTANT,
 
35
        K_FORMAT,
 
36
        K_LABEL,
 
37
        K_PACKAGE,
 
38
        K_SUBROUTINE,
 
39
        K_SUBROUTINE_DECLARATION
31
40
} perlKind;
32
41
 
33
42
static kindOption PerlKinds [] = {
34
 
    { TRUE, 'f', "function", "functions" },
35
 
    { TRUE, 'c', "class", "packages" },
36
 
    { TRUE, 'l', "macro", "local variables" },
37
 
    { TRUE, 'm', "member", "my variables" },
38
 
    { TRUE, 'v', "variable", "our variables" }
 
43
        { TRUE,  'e', "enum",       "constants" },
 
44
        { TRUE,  'o', "other",      "formats" },
 
45
        { TRUE,  'm', "macro",      "labels" },
 
46
        { TRUE,  'p', "package",    "packages" },
 
47
        { TRUE,  'f', "function",   "subroutines" },
 
48
        { FALSE, 'p', "prototype",  "subroutine declarations" },
39
49
};
40
50
 
41
51
/*
42
52
*   FUNCTION DEFINITIONS
43
53
*/
44
54
 
45
 
static const unsigned char *createTagString(const unsigned char *str, int type)
46
 
{
47
 
    vString *n = vStringNew();
48
 
    while (! isspace ((int) *str) && *str != '\0' && *str != '=' && *str != ';' &&
49
 
                        *str != ',' && *str != ')' && *str != '$')
50
 
    {
51
 
                vStringPut (n, (int) *str);
52
 
                str++;
53
 
    }
54
 
 
55
 
    vStringTerminate (n);
56
 
    if (vStringLength (n) > 0)
57
 
        makeSimpleTag (n, PerlKinds, type);
58
 
    vStringDelete (n);
59
 
 
60
 
/*    if ((*(const char*)str) == ')')
61
 
                return str-1;
62
 
        else
63
 
*/              return str;
 
55
static boolean isIdentifier1 (int c)
 
56
{
 
57
        return (boolean) (isalpha (c) || c == '_');
 
58
}
 
59
 
 
60
static boolean isIdentifier (int c)
 
61
{
 
62
        return (boolean) (isalnum (c) || c == '_');
 
63
}
 
64
 
 
65
static boolean isPodWord (const char *word)
 
66
{
 
67
        boolean result = FALSE;
 
68
        if (isalpha (*word))
 
69
        {
 
70
                const char *const pods [] = {
 
71
                        "head1", "head2", "head3", "head4", "over", "item", "back",
 
72
                        "pod", "begin", "end", "for"
 
73
                };
 
74
                const size_t count = sizeof (pods) / sizeof (pods [0]);
 
75
                const char *white = strpbrk (word, " \t");
 
76
                const size_t len = (white!=NULL) ? (size_t)(white-word) : strlen (word);
 
77
                char *const id = (char*) eMalloc (len + 1);
 
78
                size_t i;
 
79
                strncpy (id, word, len);
 
80
                id [len] = '\0';
 
81
                for (i = 0  ;  i < count  &&  ! result  ;  ++i)
 
82
                {
 
83
                        if (strcmp (id, pods [i]) == 0)
 
84
                                result = TRUE;
 
85
                }
 
86
                eFree (id);
 
87
        }
 
88
        return result;
 
89
}
 
90
 
 
91
/*
 
92
 * Perl subroutine declaration may look like one of the following:
 
93
 *
 
94
 *  sub abc;
 
95
 *  sub abc :attr;
 
96
 *  sub abc (proto);
 
97
 *  sub abc (proto) :attr;
 
98
 *
 
99
 * Note that there may be more than one attribute.  Attributes may
 
100
 * have things in parentheses (they look like arguments).  Anything
 
101
 * inside of those parentheses goes.  Prototypes may contain semi-colons.
 
102
 * The matching end when we encounter (outside of any parentheses) either
 
103
 * a semi-colon (that'd be a declaration) or an left curly brace
 
104
 * (definition).
 
105
 *
 
106
 * This is pretty complicated parsing (plus we all know that only perl can
 
107
 * parse Perl), so we are only promising best effort here.
 
108
 *
 
109
 * If we can't determine what this is (due to a file ending, for example),
 
110
 * we will return FALSE.
 
111
 */
 
112
static boolean isSubroutineDeclaration (const unsigned char *cp)
 
113
{
 
114
        boolean attr = FALSE;
 
115
        int nparens = 0;
 
116
 
 
117
        do {
 
118
                for ( ; *cp; ++cp) {
 
119
SUB_DECL_SWITCH:
 
120
                        switch (*cp) {
 
121
                                case ':':
 
122
                                        if (nparens)
 
123
                                                break;
 
124
                                        else if (TRUE == attr)
 
125
                                                return FALSE;    /* Invalid attribute name */
 
126
                                        else
 
127
                                                attr = TRUE;
 
128
                                        break;
 
129
                                case '(':
 
130
                                        ++nparens;
 
131
                                        break;
 
132
                                case ')':
 
133
                                        --nparens;
 
134
                                        break;
 
135
                                case ' ':
 
136
                                case '\t':
 
137
                                        break;
 
138
                                case ';':
 
139
                                        if (!nparens)
 
140
                                                return TRUE;
 
141
                                case '{':
 
142
                                        if (!nparens)
 
143
                                                return FALSE;
 
144
                                default:
 
145
                                        if (attr) {
 
146
                                                if (isIdentifier1(*cp)) {
 
147
                                                        cp++;
 
148
                                                        while (isIdentifier (*cp))
 
149
                                                                cp++;
 
150
                                                        attr = FALSE;
 
151
                                                        goto SUB_DECL_SWITCH; /* Instead of --cp; */
 
152
                                                } else {
 
153
                                                        return FALSE;
 
154
                                                }
 
155
                                        } else if (nparens) {
 
156
                                                break;
 
157
                                        } else {
 
158
                                                return FALSE;
 
159
                                        }
 
160
                        }
 
161
                }
 
162
        } while (NULL != (cp = fileReadLine ()));
 
163
 
 
164
        return FALSE;
64
165
}
65
166
 
66
167
/* Algorithm adapted from from GNU etags.
69
170
 */
70
171
static void findPerlTags (void)
71
172
{
72
 
    vString *name = vStringNew ();
73
 
    boolean skipPodDoc = FALSE;
74
 
    const unsigned char *line;
75
 
    perlKind kind;
76
 
 
77
 
    while ((line = fileReadLine ()) != NULL)
78
 
    {
79
 
        const unsigned char *cp = line;
80
 
 
81
 
        if (skipPodDoc)
82
 
        {
83
 
            if (strcmp ((const char*) line, "=cut") == 0)
84
 
                skipPodDoc = FALSE;
85
 
            continue;
86
 
        }
87
 
        else if (line [0] == '=')
88
 
        {
89
 
            skipPodDoc = (boolean) (strncmp (
90
 
                        (const char*) line + 1, "cut", (size_t) 3) != 0);
91
 
            continue;
92
 
        }
93
 
        else if (strcmp ((const char*) line, "__DATA__") == 0)
94
 
            break;
95
 
        else if (strcmp ((const char*) line, "__END__") == 0)
96
 
            break;
97
 
        else if (line [0] == '#')
98
 
            continue;
99
 
 
100
 
        while (isspace (*cp))
101
 
            cp++;
102
 
 
103
 
        if (strncmp((const char*) cp, "my", (size_t) 2) == 0)
104
 
        {
105
 
                cp += 2;
106
 
                while (isspace (*cp)) cp++;
107
 
 
108
 
            /* parse something like my($bla) */
109
 
            if (*(const char*) cp == '(')
110
 
            {
111
 
                        cp++;
112
 
                        while (*(const char*) cp != ')')
113
 
                        {
114
 
                                while (isspace (*(const char*) cp)) cp++;
115
 
                                if (*(const char*) cp == ',') cp++;  /* to skip ',' */
116
 
                                while (isspace (*(const char*) cp)) cp++;
117
 
                                cp++; /* to skip $ sign */
118
 
                                cp = createTagString(cp, K_MY);
119
 
                                while (isspace (*(const char*) cp)) cp++;
120
 
                        }
121
 
            }
122
 
                /* parse my $bla */
123
 
                else
124
 
                {
125
 
                        cp++; /* to skip the $ sign */
126
 
 
127
 
                        if (! isalpha (*(const char*) cp)) continue;
128
 
 
129
 
                        createTagString (cp, K_MY);
130
 
                }
131
 
        }
132
 
        else if (strncmp((const char*) cp, "our", (size_t) 3) == 0)
133
 
        {
134
 
                cp += 3;
135
 
                while (isspace (*cp)) cp++;
136
 
 
137
 
            /* parse something like my($bla) */
138
 
            if (*(const char*) cp == '(')
139
 
            {
140
 
                        cp++;
141
 
                        while (*(const char*) cp != ')')
142
 
                        {
143
 
                                while (isspace (*(const char*) cp)) cp++;
144
 
                                if (*(const char*) cp == ',') cp++;  /* to skip ',' */
145
 
                                while (isspace (*(const char*) cp)) cp++;
146
 
                                cp++; /* to skip $ sign */
147
 
                                cp = createTagString(cp, K_OUR);
148
 
                                while (isspace (*(const char*) cp)) cp++;
149
 
                        }
150
 
            }
151
 
                /* parse my $bla */
152
 
                else
153
 
                {
154
 
                        cp++; /* to skip the $ sign */
155
 
 
156
 
                        if (! isalpha (*(const char*) cp)) continue;
157
 
 
158
 
                        createTagString (cp, K_OUR);
159
 
                }
160
 
        }
161
 
        else if (strncmp((const char*) cp, "local", (size_t) 5) == 0)
162
 
        {
163
 
                cp += 5;
164
 
                while (isspace (*cp)) cp++;
165
 
 
166
 
            /* parse something like my($bla) */
167
 
            if (*(const char*) cp == '(')
168
 
            {
169
 
                        cp++;
170
 
                        while (*(const char*) cp != ')')
171
 
                        {
172
 
                                while (isspace (*(const char*) cp)) cp++;
173
 
                                if (*(const char*) cp == ',') cp++;  /* to skip ',' */
174
 
                                while (isspace (*(const char*) cp)) cp++;
175
 
                                cp++; /* to skip $ sign */
176
 
                                cp = createTagString(cp, K_LOCAL);
177
 
                                while (isspace (*(const char*) cp)) cp++;
178
 
                        }
179
 
            }
180
 
                /* parse my $bla */
181
 
                else
182
 
                {
183
 
                        cp++; /* to skip the $ sign */
184
 
 
185
 
                        if (! isalpha (*(const char*) cp)) continue;
186
 
 
187
 
                        createTagString (cp, K_LOCAL);
188
 
                }
189
 
        }
190
 
        else if (strncmp((const char*) cp, "sub", (size_t) 3) == 0 ||
191
 
                         strncmp((const char*) cp, "package", (size_t) 7) == 0)
192
 
        {
193
 
            if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
194
 
            {
195
 
                cp += 3;
196
 
                kind = K_SUBROUTINE;
197
 
            } else {
198
 
                cp += 7;
199
 
                kind = K_PACKAGE;
200
 
            }
201
 
            if (!isspace(*cp))          /* woops, not followed by a space */
202
 
                continue;
203
 
 
204
 
            while (isspace (*cp))
205
 
                cp++;
206
 
            while (! isspace ((int) *cp) && *cp != '\0' && *cp != '{' && *cp != '(' && *cp != ';')
207
 
            {
208
 
                vStringPut (name, (int) *cp);
209
 
                cp++;
210
 
            }
211
 
            vStringTerminate (name);
212
 
            if (vStringLength (name) > 0)
213
 
                makeSimpleTag (name, PerlKinds, kind);
214
 
            vStringClear (name);
215
 
        }
216
 
    }
217
 
    vStringDelete (name);
 
173
        vString *name = vStringNew ();
 
174
        vString *package = NULL;
 
175
        boolean skipPodDoc = FALSE;
 
176
        const unsigned char *line;
 
177
 
 
178
        while ((line = fileReadLine ()) != NULL)
 
179
        {
 
180
                boolean spaceRequired = FALSE;
 
181
                boolean qualified = FALSE;
 
182
                const unsigned char *cp = line;
 
183
                perlKind kind = K_NONE;
 
184
                tagEntryInfo e;
 
185
 
 
186
                if (skipPodDoc)
 
187
                {
 
188
                        if (strncmp ((const char*) line, "=cut", (size_t) 4) == 0)
 
189
                                skipPodDoc = FALSE;
 
190
                        continue;
 
191
                }
 
192
                else if (line [0] == '=')
 
193
                {
 
194
                        skipPodDoc = isPodWord ((const char*)line + 1);
 
195
                        continue;
 
196
                }
 
197
                else if (strcmp ((const char*) line, "__DATA__") == 0)
 
198
                        break;
 
199
                else if (strcmp ((const char*) line, "__END__") == 0)
 
200
                        break;
 
201
                else if (line [0] == '#')
 
202
                        continue;
 
203
 
 
204
                while (isspace (*cp))
 
205
                        cp++;
 
206
 
 
207
                if (strncmp((const char*) cp, "sub", (size_t) 3) == 0)
 
208
                {
 
209
                        TRACE("this looks like a sub\n");
 
210
                        cp += 3;
 
211
                        kind = K_SUBROUTINE;
 
212
                        spaceRequired = TRUE;
 
213
                        qualified = TRUE;
 
214
                }
 
215
                else if (strncmp((const char*) cp, "use", (size_t) 3) == 0)
 
216
                {
 
217
                        cp += 3;
 
218
                        if (!isspace(*cp))
 
219
                                continue;
 
220
                        while (*cp && isspace (*cp))
 
221
                                ++cp;
 
222
                        if (strncmp((const char*) cp, "constant", (size_t) 8) != 0)
 
223
                                continue;
 
224
                        cp += 8;
 
225
                        kind = K_CONSTANT;
 
226
                        spaceRequired = TRUE;
 
227
                        qualified = TRUE;
 
228
                }
 
229
                else if (strncmp((const char*) cp, "package", (size_t) 7) == 0)
 
230
                {
 
231
                        /* This will point to space after 'package' so that a tag
 
232
                           can be made */
 
233
                        const unsigned char *space = cp += 7;
 
234
 
 
235
                        if (package == NULL)
 
236
                                package = vStringNew ();
 
237
                        else
 
238
                                vStringClear (package);
 
239
                        while (isspace (*cp))
 
240
                                cp++;
 
241
                        while ((int) *cp != ';'  &&  !isspace ((int) *cp))
 
242
                        {
 
243
                                vStringPut (package, (int) *cp);
 
244
                                cp++;
 
245
                        }
 
246
                        vStringCatS (package, "::");
 
247
 
 
248
                        cp = space;      /* Rewind */
 
249
                        kind = K_PACKAGE;
 
250
                        spaceRequired = TRUE;
 
251
                        qualified = TRUE;
 
252
                }
 
253
                else if (strncmp((const char*) cp, "format", (size_t) 6) == 0)
 
254
                {
 
255
                        cp += 6;
 
256
                        kind = K_FORMAT;
 
257
                        spaceRequired = TRUE;
 
258
                        qualified = TRUE;
 
259
                }
 
260
                else
 
261
                {
 
262
                        if (isIdentifier1 (*cp))
 
263
                        {
 
264
                                const unsigned char *p = cp;
 
265
                                while (isIdentifier (*p))
 
266
                                        ++p;
 
267
                                while (isspace (*p))
 
268
                                        ++p;
 
269
                                if ((int) *p == ':' && (int) *(p + 1) != ':')
 
270
                                        kind = K_LABEL;
 
271
                        }
 
272
                }
 
273
                if (kind != K_NONE)
 
274
                {
 
275
                        TRACE("cp0: %s\n", (const char *) cp);
 
276
                        if (spaceRequired && *cp && !isspace (*cp))
 
277
                                continue;
 
278
 
 
279
                        TRACE("cp1: %s\n", (const char *) cp);
 
280
                        while (isspace (*cp))
 
281
                                cp++;
 
282
 
 
283
                        while (!*cp || '#' == *cp) { /* Gobble up empty lines
 
284
                                                            and comments */
 
285
                                cp = fileReadLine ();
 
286
                                if (!cp)
 
287
                                        goto END_MAIN_WHILE;
 
288
                                while (isspace (*cp))
 
289
                                        cp++;
 
290
                        }
 
291
 
 
292
                        while (isIdentifier (*cp) || (K_PACKAGE == kind && ':' == *cp))
 
293
                        {
 
294
                                vStringPut (name, (int) *cp);
 
295
                                cp++;
 
296
                        }
 
297
 
 
298
                        if (K_FORMAT == kind &&
 
299
                                vStringLength (name) == 0 && /* cp did not advance */
 
300
                                '=' == *cp)
 
301
                        {
 
302
                                /* format's name is optional.  If it's omitted, 'STDOUT'
 
303
                                   is assumed. */
 
304
                                vStringCatS (name, "STDOUT");
 
305
                        }
 
306
 
 
307
                        vStringTerminate (name);
 
308
                        TRACE("name: %s\n", name->buffer);
 
309
 
 
310
                        if (0 == vStringLength(name)) {
 
311
                                vStringClear(name);
 
312
                                continue;
 
313
                        }
 
314
 
 
315
                        if (K_SUBROUTINE == kind)
 
316
                        {
 
317
                                /*
 
318
                                 * isSubroutineDeclaration() may consume several lines.  So
 
319
                                 * we record line positions.
 
320
                                 */
 
321
                                initTagEntry(&e, vStringValue(name));
 
322
 
 
323
                                if (TRUE == isSubroutineDeclaration(cp)) {
 
324
                                        if (TRUE == PerlKinds[K_SUBROUTINE_DECLARATION].enabled) {
 
325
                                                kind = K_SUBROUTINE_DECLARATION;
 
326
                                        } else {
 
327
                                                vStringClear (name);
 
328
                                                continue;
 
329
                                        }
 
330
                                }
 
331
 
 
332
                                e.kind     = PerlKinds[kind].letter;
 
333
                                e.kindName = PerlKinds[kind].name;
 
334
 
 
335
                                makeTagEntry(&e);
 
336
 
 
337
                                if (Option.include.qualifiedTags && qualified &&
 
338
                                        package != NULL  && vStringLength (package) > 0)
 
339
                                {
 
340
                                        vString *const qualifiedName = vStringNew ();
 
341
                                        vStringCopy (qualifiedName, package);
 
342
                                        vStringCat (qualifiedName, name);
 
343
                                        e.name = vStringValue(qualifiedName);
 
344
                                        makeTagEntry(&e);
 
345
                                        vStringDelete (qualifiedName);
 
346
                                }
 
347
                        } else if (vStringLength (name) > 0)
 
348
                        {
 
349
                                makeSimpleTag (name, PerlKinds, kind);
 
350
                                if (Option.include.qualifiedTags && qualified &&
 
351
                                        K_PACKAGE != kind &&
 
352
                                        package != NULL  && vStringLength (package) > 0)
 
353
                                {
 
354
                                        vString *const qualifiedName = vStringNew ();
 
355
                                        vStringCopy (qualifiedName, package);
 
356
                                        vStringCat (qualifiedName, name);
 
357
                                        makeSimpleTag (qualifiedName, PerlKinds, kind);
 
358
                                        vStringDelete (qualifiedName);
 
359
                                }
 
360
                        }
 
361
                        vStringClear (name);
 
362
                }
 
363
        }
 
364
 
 
365
END_MAIN_WHILE:
 
366
        vStringDelete (name);
 
367
        if (package != NULL)
 
368
                vStringDelete (package);
218
369
}
219
370
 
220
371
extern parserDefinition* PerlParser (void)
221
372
{
222
 
    static const char *const extensions [] = { "pl", "pm", "perl", NULL };
223
 
    parserDefinition* def = parserNew ("Perl");
224
 
    def->kinds      = PerlKinds;
225
 
    def->kindCount  = KIND_COUNT (PerlKinds);
226
 
    def->extensions = extensions;
227
 
    def->parser     = findPerlTags;
228
 
    return def;
 
373
        static const char *const extensions [] = { "pl", "pm", "plx", "perl", NULL };
 
374
        parserDefinition* def = parserNew ("Perl");
 
375
        def->kinds      = PerlKinds;
 
376
        def->kindCount  = KIND_COUNT (PerlKinds);
 
377
        def->extensions = extensions;
 
378
        def->parser     = findPerlTags;
 
379
        return def;
229
380
}
230
381
 
231
 
/* vi:set tabstop=8 shiftwidth=4: */
 
382
/* vi:set tabstop=4 shiftwidth=4 noexpandtab: */