File Coverage

blib/lib/Parse/nm.pm

Criterion	Covered	Total	%
statement	60	63	95.2
branch	16	22	72.7
condition	6	7	85.7
subroutine	9	9	100.0
pod	3	3	100.0
total	94	104	90.3

use strict;
use warnings;

package Parse::nm;

our $VERSION = '0.09';

use Carp 'croak';
use Regexp::Assemble;
use String::ShellQuote;

sub new
{
    my ($class, %args) = @_;
    _build_filters(\%args);
    return bless \%args, (ref $class ? ref $class : $class);
}

sub _build_filters
{
    my ($args) = @_;

    if (exists $args->{_comp_filters} && @{$args->{_comp_filters}}) {
	# Copy data to preserve $self
	$args->{_comp_filters} = [ @{$args->{_comp_filters}} ];
	$args->{_re} = $args->{_re}->clone;
    } else {
	$args->{_comp_filters} = [];
	$args->{_re} = Regexp::Assemble->new(fold_meta_pairs => 0);
    }

    if (exists $args->{filters}) {
        my @f = @{$args->{filters}};
        for my $f (@f) {
            my $name = $f->{name} || '\S+';
            my $type = $f->{type} || '[A-Z]';
            $args->{_re}->add("^$name +$type +");
            push @{$args->{_comp_filters}}, [
                qr/^($name) +($type) +/, $f->{action}
            ];
        }
	delete $args->{filters};
    }
}


sub run
{
    my ($self, %args) = @_;
    %args = (%{$self}, %args) if ref $self;

    my @options = exists $args{options} ? @{$args{options}} : ();
    my @files = ref $args{files} ? @{$args{files}} : ($args{files});

    my $nm;
    {
	# have to turn this on to get POSIX-ish output from nm -P on Irix
	local $ENV{_XPG} = '1' if ($^O eq 'irix');

	#open $nm, 'nm '.join(' ', map { my $x = $_; $x =~ s/"/\\"/g; qq{"$x"} } @files).' |'
	open $nm, '-|', shell_quote('nm', '-P', @options, @files)
	    or croak "Can't run 'nm': $!";
    }
    my $r = $self->parse($nm, %args);
    close $nm;
    return $r;
}


sub parse
{
    my ($self, $handle, %args) = @_;
    %args = (%{$self}, %args) if ref $self;
    _build_filters(\%args);
    my $re = $args{_re}->re;
    my $filters = $args{_comp_filters};
    while (<$handle>) {
        next unless /$re/;
        for my $f (@{$filters}) {
            if (/$f->[0]/) {
                $f->[1]($1, $2);
            }
        }
    }
    return ();
}

1;
__END__