This file is indexed.

/usr/share/perl5/PAR/StrippedPARL/Base.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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
package PAR::StrippedPARL::Base;
use 5.008001;
use strict;
use warnings;
our $VERSION = '0.975';

use File::Temp ();
use File::Spec;
use Config ();

=head1 NAME

PAR::StrippedPARL::Base - Base class for the PARL data packages

=head1 SYNOPSIS

  # Please use one of the siblings of this class instead.
  use base 'PAR::StrippedPARL::Base';

=head1 DESCRIPTION

This class is internal to PAR. Do not use it outside of PAR.

This class is basically just a container for a static binary PAR loader
which doesn't include the PAR code like the F<parl> or F<parl.exe>
you are used to. If you're really curious, I'll tell you it is
just a copy of the F<myldr/static> (or F<myldr/static.exe>) file.

The data is appended during the C<make> phase of the PAR build process.

If the binary data isn't appended during the build process, the two class
methods will return the empty list.

=head1 CLASS METHODS

=head2 write_parl

Takes a file name as argument. Writes the raw binary data in
the package to the specified file and embeds the core modules
to produce a complete PAR loader (I<parl>).

Returns true on success or the empty list on failure.

=cut

sub write_parl {
    my $class = shift;
    my $file = shift;
    if (not defined $file) {
        warn "${class}->write_parl() needs a file name as argument";
        return();
    }

    # write out to a temporary file first
    my ($fh, $tfile) = File::Temp::tempfile(
        "parlXXXX", SUFFIX => $Config::Config{_exe}||'', TMPDIR => 1);
    close $fh;
    # File::Temp, you suck!

    if (not $class->write_raw($tfile)) {
        unlink($tfile);
        warn "Could not write temporary parl (class $class) to file '$tfile'";
        return();
    }
    chmod(oct('755'), $tfile);

    # Use this to generate a real parl
    my @libs = ();
    for my $ilib ( @INC ) {
        next if ref $ilib;
        $ilib =~ s/\\$/\\\\/;
        push(@libs, qq(-I$ilib) );
    }
    my @args = (@libs, qw/-q -B/);

    # prepend ./ if applicable
    my $execute = $tfile;
    my @dirs = File::Spec->splitdir(
        (File::Spec->splitpath($execute))[1] # directory part only
    );
    $execute = File::Spec->catfile(File::Spec->curdir(), $tfile) if not @dirs;
    system($execute, @args, "-O$file") and unlink($tfile), return();
    
    # clean up
    unlink($tfile);

    return 1;
}

=head2 get_raw

Returns the binary data attached to the data package.

Returns the empty list on failure.

=cut

sub get_raw {
    my $class = shift;
    my $pos = $class->_data_pos(); 
    if (not defined $pos) {
        warn "${class}->_data_pos() did not return the original tell() position of the DATA file handle";
        return();
    }
    my $sym;
    {
        # Is there a better way to do this?
        no strict 'refs';
        $sym = \*{"${class}::DATA"};
    }
    seek $sym, $pos, 0 or die $!;
    binmode $sym;
    local $/ = undef;
    my $data = <$sym>;
    $data =~ s/^\s*//;
    my $binary = unpack 'u', $data;
    return() if not defined $binary or $binary !~ /\S/;
    return $binary;
}


=head2 write_raw

Takes a file name as argument and writes the binary data to the file.

Returns true on success and the empty list on failure.

=cut

sub write_raw {
    my $class = shift;
    my $file = shift;
    if (not defined $file) {
        warn "${class}->write_raw() needs a file name as argument";
        return();
    }
    my $binary = $class->get_raw();
    if (not defined $binary) {
        warn "${class}->get_raw() did not return the raw binary data for a PAR loader";
        return();
    }

    open my $fh, '>', $file or die "Could not open file '$file' for writing: $!";
    binmode $fh;
    print $fh $binary;
    close $fh;

    return 1;
}

=head1 SUBCLASSING

Subclasses need to implement the C<_data_pos> class method which returns
the value of C<tell DATA> as it was after the class was loaded.

=head1 AUTHORS

Steffen Mueller E<lt>smueller@cpan.orgE<gt>,
Audrey Tang E<lt>cpan@audreyt.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2009 by Steffen Mueller E<lt>smueller@cpan.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

__DATA__