/usr/share/perl5/HTML/Mason/Resolver/File.pm is in libhtml-mason-perl 1:1.52-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 | # Copyright (c) 1998-2005 by Jonathan Swartz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
package HTML::Mason::Resolver::File;
{
$HTML::Mason::Resolver::File::VERSION = '1.52';
}
use strict;
use warnings;
use Cwd;
use File::Glob;
use File::Spec;
use HTML::Mason::Tools qw(read_file_ref paths_eq);
use Params::Validate qw(:all);
use HTML::Mason::ComponentSource;
use HTML::Mason::Resolver;
use base qw(HTML::Mason::Resolver);
use HTML::Mason::Exceptions (abbr => ['param_error']);
sub get_info {
my ($self, $path, $comp_root_key, $comp_root_path) = @_;
# Note that canonpath has the property of not collapsing a series
# of /../../ dirs in an unsafe way. This means that if the
# component path is /../../../../etc/passwd, we're still safe. I
# don't know if this was intentional, but it's certainly a good
# thing, and something we want to preserve if the code ever
# changes.
my $srcfile = File::Spec->canonpath( File::Spec->catfile( $comp_root_path, $path ) );
return unless -f $srcfile;
my $modified = (stat _)[9];
my $base = $comp_root_key eq 'MAIN' ? '' : "/$comp_root_key";
$comp_root_key = undef if $comp_root_key eq 'MAIN';
return
HTML::Mason::ComponentSource->new
( friendly_name => $srcfile,
comp_id => "$base$path",
last_modified => $modified,
comp_path => $path,
comp_class => 'HTML::Mason::Component::FileBased',
extra => { comp_root => $comp_root_key },
source_callback => sub { read_file_ref($srcfile) },
);
}
#
# Return all existing url_paths matching the given glob pattern underneath the given root.
# glob_path is required for using the "preloads" parameter.
#
sub glob_path {
my ($self, $pattern, $comp_root_path) = @_;
my @files = File::Glob::bsd_glob($comp_root_path . $pattern);
my $root_length = length $comp_root_path;
my @paths;
foreach my $file (@files) {
next unless -f $file;
if (substr($file, 0, $root_length) eq $comp_root_path) {
push(@paths, substr($file, $root_length));
}
}
return @paths;
}
#
# Given an apache request object and a list of component root pairs,
# return the associated component path or undef if none exists. This
# is called for top-level web requests that resolve to a particular
# file.
# apache_request_to_comp_path is required for running Mason under mod_perl.
#
sub apache_request_to_comp_path {
my ($self, $r, @comp_root_array) = @_;
my $file = $r->filename;
$file .= $r->path_info unless -f $file;
# Clear up any weirdness here so that paths_eq compares two
# 'canonical' paths (canonpath is called on comp roots when
# resolver object is created. Seems to be needed on Win32 (see
# bug #356).
$file = File::Spec->canonpath($file);
foreach my $root (map $_->[1], @comp_root_array) {
if (paths_eq($root, substr($file, 0, length($root)))) {
my $path = substr($file, length $root);
$path = length $path ? join '/', File::Spec->splitdir($path) : '/';
chop $path if $path ne '/' && substr($path, -1) eq '/';
return $path;
}
}
return undef;
}
1;
__END__
=pod
=head1 NAME
HTML::Mason::Resolver::File - Component path resolver for file-based components
=head1 VERSION
version 1.52
=head1 SYNOPSIS
my $resolver = HTML::Mason::Resolver::File->new();
my $info = $resolver->get_info('/some/comp.html');
=head1 DESCRIPTION
This HTML::Mason::Resolver subclass is used when components are stored
on the filesystem, which is the norm for most Mason-based applications.
=head1 SEE ALSO
L<Mason|Mason>
=head1 AUTHORS
=over 4
=item *
Jonathan Swartz <swartz@pobox.com>
=item *
Dave Rolsky <autarch@urth.org>
=item *
Ken Williams <ken@mathforum.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Jonathan Swartz.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|