32 |
# http://www.steve.org.uk/ |
# http://www.steve.org.uk/ |
33 |
# |
# |
34 |
# |
# |
35 |
|
|
36 |
|
|
37 |
use strict; |
use strict; |
38 |
|
|
39 |
|
|
40 |
# |
# |
41 |
# We want to prefer a short directory, such as |
# Only examine directories beneath /usr |
|
# /usr/lib/perl5/ |
|
42 |
# |
# |
43 |
my $shortest = undef; |
my @dirs = grep( /^\/usr/, @INC ); |
44 |
|
|
45 |
|
|
46 |
# |
# |
47 |
# Process all the builtin directories. |
# Find the shortest one. |
48 |
# |
# |
49 |
foreach my $dir ( sort( @INC ) ) |
@dirs = sort { length( $a ) <=> length( $ b ) } @dirs ; |
50 |
{ |
|
|
next if ( $dir eq "." ); |
|
|
next if (! $dir =~ /usr/ ); |
|
|
|
|
|
if ( defined( $shortest ) ) |
|
|
{ |
|
|
if ( length( $dir ) lt length( $shortest ) ) |
|
|
{ |
|
|
$shortest = $dir; |
|
|
} |
|
|
} |
|
|
else |
|
|
{ |
|
|
$shortest = $dir; |
|
|
} |
|
|
} |
|
51 |
|
|
52 |
# |
# |
53 |
# Strip trailing '/' if present. |
# Print it out - stripping the trailing '/' if present |
54 |
# |
# |
55 |
if ( $shortest =~ /(.*)\/$/ ) |
if ( $dirs[0] =~ /(.*)\/$/ ) { |
56 |
{ |
$dirs[0] = $1; |
|
$shortest = $1; |
|
57 |
} |
} |
58 |
|
|
59 |
# |
print $dirs[0]; |
|
# All done. |
|
|
# |
|
|
print $shortest; |
|