/usr/share/perl5/PAR/Filter/PatchContent.pm is in libpar-packer-perl 1.012-1.
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 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | package PAR::Filter::PatchContent;
use 5.006;
use strict;
use warnings;
use base 'PAR::Filter';
=head1 NAME
PAR::Filter::PatchContent - Content patcher
=head1 SYNOPSIS
# transforms $code
PAR::Filter::PatchContent->apply(\$code, $filename, $name);
=head1 DESCRIPTION
This filter fixes PAR-incompatible modules; F<pp> applies it to modules
by default.
=cut
sub PATCH_CONTENT () { +{
map { ref($_) ? $_ : lc($_) }
'AutoLoader.pm' => [
'$is_dosish = ' =>
'$is_dosish = $^O eq \'cygwin\' || ',
],
'Pod/Usage.pm' => [
' = $0' =>
' = $ENV{PAR_0} || $0',
],
# Some versions of Spreadsheet::ParseExcel have a weird non-POD construct =cmmt
# that is used to comment out a block of code. perl treats it as POD and strips it.
# Since it's not POD, POD parsers ignore it.
# PAR::Filter::PodStrip only strips valid POD. Hence we remove it here.
'Spreadsheet/ParseExcel.pm' => [
qr/^=cmmt\s+.*?^=cut\s*/sm =>
'',
],
'SQL/Parser.pm' => [
'my @dialects;' =>
'require PAR;
my @dialects = ();
foreach my $member ( $PAR::LastAccessedPAR->members ) {
next unless $member->fileName =~ m!\bSQL/Dialects/([^/]+)\.pm$!;
push @dialects, $1;
}
',
],
'Tk.pm' => [
'foreach $dir (@INC)' =>
'require PAR;
if (my $member = PAR::unpar($0, $file, 1)) {
$file =~ s![/\\\\]!_!g;
return PAR::Heavy::_dl_extract($member,$file,$file);
}
if (my $member = PAR::unpar($0, my $name = $_[1], 1)) {
$name =~ s![/\\\\]!_!g;
return PAR::Heavy::_dl_extract($member,$name,$name);
}
foreach $dir (@INC)',
],
'Tk/Widget.pm' => [
'if (defined($name=$INC{"$pkg.pm"}))' =>
'if (defined($name=$INC{"$pkg.pm"}) and !ref($name) and $name !~ m!^/loader/!)',
],
'Win32/API/Type.pm' => [
'INIT ' => '',
],
'Win32/SystemInfo.pm' => [
'$dll .= "cpuspd.dll";' =>
'require PAR;
$dll = "lib/Win32/cpuspd.dll";
if (my $member = PAR::unpar($0, $dll, 1)) {
$dll = PAR::Heavy::_dl_extract($member,"cpuspd.dll","cpuspd.dll");
$dll =~ s!\\\\!/!g;
} else { die $! }',
],
'XSLoader.pm' => [
'goto retry unless $module and defined &dl_load_file;' =>
'goto retry;', # XSLoader <= 0.10
'goto \&XSLoader::bootstrap_inherit unless $module and defined &dl_load_file;' =>
'goto \&XSLoader::bootstrap_inherit;', # XSLoader >= 0.14
],
'diagnostics.pm' => [
'CONFIG: ' => 'CONFIG: if (0) ',
'if (eof(POD_DIAG)) ' => 'if (0 and eof(POD_DIAG)) ',
'close POD_DIAG' => '# close POD_DIAG',
'while (<POD_DIAG>) ' =>
'require PAR; use Config;
my @files = (
"lib/pod/perldiag.pod",
"lib/Pod/perldiag.pod",
"lib/pod/perldiag-$Config{version}.pod",
"lib/Pod/perldiag-$Config{version}.pod",
"lib/pods/perldiag.pod",
"lib/pods/perldiag-$Config{version}.pod",
);
my $contents;
foreach my $file (@files) {
$contents = PAR::read_file($file);
last if defined $contents;
}
for(map "$_\\n\\n", split/(?:\\r?\\n){2,}/, $contents) ',
],
'utf8_heavy.pl' => [
'$list ||= eval { $caller->$type(); }'
=> '$list = eval { $caller->$type(); }',
'|| croak("Can\'t find $encoding character property definition via $caller->$type or $file.pl")'
=> '|| croak("Can\'t find $encoding character property definition via $caller->$type or $file.pl") unless $list;'
],
} };
sub apply {
my ($class, $ref, $filename, $name) = @_;
{ use bytes; $$ref =~ s/^\xEF\xBB\xBF//; } # remove utf8 BOM
my @rule = @{PATCH_CONTENT->{lc($name)}||[]} or return $$ref;
while (my ($from, $to) = splice(@rule, 0, 2)) {
if (ref($from) eq 'Regexp') {
$$ref =~ s/$from/$to/g;
}
else {
$$ref =~ s/\Q$from\E/$to/g;
}
}
return $$ref;
}
1;
=head1 SEE ALSO
L<PAR::Filter>
=head1 AUTHORS
Audrey Tang E<lt>cpan@audreyt.orgE<gt>
L<http://par.perl.org/> is the official PAR website. You can write
to the mailing list at E<lt>par@perl.orgE<gt>, or send an empty mail to
E<lt>par-subscribe@perl.orgE<gt> to participate in the discussion.
Please submit bug reports to E<lt>bug-par@rt.cpan.orgE<gt>.
=head1 COPYRIGHT
Copyright 2003-2009 by Audrey Tang E<lt>cpan@audreyt.orgE<gt>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See L<http://www.perl.com/perl/misc/Artistic.html>
=cut
|