/usr/share/perl5/Test/Inline/Util.pm is in libtest-inline-perl 2.213-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | # This is an inlined version of the private Phase N module File::DirUtils,
# approved for use only in its inline state as Test::Inline::Util.
# It will be released to CPAN at some later time, once complete.
# We ask that until that time you respect our development process and
# do not use this code.
package Test::Inline::Util;
use strict;
use File::Spec::Functions ':ALL';
use vars qw{$VERSION};
BEGIN {
$VERSION = '2.213';
}
sub shorten {
my $class = ref $_[0] ? ref shift : shift;
my $path = (defined $_[0] and length $_[0])
? canonpath( shift )
: return shift;
my @parts = splitdir( $path );
my $i = 0;
while ( defined $parts[++$i] ) {
next unless $i;
next unless $parts[$i] eq updir();
next if $parts[$i - 1] eq updir();
splice @parts, $i - 1, 2;
$i -= 2;
}
catdir( @parts );
}
sub parts {
my $class = ref $_[0] ? ref shift : shift;
my $path = $class->shorten(shift);
$path = '' if $path eq curdir();
scalar splitdir($path);
}
sub inverse {
my $class = ref $_[0] ? ref shift : shift;
my $path = $class->shorten( shift );
if ( ! defined $path or $path eq '' or $path eq curdir() ) {
return $path;
}
return undef if file_name_is_absolute( $path );
my @parts = splitdir( $path );
return undef if $parts[0] eq updir();
catdir( (updir()) x scalar @parts );
}
sub commonise {
my $class = ref $_[0] ? ref shift : shift;
my $first = $class->shorten( shift );
my $second = $class->shorten( shift );
return undef unless defined $first;
return undef unless defined $second;
my @first = splitdir( $first );
my @second = splitdir( $second );
my @base = ();
while ( defined $first[0] and defined $second[0] and $first[0] eq $second[0] ) {
push @base, $first[0];
shift @first;
shift @second;
}
[ catdir(@base), catdir(@first), catdir(@second) ];
}
sub relative {
my $class = ref $_[0] ? ref shift : shift;
my $commonised = $class->commonise( @_ ) or return undef;
my $from = $class->inverse( $commonised->[1] );
return undef unless defined $from;
my $to = $commonised->[2];
if ( $from eq '' and $to eq '' ) {
return '';
}
catdir( grep { length $_ } ($from, $to) );
}
1;
|