File Coverage

blib/lib/Parse/Readelf/Debug/Line.pm
Criterion Covered Total %
statement 130 130 100.0
branch 71 76 93.4
condition 23 33 69.7
subroutine 13 13 100.0
pod 9 9 100.0
total 246 261 94.2


line stmt bran cond sub pod time code
1             package Parse::Readelf::Debug::Line;
2              
3             # Author, Copyright and License: see end of file
4              
5             =head1 NAME
6              
7             Parse::Readelf::Debug::Line - handle readelf's debug line section with a class
8              
9             =head1 SYNOPSIS
10              
11             use Parse::Readelf::Debug::Line;
12              
13             my $line_info = new Parse::Readelf::Debug::Line($executable);
14              
15             my $object_id = $line_info->object_id("mocdule.c");
16              
17             my $file_name = $line_info->file($object_id, $number);
18             my $directory_name = $line_info->directory($object_id, $number);
19             my $path = $line_info->path($object_id, $number);
20              
21             my $object_name = $line_info->object_name($object_id);
22              
23             my $file_count = $line_info->files($object_id);
24             my @files = $line_info->files($object_id);
25             my $directory_count = $line_info->directories($object_id);
26             my @directories = $line_info->directories($object_id);
27             my $path_count = $line_info->paths($object_id);
28             my @paths = $line_info->paths($object_id);
29              
30             =head1 ABSTRACT
31              
32             Parse::Readelf::Debug::Line parses the output of C
33             --debug-dump=line> and stores its interesting details in an object to
34             be available. Normally it's not used directly but by other modules of
35             L>.
36              
37             =head1 DESCRIPTION
38              
39             Normally an object of this class is constructed with the file name of
40             an object file to be parsed. Upon construction the file is analysed
41             and all relevant information about its debug line section is stored
42             inside of the object. This information can be accessed afterwards
43             using a bunch of getter methods, see L for details.
44              
45             Currently only output for B is supported. Please
46             contact the author for other versions and provide some example
47             C outputs.
48              
49             =cut
50              
51             #########################################################################
52              
53 4     4   1114 use 5.006001;
  4         15  
  4         194  
54 4     4   20 use strict;
  4         7  
  4         143  
55 4     4   16 use warnings;
  4         5  
  4         160  
56 4     4   19 use Carp;
  4         5  
  4         7134  
