#!/usr/local/bin/perl
$VERSION = '0.01';
use warnings; use strict;
use Data::Dumper;
$Data::Dumper::Useqq = 1;
$Data::Dumper::Indent = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Terse = 0;
$Data::Dumper::Purity = $Data::Dumper::Deepcopy = 1;
$Data::Dumper::Deparse = 1;
use Getopt::Long;
my %opt =
(
'ports-data' => q{/var/db/pkg}
, 'file-list' => '+CONTENTS'
, 'ports' => []
, 'libs' => []
);
GetOptions
(
'd|dir|ports-data=s' => \$opt{'ports-data'}
, 'p|ports=s@' => $opt{'ports'}
, 'l|libs=s@' => $opt{'libs'}
)
or die;
# Search for files for ALL the installed ports.
push @{ $opt{'ports'} } , '.' unless scalar @{ $opt{'ports'} };
push @{ $opt{'libs'} } , @ARGV if scalar @ARGV;
my $possibly_linked =
get_files
(
{
'list-maker' => [ qw{ pkg_info -L } ]
, 'ports' => find_ports( $opt{'ports'} )
, 'keep' =>
qr{ (?: /(?: s?bin | libexec ) / .+ | /perl\d+/.+?[^/]+\.so )$
+ }x
}
);
my $linked =
find_libs
(
{
'libs-lister' => q{ldd}
, 'ports' => $possibly_linked
, 'keep' => ( map qr{$_}i , join '|' , @{ $opt{'libs'} } )[0]
}
);
print Dumper( $linked );
exit;
sub find_libs
{
my ( $find ) = @_;
my %linked;
my $parse = qr{^ \s* lib[-.,_a-zA-Z0-9]+ \s+ => \s+ .+ };
foreach my $port ( keys %{ $find->{'ports'} } )
{
foreach my $file ( @{ $find->{'ports'}->{ $port } } )
{
# Stringification is needed to send ldd(1) errors to /dev/null;
+ otherwise
# "2>/dev/null: No such file or directory" error message is pro
+duced by
# ldd(1).
my $cmd =
join ' ' , $find->{'libs-lister'} , $file , '2>/dev/null';
open my $ph , '-|' , $cmd or die "Cannot open pipe: $!";
my $skip = quotemeta $file;
$skip = qr{^$skip:};
while ( my $line = <$ph> )
{
next unless $line =~ m/$find->{'keep'}/;
next if $line =~ m/$skip/;
$line =~ s/^\s+//;
chomp $line;
push @{ $linked{ $port }->{ $file } } , $line
}
}
}
return { %linked };
}
sub get_files
{
my ( $find ) = @_;
my %files;
foreach my $p ( @{ $find->{'ports'} } )
{
open my $ph , '-|' , @{ $find->{'list-maker'} } , $p
or die "Cannot open pipe: $!";
while ( my $file = <$ph> )
{
next unless $file =~ m/$find->{'keep'}/ ;
chomp $file;
push @{ $files{ $p } } , $file ;
}
}
return { %files };
}
sub find_ports
{
my ( $re ) = @_;
($re) = map qr{$_}i, join '|' , @{ $re };
my ($dh , $close ) = open_dir( $opt{'ports-data'} );
my @ports;
while ( my $port = readdir $dh )
{
next unless $port =~ m/$re/;
my $path = join '/' , $opt{'ports-data'} , $port;
next
unless -d $path
&& -f join '/' , $path , $opt{'file-list'}
;
push @ports , $port;
}
$close->();
chomp @ports;
return [ sort @ports ];
}
sub open_dir
{
my ( $dir ) = @_;
opendir my $dh , $dir or die "Cannot open $dir: $!";
return ( $dh , sub { closedir $dh or die "Cannot close $dir: $!"; }
+);
}
Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
Read Where should I post X? if you're not absolutely sure you're posting in the right place.
Please read these before you post! —
Posts may use any of the Perl Monks Approved HTML tags:
- a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
| |
For: |
|
Use: |
| & | | & |
| < | | < |
| > | | > |
| [ | | [ |
| ] | | ] |
Link using PerlMonks shortcuts! What shortcuts can I use for linking?
See Writeup Formatting Tips and other pages linked from there for more info.