/usr/lib/perl5/Devel/Cover/Util.pm is in libdevel-cover-perl 1.08-1ubuntu2.
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 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | # Copyright 2001-2013, Paul Johnson (paul@pjcj.net)
# This software is free. It is licensed under the same terms as Perl itself.
# The latest version of this software should be available from my homepage:
# http://www.pjcj.net
package Devel::Cover::Util;
use strict;
use warnings;
our $VERSION = '1.08'; # VERSION
use Cwd 'abs_path';
use File::Spec;
use base 'Exporter';
our @EXPORT_OK = qw( remove_contained_paths );
sub remove_contained_paths {
my ( $container, @paths ) = @_;
# File::Spec's case tolerancy detection on *nix/Mac systems does not
# take actual file system properties into account, but is better than
# trying to normalize paths with per-os logic. On Windows it is
# properly determined per drive.
my ( $drive ) = File::Spec->splitpath( $container );
my $ignore_case = '(?i)';
$ignore_case = '' if !File::Spec->case_tolerant( $drive );
my $regex = qr@
$ignore_case # ignore case on tolerant filesystems
^ # string to match starts with:
\Q$container\E # path, meta-quoted for safety
($|/) # followed by either the end of the string, or another
# slash, to avoid removing paths in directories named
# similar to the container
@x;
@paths = grep {
my $path = abs_path $_; # normalize backslashes
$path !~ $regex; # check if path is inside the container
} @paths;
return @paths;
}
1
__END__
=head1 NAME
Devel::Cover::Util - Utility subroutines for Devel::Cover
=head1 VERSION
version 1.08
=head1 SYNOPSIS
use Devel::Cover::Util "remove_contained_paths";
=head1 DESCRIPTION
This module utility subroutines for Devel::Cover.
=head1 SUBROUTINES
=head2 remove_contained_paths
@Inc = remove_contained_paths(getcwd, @Inc);
Remove certain paths from a list of paths.
=head1 BUGS
Huh?
=head1 LICENCE
Copyright 2001-2013, Paul Johnson (paul@pjcj.net)
This software is free. It is licensed under the same terms as Perl itself.
The latest version of this software should be available from my homepage:
http://www.pjcj.net
=cut
|