The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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__

=head1 NAME

Parse::nm - Run and parse 'nm' command output with filter callbacks

=head1 SYNOPSIS

Class interface:

    use Parse::nm;

    Parse::nm->run(options => [ qw(-e) ],
                   filters => [
                     {
                       name => qr/\.\w+/,
                       type => 'T',
                       action => sub {
                         print "$_[0]\n"
                       }
                     },
                   ],
                   files => 't.o',
                );

Object interface:

    use Parse::nm;

    my $pnm = Parse::nm->new(options => ...,
                             filters => ...);
    $pnm->run(files => 'file1.o');
    $pnm->run(files => 'file2.o');

    $str = "TestFunc T 0 0 \n";
    $pnm->parse(\$str);

=head1 METHODS

=head2 ->new(%options)

Builds an object with the default options.

=head2 ->parse(*GLOB, %options)

Parse 'nm -P'-style data coming from a filehandle.

Note that if your Perl is compiled with PerlIO (this is the default since
5.8.0), you can easily parse a string by opening a string reference to it.

    open($fh, '<', \$str);
    Parse::nm->parse($fh, %options);

=head2 ->run(%options)

Run C<nm> and parse its output.

=head1 OPTIONS

=over 4

=item options => [ ]

Command-line options given to C<nm> to run it.
The C<-P> (POSIX-style output) is always given.
C<-A> (show input file) is currently incompatible.

=item files => [ ]

List of files to give to C<nm> for parsing.

=item filters => \@filters

=over 4

=item name => qr/\S+/

A regexp that must match the name of the symbol.

Don't use C<^> or C<$>: this is not supported.

=item type => qr/[A-Z]/

A regexp that must match the type of the symbol. Types are single ASCII letter.
See the C<nm> man page of your operating system for more information.

Don't use C<^> or C<$>: this is not supported.

=item action => sub { ... }

A callback that will be triggered for each line where both C<name> and C<type>
match.

=back

=back

=head1 SEE ALSO

L<http://www.opengroup.org/onlinepubs/009695399/utilities/nm.html>

L<Binutils::Objdump>

=head1 PLATFORM SUPPORT

=over 4

=item POSIX systems

OK.

=item StrawberryPerl (Windows)

Work in progress (patches welcome).

=item OpenBSD

Parse::nm can not work on OpenBSD (at least up to 4.6) because 'nm' doesn't
have a POSIX-compatible mode.

L<http://www.openbsd.org/cgi-bin/man.cgi?query=nm&apropos=0&sektion=0&manpath=OpenBSD+4.6&arch=i386&format=html#STANDARDS>

=back

=head1 AUTHOR

Olivier MenguE<eacute>, C<dolmen@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright E<copy> 2010-2011 Olivier MenguE<eacute>.

This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself, either Perl version 5.12.0 or, at your option,
any later version of Perl 5 you may have available.

=cut