File Coverage

lib/Devel/SharedLibs.pm

Criterion	Covered	Total	%
statement	12	13	92.3
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	17	18	94.4

########################################################################
# housekeeping
########################################################################

package Devel::SharedLibs;
use v5.22;
use autodie qw( open close );

use IO::File;

use List::MoreUtils qw( uniq );

########################################################################
# package variables
########################################################################

our $VERSION = 'v0.3.1';
$VERSION    = eval "$VERSION";

sub import
{
    # all this does it localize $path for the END closure.
    # kwikhak for the moment until I find out if there is
    # any decent way to deal with ldd on BSD.

    my ( undef, $path ) = @_;

    END
    {
        $ENV{ DEVEL_SHAREDLIBS_PRINT }
        or return;

        $path   ||= $ENV{ DEVEL_SHAREDLIBS_PATH };

        # avoid stale output.

        if( $path && -e $path )
        {
            unlink $path
            or do
            {
                say STDERR
                "Failed unlink: '$path', aborting";
                exit -1;
            };
        }

        qx{ ldd --version };

        if( $? )
        {
            say STDERR
            "Non-zeo exit: ldd --version ($?), no ouptut produced.";

            exit $?
        }

        local $,    = "\n";
        local $\    = "\n";

        my $fh
        = $path
        ? IO::File->new( $path, 'w' )
        : *STDOUT{ IO }
        ;

        print $fh
        "# ldd '$^X', '$0'" =>
        uniq
        sort
        map
        {
            # the literal '=>' dodges linux-vdso & friends,
            # which lack a path and also the
            # "not a dynamic executable" messages from
            # most of the contents.

            my ( $lib ) = m{ => \s+ (\S+) }x;

            $lib || ()
        }
        map
        {
            split "\n" => qx(ldd $_ 2>/dev/null )
        }
        (
            $^X,
            values %INC
        );

        close $fh;

        say STDERR "SharedLibs output: '$path'";
    }
}

# keep require happy
1
__END__