File Coverage

blib/lib/File/PathList.pm

Criterion	Covered	Total	%
statement	47	48	97.9
branch	21	24	87.5
condition	9	9	100.0
subroutine	11	11	100.0
pod	4	4	100.0
total	92	96	95.8

package File::PathList;

=pod

=head1 NAME

File::PathList - Find a file within a set of paths (like @INC or Java classpaths)

=head1 SYNOPSIS

  # Create a basic pathset
  my $inc  = File::PathList->new( \@INC );

  # Again, but with more explicit params
  my $inc2 = File::PathList->new(
  	paths => \@INC,
  	cache => 1,
  	);

  # Get the full (localised) path for a unix-style relative path
  my $file = "foo/bar/baz.txt";
  my $path = $inc->find_file( $file );

  if ( $path ) {
      print "Found '$file' at '$path'\n";
  } else {
      print "Failed to find '$file'\n";
  }

=head1 DESCRIPTION

Many systems that map generic relative paths to absolute paths do so with a
set of base paths.

For example, perl itself when loading classes first turn a C
into a path like C, and thens looks through each element of
C<@INC> to find the actual file.

To aid in portability, all relative paths are provided as unix-style
relative paths, and converted to the localised version in the process of
looking up the path.

=head1 EXTENDING

The recommended method for extending C is to add additional
topic-specific find methods.

For example, a subclass that was attempting to duplicate the functionality
of perl's C<@INC> and module location may wish to add a C
method.

=head1 METHODS

=cut

use 5.005;
use strict;
use File::Spec       ();
use File::Spec::Unix ();
use Params::Util     qw{_ARRAY _CODE};

use vars qw{$VERSION};
BEGIN {
	$VERSION = '1.04';
}





#####################################################################
# Constructor and Accessors

=pod

=head2 new \@path | param => $value, ...

The C constructor creates a new C.

It takes the following options as key/value pairs.

=over 4

=item paths

The compulsory C param should be a reference to an C of local
filesystem paths.

=item cache

If the optional C param is set to true, the object will internally
cache the results of the file lookups. (false by default)

=back

If the C contructor is provided only a single param, this will be
take to mean C $param>.

Returns a new C object, or C if a valid path set
was not provided.

=cut

sub new {
	my $class = ref $_[0] ? ref shift : shift;

	# Handle the one argument shorthand case
	my %params = (@_ == 1)
		? (paths => shift)
		: @_;

	# Check the paths
	_ARRAY($params{paths}) or return undef;

	# Create the basic object
	my $self = bless {
		paths => [ @{$params{paths}} ],
		# code  => !! $params{code},
		$params{cache}
			? ( cache => {} )
			: (),
		}, $class;

	# Make sure there are no CODE refs if we can't have them
	# unless ( $self->code ) {
		if ( grep { _CODE($_[0]) } $self->paths ) {
			return undef;
		}
	# }

	$self;
}

=pod

=head2 paths

The C accessor returns the list of paths use to create the
C object.

Returns a list of localised path strings.

=cut

sub paths { @{$_[0]->{paths}} }

=pod

=head2 cache

The C accessor indicates whether or not the C object
is caching the results of the file lookups.

=cut

sub cache { exists $_[0]->{cache} }





#####################################################################
# File::PathList Methods

=pod

=head2 find_file $unix_path

The C method takes a unix-style relative file path, and
iterates through the list of paths, checking for the file in it.

Returns the full path to the file, the false null string C<''> if the file
could not be found, or C if passed a bad file name.

=cut

sub find_file {
	my ($self, $rel) = @_;

	# Check the file name is valid
	defined $rel and ! ref $rel and length $rel    or return undef;
	File::Spec::Unix->no_upwards($rel)             or return undef;
	File::Spec::Unix->file_name_is_absolute($rel) and return undef;

	# Is it in the cache?
	if ( $self->{cache} and exists $self->{cache}->{$rel} ) {
		return $self->{cache}->{$rel};
	}

	# Split up the filename into parts
	my (undef, $dir, $file) = File::Spec::Unix->splitpath($rel);
	my @parts = ( File::Spec::Unix->splitdir( $dir ), $file );

	# File name cannot contain upwards parts
	if ( @parts != File::Spec::Unix->no_upwards(@parts) ) {
		return undef;
	}

	# Attempt to locate the file in each path
	foreach my $inc ( $self->paths ) {
		my $path = File::Spec->catfile( $inc, @parts );
		next unless -f $path;

		# Cache if needed
		if ( $self->{cache} ) {
			$self->{cache}->{$rel} = $path;
		}

		return $path;
	}

	# File not found
	'';
}

1;

=pod

=head1 SUPPORT

Bugs should always be submitted via the CPAN bug tracker

L

For other issues, contact the maintainer

=head1 AUTHOR

Adam Kennedy [e-mail]

=head1 ACKNOWLEDGEMENTS

Thank you to Phase N (L) for permitting
the open sourcing and release of this distribution.

=head1 COPYRIGHT

Copyright 2005 - 2008 Adam Kennedy.

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut