File Coverage

blib/lib/Parse/ExCtags.pm
Criterion Covered Total %
statement 62 63 98.4
branch 8 10 80.0
condition 4 12 33.3
subroutine 13 13 100.0
pod 1 8 12.5
total 88 106 83.0


line stmt bran cond sub pod time code
1             package Parse::ExCtags;
2 1     1   23895 use Spiffy -Base;
  1         5777  
  1         9  
3 1     1   3455 use IO::All;
  1     1   3  
  1     1   29  
  1         6  
  1         6  
  1         25  
  1         916  
  1         17664  
  1         11  
4 1     1   80 use vars qw/$VERSION @EXPORT/;
  1         2  
  1         875  
5             our @EXPORT = qw(exctags);
6              
7             $VERSION = '0.06';
8              
9             field file => '';
10             field tags => [];
11             field parsed => 0;
12              
13             sub exctags() {
14 1     1 0 15 new(__PACKAGE__,@_);
15             }
16              
17 2     2 1 71 sub paired_arguments { qw(-file) };
  2         8  
18              
19             sub new() {
20 1     1 0 4 my $class = shift;
21 1         3 my $self = {};
22 1         3 bless $self;
23 1         13 my ($args) = $self->parse_arguments(@_);
24 1   50     64 $self->file($args->{-file} || 'tags');
25 1         19 $self->parse;
26 1         36 return $self;
27             }
28              
29 1     1 0 2 sub parse {
30 1         3 my $forced = shift;
31 1 50       4 $self->parsed(0) if $forced;
32 1 50       27 return $self->tags if($self->parsed);
33 1         11 my $tags;
34 12         30 map { $tags->{$_->{'name'}} = $_ }
  12         30  
35             map {
36 1         38 $_->[2] =~ s{;"$}{};
37 12         33 { name => $_->[0],
38             file => $_->[1],
39             address => $_->[2],
40             field => $self->parse_tagfield($_->[3]), };
41 1         2 } map $self->split_line($_), (@{io($self->file)});
42 1         26 $self->parsed(1);
43 1         160 $self->tags($tags);
44             }
45              
46 12     12 0 62125 sub split_line {
47 12         14 my ($line) = @_;
48 12 100       46 if($line =~ /^(.+?)\t(.+?)\t(\/\^.+")\t(.+)?$/) {
49 6         36 return [$1,$2,$3,$4]
50             } else {
51 6         27 return [split /\t/,$line,4]
52             }
53             }
54              
55 12     12 0 17 sub parse_tagfield {
56 12 100       38 my $field = shift or return {};
57 6         18 my $name_re = qr{[a-zA-Z]+};
58 6         24 my $value_re = qr{[\\a-zA-Z\d]*};
59 6         8 my $fields;
60 6   50     26 for(split(/\t/,$field||='')) {
61 12         14 my ($name,$value);
62 12 100       94 if(/($name_re):($value_re)/) {
63 6         10 $name = $1;
64 6         9 ($value) = unescape_value($2);
65             } else {
66 6         8 $name = 'kind';
67 6         10 $value = lookup_kind($_);
68             }
69 12         68 $fields->{$name} = $value;
70             }
71 6         36 return $fields;
72             }
73              
74             sub lookup_kind() {
75 6   50 6 0 13 my $kind = shift||'';
76             return {
77 6   33     56 c => 'class',
78             d => 'define',
79             e => 'enumerator',
80             f => 'function',
81             F => 'file',
82             g => 'enumeration',
83             m => 'member',
84             p => 'function',
85             s => 'structure',
86             t => 'typedef',
87             u => 'union',
88             v => 'variable',
89             }->{$kind} || $kind;
90             }
91              
92             sub unescape_value() {
93 6     6 0 12 my @new = @_;
94 6   0     9 for(@new) { s{\G(.*?)(\\.)}{$1 . ({'\\t' => chr(9), '\\r' => chr(13), '\\n' => chr(10), '\\\\' => '\\',}->{$2}||$2)}ge; }
  6         12  
  0         0  
95 6         17 return @new;
96             }
97              
98             =head1 NAME
99              
100             Parse::ExCtags - Parse ExCtags format of TAGS file
101              
102             =head1 SYNOPSIS
103              
104             use YAML;
105             use Parse::ExCtags;
106             my $tags = exctags(-file => 'tags')->tags; # hashref
107             print YAML::Dump $tags;
108              
109             =head1 DESCRIPTION
110              
111             This module exports a exctags() function that returns a
112             Parse::ExCtags object. The object has a tags() method
113             that return an hashref of hashref which are tags
114             presented in the file given by -file argument.
115              
116             The key to $tags is the 'tag name'. Usually a subroutine name
117             or package name. The kind of this 'tag name' is optionally store
118             in $tags->{field}->{kind}.
119              
120             Each hash has following keys:
121              
122             name: the tag name
123             file: the associated file
124             adddress: the ex pattern to search this tag
125             field: tagfields, a hashref of hashref (name,value) pair.
126              
127             =head1 COPYRIGHT
128              
129             Copyright 2004 by Kang-min Liu .
130              
131             This program is free software; you can redistribute it and/or
132             modify it under the same terms as Perl itself.
133              
134             See
135              
136             =cut
137              
138              
139