/usr/share/perl5/Makefile/AST/StemMatch.pm is in libmakefile-parser-perl 0.215-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 74 75 76 77 | package Makefile::AST::StemMatch;
use strict;
use warnings;
use base 'Class::Accessor::Fast';
__PACKAGE__->mk_ro_accessors(qw{
pattern target stem dir notdir
});
sub _split_path ($) {
my ($path) = @_;
my ($dir, $notdir);
if ($path =~ m{.*/}) {
$dir = $&;
$notdir = $';
} else {
$dir = '';
$notdir = $path;
}
return ($dir, $notdir);
}
sub _pat2re ($@) {
my ($pat, $capture) = @_;
$pat = quotemeta $pat;
if ($capture) {
$pat =~ s/\\\%/(\\S*)/;
} else {
$pat =~ s/\\\%/\\S*/;
}
$pat;
}
sub new ($$) {
my $class = ref $_[0] ? ref shift : shift;
my $opts = shift;
my $pattern = $opts->{pattern};
my $target = $opts->{target};
my ($dir, $notdir) = _split_path($target);
my $re = _pat2re($pattern, 1);
my $stem;
if ($pattern =~ m{/}) {
if ($target =~ $re) {
$stem = $1;
}
} else {
if ($notdir =~ $re) {
$stem = $1;
}
}
if (defined $stem) {
return $class->SUPER::new(
{
pattern => $pattern,
target => $target,
stem => $stem,
dir => $dir,
notdir => $notdir,
}
);
} else {
return undef;
}
}
sub subs_stem ($$) {
my ($self, $other_pat) = @_;
my $stem = $self->stem;
$other_pat =~ s/\%/$stem/;
if ($self->pattern !~ m{/}) {
$other_pat = $self->dir . $other_pat;
}
return $other_pat;
}
1;
|