57              
58             our $VERSION = '0.18';
59              
60             #########################################################################
61              
62             =head1 EXPORT
63              
64             Nothing is exported by default as it's normally not needed to modify
65             any of the variables declared in the following export groups:
66              
67             =head2 :all
68              
69             all of the following groups
70              
71             =cut
72              
73             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
74              
75             require Exporter;
76              
77             our @ISA = qw(Exporter);
78             our @EXPORT = qw();
79              
80             our %EXPORT_TAGS =
81             (command => [ qw($command) ],
82             fixed_regexps => [ qw($re_section_start $re_dwarf_version) ],
83             versioned_regexps => [ qw(@re_directory_table
84             @re_file_name_table
85             @re_file_name_table_header) ]
86             );
87             $EXPORT_TAGS{all} = [ map { @$_ } values(%EXPORT_TAGS) ];
88              
89             our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );
90              
91             #########################################################################
92              
93             =head2 :command
94              
95             =over
96              
97             =item I<$command>
98              
99             is the variable holding the command to run C to get the
100             information relevant for this module, normally C
101             --debug-dump=line>.
102              
103             =back
104              
105             =cut
106              
107             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
108              
109             our $command = 'readelf --debug-dump=line';
110              
111             #########################################################################
112              
113             =head2 :fixed_regexps
114              
115             =over
116              
117             =item I<$re_section_start>
118              
119             is the regular expression that recognises the start of the line debug
120             output of C.
121              
122             =item I<$re_dwarf_version>
123              
124             is the regular expression that recognises the Dwarf version line in a
125             line debug output of C. The version number must be an
126             integer number which will (must) be stored in C<$1>.
127              
128             =back
129              
130             =cut
131              
132             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
133              
134             our $re_section_start =
135             qr(^(?:raw )?dump of debug contents of section \.debug_line:)i;
136              
137             our $re_dwarf_version = qr(^\s*DWARF Version:\s+(\d+)\s*$)i;
138              
139             #########################################################################
140              
141             =head2 :versioned_regexps
142              
143             =over
144              
145             =item I<@re_directory_table>
146              
147             is the version dependent regular expression that recognises the start
148             of the directory table in line debug output of C.
149              
150             =item I<@re_file_name_table>
151              
152             is the version dependent regular expression that recognises the start
153             of the non-empty file name table in line debug output of C.
154              
155             =item I<@re_file_name_table_header>
156              
157             is the version dependent regular expression that recognises the
158             heading line of the file name table in line debug output of
159             C. If this must be modified this probably means the parsing
160             will not work correctly!
161              
162             =back
163              
164             =cut
165              
166             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
167              
168             our @re_directory_table =
169             ( undef, undef, qr(^\s*The Directory Table)i );
170              
171             our @re_file_name_table =
172             ( undef, undef, qr(^\s*The File Name Table:)i );
173              
174             our @re_file_name_table_header =
175             ( undef, undef, qr(^\s*Entry\s+Dir\s+Time\s+Size\s+Name)i );
176              
177             #########################################################################
178              
179             =head2 new - get readelf's debug line section into an object
180              
181             $line_info = new Parse::Readelf::Debug::Line($file_name);
182              
183             =head3 example:
184              
185             $line_info1 = new Parse::Readelf::Debug::Line('program');
186             $line_info2 = new Parse::Readelf::Debug::Line('module.o');
187              
188             =head3 parameters:
189              
190             $file_name name of executable or object file
191              
192             =head3 description:
193              
194             This method parses the output of C and
195             stores its interesting details internally to be accessed later by
196             getter methods described below.
197              
198             =head3 global variables used:
199              
200             The method uses all of the variables described above in the
201             L section.
202              
203             =head3 returns:
204              
205             The method returns the blessed Parse::Readelf::Debug::Line object
206             or an exception in case of an error.
207              
208             =cut
209              
210             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
211             sub new($$)
212             {
213 27     27 1 33657 my $this = shift;
214 27   100     171 my $class = ref($this) || $this;
215 27         90 my ($file_name) = @_;
216 27         165 my %self = (objects => [],
217             object_map => {},
218             directories => [],
219             file_names => []);
220 27         41 local $_;
221              
222             # checks:
223 27 100       73 if (! $file_name)
224 1         408 { croak 'bad call to new of ', __PACKAGE__; }
225 26 100       68 if (ref($this))
226 1         227 { carp 'cloning of a ', __PACKAGE__, " object is not supported"; }
227 26 100       478 if (! -f $file_name)
228 1         307 { croak __PACKAGE__, " can't find ", $file_name; }
229              
230             # call readelf and prepare parsing output:
231 25 100       43004 open READELF, '-|', $command.' '.$file_name or
232             croak "can't parse ", $file_name, ' with "', $command, '" in ',
233             __PACKAGE__, ': ', $!;
234              
235             # find start of section:
236 24         16520 while ()
237 143315 100       431519 { last if m/$re_section_start/; }
238              
239             # parse section:
240 24         177 my $version = -1;
241 24         119 my @directory_list = ();
242 24         217 while ()
243             {
244              
245 8084 100       20097 if (m/$re_dwarf_version/)
246             {
247 47         214 $version = $1;
248 47 100 100     1466 confess 'DWARF version ', $version, ' not supported in ',
      100        
249             __PACKAGE__
250             unless (defined $re_directory_table[$version] and
251             defined $re_file_name_table[$version] and
252             defined $re_file_name_table_header[$version]);
253             }
254 8081 100       10605 next unless $version >= 0;
255              
256 8027 100       36249 if (m/$re_directory_table[$version]/)
    100          
257             {
258 44         140 @directory_list = ('.');
259 44         228 while ()
260             {
261 228         743 s/^\s+//; s/\s+$//;
  228         544  
262 228 100       485 last unless $_;
263 184         563 push @directory_list, $_;
264             }
265             }
266              
267             elsif (m/$re_file_name_table[$version]/)
268             {
269 44 100       631 =~ m/$re_file_name_table_header[$version]/ or
270             confess 'aborting: head line of file name table ',
271             'not recognised in ', __PACKAGE__;
272 43         78 my @file_name_table = ();
273 43         60 my @directory_table = ();
274 43         231 while ()
275             {
276 1667         4352 s/[\r\n]+//;
277 1667 100       4823 last unless m/\s*(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(.*)/;
278 1624         3306 my ($id, $directory_id, $time, $size, $name) =
279             ($1, $2, $3, $4, $5);
280 1624 100       2679 if ($id == 1)
281             {
282 43         42 push @{$self{objects}}, $name;
  43         177  
283 43         1196 $self{object_map}{$name} = $#{$self{objects}};
  43         243  
284 43         61 push @{$self{directories}}, \@directory_table;
  43         126  
285 43         47 push @{$self{file_names}}, \@file_name_table;
  43         90  
286             }
287 1624         2304 $file_name_table[$id] = $name;
288 1624         4851 $directory_table[$id] = $directory_list[$directory_id];
289             }
290 43         247 @directory_list = ();
291             }
292             }
293              
294             # now we're finished:
295 20 100       1225 close READELF or
296             croak 'error while attempting to parse ', $file_name,
297             ' (maybe not an object file?)';
298 19         534 bless \%self, $class;
299             }
300              
301             #########################################################################
302              
303             =head2 object_id - get object ID of (named) source file
304              
305             $object_id = $line_info->object_id($file_name);
306              
307             =head3 example:
308              
309             $object_id = $line_info->object_id('module.c');
310              
311             =head3 parameters:
312              
313             $file_name name of the source file (without directory)
314              
315             =head3 description:
316              
317             This method returns the internal object ID of a module when given
318             the name of its source file without directory. This is a
319             non-negative number.
320              
321             =head3 returns:
322              
323             The method returns the object ID or -1 if no matching object was
324             found.
325              
326             =cut
327              
328             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
329             sub object_id($$)
330             {
331 10     10 1 1792 my $this = shift;
332 10         13 my ($name) = @_;
333 10         19 my $id = $this->{object_map}{$name};
334 10 100       25 return defined $id ? $id : -1;
335             }
336              
337             #########################################################################
338              
339             =head2 object_name - get name of major source file for a given object ID
340              
341             $object_name = $line_info->object_name($object_id);
342              
343             =head3 example:
344              
345             $object_name = $line_info->object_name(0);
346              
347             =head3 parameters:
348              
349             $object_id internal object ID of module
350              
351             =head3 description:
352              
353             This method is the opposite method of L<|C>, it returns
354             the name of the major source file for the given internal object ID
355             of a module.
356              
357             =head3 returns:
358              
359             The method returns the source name or an empty string if no
360             matching object was found.
361              
362             =cut
363              
364             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
365             sub object_name($$)
366             {
367 9     9 1 3383 my $this = shift;
368 9         15 my ($id) = @_;
369 9         20 my $name = $this->{objects}[$id];
370 9 100       25 return defined $name ? $name : '';
371             }
372              
373             #########################################################################
374              
375             =head2 file - get file name of source for a given ID combination
376              
377             $file_name = $line_info->file($object_id, $source_number, $relax);
378              
379             =head3 example:
380              
381             $file_name = $line_info->file(0, 0);
382             $file_name = $line_info->file(0, 0, 1); # Dwarf-4
383              
384             =head3 parameters:
385              
386             $object_id internal object ID of module
387             $source_number number of the source
388             $relax optional flag to enable fallback code for object ID
389              
390             =head3 description:
391              
392             This method returns the file name (without directory) of the
393             source file number C<$source_number> for the given internal object
394             ID of a module. The source number is a positive integer. 1 is
395             the number of the major source file, all others are usually
396             include files. Note that 0 is not used!
397              
398             Newer Dwarf versions don't seem to use different tables for
399             different object IDs and put all sources into one table. The
400             optional flag C<$relax> tells the method to use this one table in
401             those cases.
402              
403             =head3 returns:
404              
405             The method returns the source name or an empty string if no
406             matching source was found in the object.
407              
408             =cut
409              
410             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
411             sub file($$$;$)
412             {
413 22     22 1 4135 my $this = shift;
414 22         35 my ($id, $source, $relax) = @_;
415             # TODO: compilation unit and ID seem to be totally different
416             # things and I've never seen 2 file name tables in Dwarf-4 so far:
417 22         47 my $table = $this->{file_names}[$id];
418 22 100 100     66 if (not defined $table and $relax)
419 4         7 { $table = $this->{file_names}[0]; }
420 22 100 66     102 return '' unless defined $table and ref($table) eq 'ARRAY';
421 21         30 my $name = $table->[$source];
422 21 100       94 return defined $name ? $name : '';
423             }
424              
425             #########################################################################
426              
427             =head2 files - list of all source file names for a given object ID
428              
429             @file_names = $line_info->files($object_id);
430             $file_count = $line_info->files($object_id);
431              
432             =head3 example:
433              
434             @file_names = $line_info->files(1);
435             $number_of_files = $line_info->files($object_id);
436              
437             =head3 parameters:
438              
439             $object_id internal object ID of module
440              
441             =head3 description:
442              
443             In list context this method returns a list of all file names
444             (without directory parts) for the given internal object ID of a
445             module. In scalar context it returns how many elements this list
446             would have. As number 1 is the first source number actually used
447             in the internal representation of the list the number returned in
448             scalar context is also the last number you can pass to the
449             L<|C> method described above that returns a valid name (a
450             non empty string). Note also that the empty element 0 is not part
451             of the list returned in list context.
452              
453             =head3 returns:
454              
455             The method returns the list / the count as described above or an
456             empty list / 0 if an unused or invalid object id was given.
457              
458             =cut
459              
460             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
461             sub files($$)
462             {
463 4     4 1 1240 my $this = shift;
464 4         9 my ($id) = @_;
465 4         6 my $table = $this->{file_names}[$id];
466 4 100       16 return wantarray ? () : 0 unless defined $table;
    100          
467 2 100       5 if (wantarray)
468             {
469 1         2 return @{$table}[1..$#{$table}];
  1         5  
  1         3  
470             }
471 1         2 return $#{$table};
  1         3  
472             }
473              
474             #########################################################################
475              
476             =head2 directory - get directory name of source for a given ID combination
477              
478             $directory = $line_info->directory($object_id, $source_number);
479              
480             =head3 example:
481              
482             $directory = $line_info->directory(0, 0);
483              
484             =head3 parameters:
485              
486             $object_id internal object ID of module
487             $source_number number of the source
488              
489             =head3 description:
490              
491             This method returns the directory part of the file name of the
492             source file number C<$source_number> for the given internal object
493             ID of a module. The source number is a positive integer. 1 is
494             the number of the major source file, all others are usually
495             include files. Note that 0 is not used!
496              
497             =head3 returns:
498              
499             The method returns the directory name or an empty string if no
500             matching source was found in the object.
501              
502             =cut
503              
504             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
505             sub directory($$$)
506             {
507 6     6 1 10 my $this = shift;
508 6         11 my ($id, $source) = @_;
509 6         8 my $table = $this->{directories}[$id];
510 6 100 66     34 return '' unless defined $table and ref($table) eq 'ARRAY';
511 5         6 my $name = $table->[$source];
512 5 100       30 return defined $name ? $name : '';
513             }
514              
515             #########################################################################
516              
517             =head2 directories - list of all directory names for a given object ID
518              
519             @directories = $line_info->directories($object_id);
520             $dir_count = $line_info->directories($object_id);
521              
522             =head3 example:
523              
524             @directories = $line_info->directories(1);
525             $number_of_dirs = $line_info->directories($object_id);
526              
527             =head3 parameters:
528              
529             $object_id internal object ID of module
530              
531             =head3 description:
532              
533             In list context this method returns a list of the directory parts
534             of all file names for the given internal object ID of a module.
535             As usually several used include files are found in the same
536             directory this list normally will contain duplictes. Those are NOT
537             eliminated. In scalar context it returns how many elements this
538             list would have. As number 1 is the first source number actually
539             used in the internal representation of the list the number
540             returned in scalar context is also the last number you can pass to
541             the L<|C> method described above that returns a valid
542             name (a non empty string). Note also that the empty element 0 is
543             not part of the list returned in list context.
544              
545             =head3 returns:
546              
547             The method returns the list / the count as described above or an
548             empty list / 0 if an unused or invalid object id was given.
549              
550             =cut
551              
552             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
553             sub directories($$)
554             {
555 4     4 1 1410 my $this = shift;
556 4         7 my ($id) = @_;
557 4         6 my $table = $this->{directories}[$id];
558 4 100       16 return wantarray ? () : 0 unless defined $table;
    100          
559 2 100       6 if (wantarray)
560             {
561 1         2 return @{$table}[1..$#{$table}];
  1         5  
  1         2  
562             }
563 1         1 return $#{$table};
  1         3  
564             }
565              
566             #########################################################################
567              
568             =head2 path - get path to source file for a given ID combination
569              
570             $file_path = $line_info->path($object_id, $source_number);
571              
572             =head3 example:
573              
574             $file_path = $line_info->path(0, 0);
575              
576             =head3 parameters:
577              
578             $object_id internal object ID of module
579             $source_number number of the source
580              
581             =head3 description:
582              
583             This method returns the path (directory plus file name) of the
584             source file number C<$source_number> for the given internal object
585             ID of a module. The source number is a positive integer. 1 is
586             the number of the major source file, all others are usually
587             include files. Note that 0 is not used!
588              
589             =head3 returns:
590              
591             The method returns the source name or an empty string if no
592             matching source was found in the object.
593              
594             =cut
595              
596             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
597             sub path($$$)
598             {
599 6     6 1 9 my $this = shift;
600 6         12 my ($id, $source) = @_;
601 6         8 my $table = $this->{file_names}[$id];
602 6 100 66     37 return '' unless defined $table and ref($table) eq 'ARRAY';
603 5         7 my $name = $table->[$source];
604 5 100       16 return '' unless defined $name;
605 3         9 $table = $this->{directories}[$id];
606 3 50 33     17 confess 'internal error: inconsistent table data for (',
607             $id, ',', $source, ') in ', __PACKAGE__, '::path'
608             unless defined $table and ref($table) eq 'ARRAY'; # 1)
609 3         5 my $name2 = $table->[$source];
610 3 50       5 confess 'internal error: inconsistent name data for (',
611             $id, ',', $source, ') in ', __PACKAGE__, '::path'
612             unless defined $name2; # 1)
613 3         18 return $name2.'/'.$name;
614             }
615              
616             #########################################################################
617              
618             =head2 paths - list of paths to all sources for a given object ID
619              
620             @paths = $line_info->paths($object_id);
621             $path_count = $line_info->paths($object_id);
622              
623             =head3 example:
624              
625             @paths = $line_info->paths(1);
626             $number_of_paths = $line_info->paths($object_id);
627              
628             =head3 parameters:
629              
630             $object_id internal object ID of module
631              
632             =head3 description:
633              
634             In list context this method returns a list of all paths (directory
635             plus file name) for the given internal object ID of a module. In
636             scalar context it returns how many elements this list would have.
637             As number 1 is the first source number actually used in the
638             internal representation of the list the number returned in scalar
639             context is also the last number you can pass to the L<|C>
640             method described above that returns a valid name (a non empty
641             string). Note also that the empty element 0 is not part of the
642             list returned in list context.
643              
644             =head3 returns:
645              
646             The method returns the list / the count as described above or an
647             empty list / 0 if an unused or invalid object id was given.
648              
649             =cut
650              
651             # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
652             sub paths($$)
653             {
654 4     4 1 1453 my $this = shift;
655 4         6 my ($id) = @_;
656 4         8 my $dir_table = $this->{directories}[$id];
657 4         6 my $file_table = $this->{file_names}[$id];
658 4 100 66     21 unless (defined $dir_table and defined $file_table)
659             {
660 2 50 33     10 confess 'internal error: inconsistent table data for (',
661             $id, ') in ', __PACKAGE__, '::paths'
662             if defined $dir_table or defined $file_table;
663 2 100       7 return wantarray ? () : 0;
664             }
665 2 50 33     14 confess 'internal error: inconsistent table structure for (',
666             $id, ') in ', __PACKAGE__, '::paths'
667             unless (ref($dir_table) eq 'ARRAY' and
668             ref($file_table) eq 'ARRAY');
669 2         5 confess 'internal error: inconsistent name data for (',
670             $id, ') in ', __PACKAGE__, '::paths'
671 2 50       3 unless $#{$dir_table} == $#{$file_table};
  2         5  
672 2 100       6 return $#{$dir_table} unless wantarray();
  1         5  
673             return
674 1         5 map { $dir_table->[$_] . '/' . $file_table->[$_] }
  1         3  
675 1         1 (1..$#{$dir_table});
676             }
677              
678             1;
679              
680             #########################################################################
681              
682             __END__