use POSIX;
####
use POSIX qw< ceil floor >;
##
##
> exports
Usage: exports [-a] [ Perl::Module [...] ] [ file [...] ]
Writes out what each listed module by-default exports
or reports all uses of those exports in the listed files.
If no module names are listed, then searches each file for
cases of 'use Perl::Module;' and suggests replacements.
-a: Searches for *any* exports, not just default ones.
##
##
> grep POSIX ASAP/Client.pm
ASAP/Client.pm:use POSIX;
##
##
> exports POSIX ASAP/Client.pm
ASAP/Client.pm:
107: strftime("%Y-%m-%dT%T$fs Z", gmtime($sec));
strftime
# use POSIX qw< strftime >;
##
##
> exports bin/mktestcalls
bin/mktestcalls:
1197: openlog( 'mktestcalls', 'pid', 'local3' );
openlog
1204: GetOptions(\%opt,
GetOptions
1237: -H pretend to be hostname
hostname
1293: my $HOSTNAME = $opt{H} || hostname();
hostname
1590: out_server => hostname(),
hostname
2229: eval{ syslog( 'debug', $msg ) };
syslog
# use Asterisk::AGI(); # No default exports
# use Socket(); # Not used?
# use Sys::Hostname qw< hostname >;
# use Sys::Syslog qw< openlog syslog >;
# use Getopt::Long qw< GetOptions >;
##
##
> grep use bin/mktestcalls
use strict;
use Asterisk::AGI;
use List::Util 'shuffle';
use Socket;
use Sys::Hostname;
use Sys::Syslog;
use Sys::SigAction 'set_sig_handler';
use Getopt::Long;
##
##
> exports -a List::Util lib/Track.pm
lib/Track.pm:
1768: push @dial_servers, shuffle(@servers);
shuffle
1820: $maxto = max(
max
1821: min(
min
1867: # S() = max call duration in seconds
max
# use List::Util qw< max min shuffle >;
##
##
> exports File::Basename File::Glob
File::Basename 2.78:
fileparse
fileparse_set_fstype
basename
dirname
File::Glob 1.07:
##
##
> exports -a File::Basename File::Glob
File::Basename 2.78:
fileparse
fileparse_set_fstype
basename
dirname
File::Glob 1.07:
csh_glob
bsd_glob
glob
GLOB_ABEND
GLOB_ALPHASORT
GLOB_ALTDIRFUNC
GLOB_BRACE
GLOB_CSH
GLOB_ERR
GLOB_ERROR
GLOB_LIMIT
GLOB_MARK
GLOB_NOCASE
GLOB_NOCHECK
GLOB_NOMAGIC
GLOB_NOSORT
GLOB_NOSPACE
GLOB_QUOTE
GLOB_TILDE
##
##
> exports POSIX exports
exports:
121: or die "Can't rewind handle to $file: $!\n";
rewind
# use POSIX qw< rewind >;
##
##
> exports say
say:
# use Encode(); # Not used?
##
##
> grep Encode say
use Encode;
} elsif( Encode::is_utf8($_) ) {
##
##
#!/usr/bin/perl -w
use strict;
my $Any = 0; # If -a was given.
Main( @ARGV );
exit;
sub Usage {
warn @_, $/
if @_;
die "Usage: exports [-a] [ Perl::Module [...] ] [ file [...] ]\n",
" Writes out what each listed module by-default exports\n",
" or reports all uses of those exports in the listed files.\n",
" If no module names are listed, then searches each file for\n",
" cases of 'use Perl::Module;' and suggests replacements.\n",
" -a: Searches for *any* exports, not just default ones.\n",
;
}
sub IsModName {
local( $_ ) = @_;
return 2 # Looks like 'Foo::Bar'; assume module name.
if /::/ && ! /[^\w:]/;
return 1 # Just \w chars and not a file; perhaps a module name.
if ! /\W/ && ! -e;
# Contains a non-module character (like '.') or is a file; assume file name:
return 0;
}
sub ParseArgs {
my( $mods_av, $files_av, @args ) = @_;
Usage()
if ! @args;
while( @args ) {
last
if $args[0] !~ /^--?[^-]/;
local $_ = shift @args;
if( /^-a/ ) {
$Any = 1;
} else {
Usage( "Unrecognized option: $_" );
}
}
shift @args
if '--' eq $args[0];
while( @args ) {
last
if ! IsModName( $args[0] );
push @$mods_av, shift @args;
}
while( @args ) {
my $isMod = IsModName( $args[0] );
die sprintf "Put all module names (%s) before all file names (%s)\n",
$args[0], $files_av->[-1]
if 2 == $isMod;
if( '-' ne $args[0] ) {
my $isFile = -e $args[0];
die "Can't find file ($args[0]): $!\n"
if ! defined $isFile;
die "Not a file: $args[0]\n"
if ! $isFile || -d _;
}
push @$files_av, shift @args;
}
}
# Returns the list of symbols exported by the given module:
sub GetExports {
my( $package ) = @_;
eval { $package->import() }; # POSIX doesn't populate @EXPORT early
my @exports = do {
no strict 'refs';
@{ "${package}::EXPORT" }
};
if( $Any ) {
no strict 'refs';
push @exports, @{ "${package}::EXPORT_OK" };
}
s/^&//
for @exports; # '&foo' and 'foo' are the same to Exporter.pm
my %seen;
@exports = grep ! $seen{$_}++, @exports; # Remove duplicates
return @exports;
}
sub PrintExports {
my( $mod ) = @_;
my @exports = GetExports( $mod );
my $pref = '';
# if( -t STDOUT ) {
my $version = $mod->VERSION();
if( $version ) {
print "$mod $version:\n";
} else {
print "$mod:\n";
}
$pref = ' ';
# }
print "$pref$_\n"
for @exports;
}
sub SearchFile {
my( $file, @mods ) = @_;
my $fh;
if( '-' eq $file ) {
$fh = \*STDIN;
} else {
open $fh, '<', $file
or die "Can't read $file: $!\n";
}
@mods = LoadModules( FindUsedModules( $fh ) )
if ! @mods;
if( ! @mods ) {
my $default = $Any ? '' : ' default';
print "No$default imports: $file\n";
return;
}
$. = 0;
seek $fh, 0, 0
or die "Can't rewind handle to $file: $!\n";
print "$file:\n";
ReportExportUse( $fh, @mods );
}
sub MatchWords {
my( @exports ) = @_;
my @res;
for( @exports ) {
if( s/^\$// ) {
push @res, '\$' . "\Q$_" . '(?![\[\{\w])';
} elsif( s/^\%// ) {
push @res, '%' . "\Q$_" . '\b';
push @res, '\$' . "\Q$_" . '\{';
} elsif( s/^@// ) {
push @res, '\@' . "\Q$_" . '\b';
push @res, '\$' . "\Q$_" . '\[';
} else {
push @res, '(? ) {
my $underline = '';
my $line = $_;
if( $inuse ) {
next
if ! s/^([^;]*;)/ ' ' x length($1) /e;
$inuse = 0;
} elsif( $Any ) {
$inuse = 1
if s/^(\s*use\s+[\w:]+[^;]*(;?))/ ' ' x length($1) /e
&& ! $2;
}
while( /$match/g ) {
my( $start, $end ) = ( $-[0], $+[0] );
my $export = substr( $_, $start, $end - $start );
s/\$(.*)\[$/\@$1/,
s/\$(.*)\{$/\%$1/,
for $export;
my $len = length($export);
$underline .= ' ' x ( $start - length($underline) );
$underline .= $export;
my $mod = $export_mod{$export};
if( $mod ) {
$mod_export{$mod}{$export}++;
} else {
warn "Can't find module that exports '$export'\n";
}
}
printf "%6d: %s%8s%s\n", $., $line, '', $underline
if $underline;
}
}
for my $mod ( @mods ) {
my @used = sort keys %{ $mod_export{$mod} };
if( @used ) {
Print( "# use $mod\tqw< @used >;\n" );
} elsif( $export_mod{''}{$mod} ) {
my $default = $Any ? '' : ' default';
Print( "# use $mod();\t# No$default exports\n" );
} else {
Print( "# use $mod();\t# Not used?\n" );
}
my $hv = $conflict{$mod};
for my $prev ( keys %$hv ) {
my @e = sort grep {
$mod_export{$prev}{$_}
} keys %{ $hv->{$prev} };
print "# Also (see $prev): @e\n"
if @e;
}
}
}
# Expands tab characters ("\t"s) then prints:
sub Print {
my @strings = @_;
my $pos = 0;
for( @strings ) {
my $plus = 0;
s{\t}{
my $total = $pos + $plus + pos() - 1;
my $pad = 9 - $total % 8;
$pad += 8
if $total < 16;
$pad += 8
if $total < 8;
$plus += $pad - 1;
' ' x $pad
}gex;
$pos += length;
}
print @strings;
}
# Note duplicate exports and assign each export to only one module:
sub GroupExports {
my( $exports_av, $export_mod_hv, $conflict_hv, @mods ) = @_;
for my $mod ( @mods ) {
my @e = GetExports( $mod );
if( ! @e ) {
$export_mod_hv->{''}{$mod} = 1;
next;
}
for my $export ( @e ) {
my $prev = $export_mod_hv->{$export};
if( $prev ) {
$conflict_hv->{$mod}{$prev}{$export} = 1;
} else {
push @$exports_av, $export;
$export_mod_hv->{$export} = $mod;
}
}
}
}
# Find used modules, either all or just those with no arguments given:
sub FindUsedModules {
my( $fh ) = @_;
my @mods;
local $_;
while( <$fh> ) {
if( /^\s*use\s+([\w:]+)\s*;/
|| $Any && /^\s*use\s+([\w:]+)\b/
) {
push @mods, $1
if 'strict' ne $1;
}
}
return @mods;
}
# Returns names of modules successfully loaded ("require"d):
sub LoadModules {
return grep {
( my $file = $_ ) =~ s-::-/-g;
$file .= ".pm";
if( ! eval { local $_; require $file; 1 } ) {
# ... trim error message ...
warn "$_: $@\n";
0 # Ignore further work for this module
} else {
1 # Keep this module for further work
}
} @_;
}
sub Main {
my( @args ) = @_;
ParseArgs( \my( @mods, @files ), @args );
exit 1
if @mods != LoadModules( @mods ); # If some modules not found.
if( ! @files ) { # Just list each module and its exports:
PrintExports( $_ )
for @mods;
} else { # Search file(s) for uses of exports:
for my $file ( @files ) {
SearchFile( $file, @mods );
}
}
}