File Coverage

blib/lib/MasonX/Resolver/ExtendedCompRoot.pm

Criterion	Covered	Total	%
statement	9	32	28.1
branch	0	14	0.0
condition	0	6	0.0
subroutine	3	6	50.0
pod	2	2	100.0
total	14	60	23.3

# This software is copyright (c) 2004 Alex Robinson.
# It is free software and can be used under the same terms as perl,
# i.e. either the GNU Public Licence or the Artistic License.

package MasonX::Resolver::ExtendedCompRoot;

use strict;

our $VERSION = '0.03';

use base qw(HTML::Mason::Resolver::File);

use HTML::Mason::Tools qw(read_file_ref);

#
# call ApacheHandler's apache_request_to_comp_path in a way
# that doesn't cause standalone invocations to choke
#
sub apache_request_to_comp_path
	{
	return HTML::Mason::Resolver::File::ApacheHandler::apache_request_to_comp_path(@_);
	}

#
# override HTML::Mason::Resolver::File's get_info
# which this method simply replicates and adds several lines to
# additional lines marked #ecr
#
sub get_info {
    my ($self, $path) = @_;

	my $specified_comp_root;							#ecr
	if (index($path,'=>') != -1) {						#ecr
	my ($comp_root,$comp_path) = split('=>',$path,2);	#ecr
	$specified_comp_root = $comp_root;					#ecr
	$specified_comp_root =~ s|^/||;						#ecr
	$path = $comp_path;									#ecr
	}													#ecr

    foreach my $pair ($self->comp_root_array) {

	next if ($specified_comp_root and ($pair->[0] ne $specified_comp_root));	#ecr

	my $srcfile = File::Spec->canonpath( File::Spec->catfile( $pair->[1], $path ) );
	next unless -f $srcfile;

	my $key = $pair->[0];

	my $modified = (stat _)[9];
	my $base = $key eq 'MAIN' ? '' : "/$key";
	$key = undef if $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 => $key },
                      source_callback => sub { read_file_ref($srcfile) },
                    );
    }

    if ( $path ne '/' )
    {
        # see if path corresponds to real filesystem path, a common new user mistake
        my $fs_path = File::Spec->catfile( split /\//, $path );
        if ( defined $fs_path && -e $fs_path )
        {
            warn "Your component path ($path) matches a real file on disk ($fs_path).  Have you read about the component root in the Administrator's Manual (HTML::Mason::Admin)?";
        }
    }

    return;
}

1;


__END__