[catagits/Gitalist.git] / local-lib5 / lib / perl5 / File / ShareDir.pm

package File::ShareDir;

=pod

=head1 NAME

File::ShareDir - Locate per-dist and per-module shared files

=head1 SYNOPSIS

  use File::ShareDir ':ALL';
  
  # Where are distribution-level shared data files kept
  $dir = dist_dir('File-ShareDir');
  
  # Where are module-level shared data files kept
  $dir = module_dir('File::ShareDir');
  
  # Find a specific file in our dist/module shared dir
  $file = dist_file(  'File-ShareDir',  'file/name.txt');
  $file = module_file('File::ShareDir', 'file/name.txt');
  
  # Like module_file, but search up the inheritance tree
  $file = class_file( 'Foo::Bar', 'file/name.txt' );

=head1 DESCRIPTION

The intent of L<File::ShareDir> is to provide a companion to
L<Class::Inspector> and L<File::HomeDir>, modules that take a
process that is well-known by advanced Perl developers but gets a
little tricky, and make it more available to the larger Perl community.

Quite often you want or need your Perl module (CPAN or otherwise)
to have access to a large amount of read-only data that is stored
on the file-system at run-time.

On a linux-like system, this would be in a place such as /usr/share,
however Perl runs on a wide variety of different systems, and so
the use of any one location is unreliable.

Perl provides a little-known method for doing this, but almost
nobody is aware that it exists. As a result, module authors often
go through some very strange ways to make the data available to
their code.

The most common of these is to dump the data out to an enormous
Perl data structure and save it into the module itself. The
result are enormous multi-megabyte .pm files that chew up a
lot of memory needlessly.

Another method is to put the data "file" after the __DATA__ compiler
tag and limit yourself to access as a filehandle.

The problem to solve is really quite simple.

  1. Write the data files to the system at install time.
  
  2. Know where you put them at run-time.

Perl's install system creates an "auto" directory for both
every distribution and for every module file.

These are used by a couple of different auto-loading systems
to store code fragments generated at install time, and various
other modules written by the Perl "ancient masters".

But the same mechanism is available to any dist or module to
store any sort of data.

=head2 Using Data in your Module

C<File::ShareDir> forms one half of a two part solution.

Once the files have been installed to the correct directory,
you can use C<File::ShareDir> to find your files again after
the installation.

For the installation half of the solution, see L<Module::Install>
and its C<install_share> directive.

=head1 FUNCTIONS

C<File::ShareDir> provides four functions for locating files and
directories.

For greater maintainability, none of these are exported by default
and you are expected to name the ones you want at use-time, or provide
the C<':ALL'> tag. All of the following are equivalent.

  # Load but don't import, and then call directly
  use File::ShareDir;
  $dir = File::ShareDir::dist_dir('My-Dist');
  
  # Import a single function
  use File::ShareDir 'dist_dir';
  dist_dir('My-Dist');
  
  # Import all the functions
  use File::ShareDir ':ALL';
  dist_dir('My-Dist');

All of the functions will check for you that the dir/file actually
exists, and that you have read permissions, or they will throw an
exception.

=cut

use 5.005;
use strict;
use Carp             'croak';
use Config           ();
use Exporter         ();
use File::Spec       ();
use Params::Util     '_CLASS';
use Class::Inspector ();

use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS};
BEGIN {
	$VERSION     = '1.01';
	@ISA         = qw{ Exporter };
	@EXPORT_OK   = qw{
		dist_dir dist_file
		module_dir module_file
		class_dir class_file
	};
	%EXPORT_TAGS = (
		ALL => [ @EXPORT_OK ],
	);	
}

use constant IS_MACOS => !!($^O eq 'MacOS');


#####################################################################
# Interface Functions

=pod

=head2 dist_dir

  # Get a distribution's shared files directory
  my $dir = dist_dir('My-Distribution');

The C<dist_dir> function takes a single parameter of the name of an
installed (CPAN or otherwise) distribution, and locates the shared
data directory created at install time for it.

Returns the directory path as a string, or dies if it cannot be
located or is not readable.

=cut

sub dist_dir {
	my $dist = _DIST(shift);
	my $dir;

	# Try the new version
	$dir = _dist_dir_new( $dist );
	return $dir if defined $dir;

	# Fall back to the legacy version
	$dir = _dist_dir_old( $dist );
	return $dir if defined $dir;

	# Ran out of options
	croak("Failed to find share dir for dist '$dist'");
}

sub _dist_dir_new {
	my $dist = shift;

	# Create the subpath
	my $path = File::Spec->catdir(
		'auto', 'share', 'dist', $dist,
	);

	# Find the full dir withing @INC
	foreach my $inc ( @INC ) {
		next unless defined $inc and ! ref $inc;
		my $dir = File::Spec->catdir( $inc, $path );
		next unless -d $dir;
		unless ( -r $dir ) {
			croak("Found directory '$dir', but no read permissions");
		}
		return $dir;
	}

	return undef;
}

sub _dist_dir_old {
	my $dist = shift;

	# Create the subpath
	my $path = File::Spec->catdir(
		'auto', split( /-/, $dist ),
	);

	# Find the full dir within @INC
	foreach my $inc ( @INC ) {
		next unless defined $inc and ! ref $inc;
		my $dir = File::Spec->catdir( $inc, $path );
		next unless -d $dir;
		unless ( -r $dir ) {
			croak("Found directory '$dir', but no read permissions");
		}
		return $dir;
	}

	return undef;
}

=pod

=head2 module_dir

  # Get a module's shared files directory
  my $dir = module_dir('My::Module');

The C<module_dir> function takes a single parameter of the name of an
installed (CPAN or otherwise) module, and locates the shared data
directory created at install time for it.

In order to find the directory, the module B<must> be loaded when
calling this function.

Returns the directory path as a string, or dies if it cannot be
located or is not readable.

=cut

sub module_dir {
	my $module = _MODULE(shift);
	my $dir;

	# Try the new version
	$dir = _module_dir_new( $module );
	return $dir if defined $dir;

	# Fall back to the legacy version
	return _module_dir_old( $module );
}

sub _module_dir_new {
	my $module = shift;

	# Create the subpath
	my $path = File::Spec->catdir(
		'auto', 'share', 'module',
		_module_subdir( $module ),
	);

	# Find the full dir withing @INC
	foreach my $inc ( @INC ) {
		next unless defined $inc and ! ref $inc;
		my $dir = File::Spec->catdir( $inc, $path );
		next unless -d $dir;
		unless ( -r $dir ) {
			croak("Found directory '$dir', but no read permissions");
		}
		return $dir;
	}

	return undef;
}
	
sub _module_dir_old {
	my $module = shift;
	my $short  = Class::Inspector->filename($module);
	my $long   = Class::Inspector->loaded_filename($module);
	$short =~ tr{/}{:} if IS_MACOS;
	substr( $short, -3, 3, '' );
	$long  =~ m/^(.*)\Q$short\E\.pm\z/s or die("Failed to find base dir");
	my $dir = File::Spec->catdir( "$1", 'auto', $short );
	unless ( -d $dir ) {
		croak("Directory '$dir', does not exist");
	}
	unless ( -r $dir ) {
		croak("Directory '$dir', no read permissions");
	}
	return $dir;
}

=pod

=head2 dist_file

  # Find a file in our distribution shared dir
  my $dir = dist_file('My-Distribution', 'file/name.txt');

The C<dist_file> function takes two params of the distribution name
and file name, locates the dist dir, and then finds the file within
it, verifying that the file actually exists, and that it is readable.

The filename should be a relative path in the format of your local
filesystem. It will simply added to the directory using L<File::Spec>'s
C<catfile> method.

Returns the file path as a string, or dies if the file or the dist's
directory cannot be located, or the file is not readable.

=cut

sub dist_file {
	my $dist = _DIST(shift);
	my $file = _FILE(shift);

	# Try the new version first
	my $path = _dist_file_new( $dist, $file );
	return $path if defined $path;

	# Hand off to the legacy version
	return _dist_file_old( $dist, $file );;
}

sub _dist_file_new {
	my $dist = shift;
	my $file = shift;

	# If it exists, what should the path be
	my $dir  = _dist_dir_new( $dist );
	my $path = File::Spec->catfile( $dir, $file );

	# Does the file exist
	return undef unless -e $path;
	unless ( -f $path ) {
		croak("Found dist_file '$path', but not a file");
	}
	unless ( -r $path ) {
		croak("File '$path', no read permissions");
	}

	return $path;
}

sub _dist_file_old {
	my $dist = shift;
	my $file = shift;

	# Create the subpath
	my $path = File::Spec->catfile(
		'auto', split( /-/, $dist ), $file,
	);

	# Find the full dir withing @INC
	foreach my $inc ( @INC ) {
		next unless defined $inc and ! ref $inc;
		my $full = File::Spec->catdir( $inc, $path );
		next unless -e $full;
		unless ( -r $full ) {
			croak("Directory '$full', no read permissions");
		}
		return $full;
	}

	# Couldn't find it
	croak("Failed to find shared file '$file' for dist '$dist'");
}

=pod

=head2 module_file

  # Find a file in our module shared dir
  my $dir = module_file('My::Module', 'file/name.txt');

The C<module_file> function takes two params of the module name
and file name. It locates the module dir, and then finds the file within
it, verifying that the file actually exists, and that it is readable.

In order to find the directory, the module B<must> be loaded when
calling this function.

The filename should be a relative path in the format of your local
filesystem. It will simply added to the directory using L<File::Spec>'s
C<catfile> method.

Returns the file path as a string, or dies if the file or the dist's
directory cannot be located, or the file is not readable.

=cut

sub module_file {
	my $module = _MODULE(shift);
	my $file   = _FILE(shift);
	my $dir    = module_dir($module);
	my $path   = File::Spec->catfile($dir, $file);
	unless ( -e $path ) {
		croak("File '$file' does not exist in module dir");
	}
	unless ( -r $path ) {
		croak("File '$file' cannot be read, no read permissions");
	}
	$path;
}

=pod

=head2 class_file

  # Find a file in our module shared dir, or in our parent class
  my $dir = class_file('My::Module', 'file/name.txt');

The C<module_file> function takes two params of the module name
and file name. It locates the module dir, and then finds the file within
it, verifying that the file actually exists, and that it is readable.

In order to find the directory, the module B<must> be loaded when
calling this function.

The filename should be a relative path in the format of your local
filesystem. It will simply added to the directory using L<File::Spec>'s
C<catfile> method.

If the file is NOT found for that module, C<class_file> will scan up
the module's @ISA tree, looking for the file in all of the parent
classes.

This allows you to, in effect, "subclass" shared files.

Returns the file path as a string, or dies if the file or the dist's
directory cannot be located, or the file is not readable.

=cut

sub class_file {
	my $module = _MODULE(shift);
	my $file   = _FILE(shift);

	# Get the super path ( not including UNIVERSAL )
	# Rather than using Class::ISA, we'll use an inlined version
	# that implements the same basic algorithm.
	my @path  = ();
	my @queue = ( $module );
	my %seen  = ( $module => 1 );
	while ( my $cl = shift @queue ) {
		push @path, $cl;
		no strict 'refs';
		unshift @queue, grep { ! $seen{$_}++ }
			map { s/^::/main::/; s/\'/::/g; $_ }
			( @{"${cl}::ISA"} );
	}

	# Search up the path
	foreach my $class ( @path ) {
		local $@;
		my $dir = eval {
		 	module_dir($class);
		};
		next if $@;
		my $path = File::Spec->catfile($dir, $file);
		unless ( -e $path ) {
			next;
		}
		unless ( -r $path ) {
			croak("File '$file' cannot be read, no read permissions");
		}
		return $path;
	}
	croak("File '$file' does not exist in class or parent shared files");
}


#####################################################################
# Support Functions

sub _module_subdir {
	my $module = shift;
	$module =~ s/::/-/g;
	return $module;
}

sub _dist_packfile {
	my $module = shift;
	my @dirs   = grep { -e } ( $Config::Config{archlibexp}, $Config::Config{sitearchexp} );
	my $file   = File::Spec->catfile(
		'auto', split( /::/, $module), '.packlist',
	);

	foreach my $dir ( @dirs ) {
		my $path = File::Spec->catfile( $dir, $file );
		next unless -f $path;

		# Load the file
		my $packlist = ExtUtils::Packlist->new($path);
		unless ( $packlist ) {
			die "Failed to load .packlist file for $module";
		}

		die "CODE INCOMPLETE";
	}

	die "CODE INCOMPLETE";
}

# Matches a valid distribution name
### This is a total guess at this point
sub _DIST {
	if ( defined $_[0] and ! ref $_[0] and $_[0] =~ /^[a-z0-9+_-]+$/is ) {
		return shift;
	}
	croak("Not a valid distribution name");
}

# A valid and loaded module name
sub _MODULE {
	my $module = _CLASS(shift) or croak("Not a valid module name");
	if ( Class::Inspector->loaded($module) ) {
		return $module;
	}
	croak("Module '$module' is not loaded");
}

# A valid file name
sub _FILE {
	my $file = shift;
	unless ( defined $file and ! ref $file and length $file ) {
		croak("Did not pass a file name");
	}
	if ( File::Spec->file_name_is_absolute($file) ) {
		croak("Cannot use absolute file name '$file'");
	}
	$file;
}

1;

=pod

=head1 SUPPORT

Bugs should always be submitted via the CPAN bug tracker

L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-ShareDir>

For other issues, contact the maintainer.

=head1 AUTHOR

Adam Kennedy E<lt>adamk@cpan.orgE<gt>

=head1 SEE ALSO

L<File::HomeDir>, L<Module::Install>, L<Module::Install::Share>,
L<File::ShareDir::PAR>

=head1 COPYRIGHT

Copyright 2005 - 2009 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
Commit	Line	Data
3fea05b9	1	package File::ShareDir;
	2
	3	=pod
	4
	5	=head1 NAME
	6
	7	File::ShareDir - Locate per-dist and per-module shared files
	8
	9	=head1 SYNOPSIS
	10
	11	use File::ShareDir ':ALL';
	12
	13	# Where are distribution-level shared data files kept
	14	$dir = dist_dir('File-ShareDir');
	15
	16	# Where are module-level shared data files kept
	17	$dir = module_dir('File::ShareDir');
	18
	19	# Find a specific file in our dist/module shared dir
	20	$file = dist_file( 'File-ShareDir', 'file/name.txt');
	21	$file = module_file('File::ShareDir', 'file/name.txt');
	22
	23	# Like module_file, but search up the inheritance tree
	24	$file = class_file( 'Foo::Bar', 'file/name.txt' );
	25
	26	=head1 DESCRIPTION
	27
	28	The intent of L<File::ShareDir> is to provide a companion to
	29	L<Class::Inspector> and L<File::HomeDir>, modules that take a
	30	process that is well-known by advanced Perl developers but gets a
	31	little tricky, and make it more available to the larger Perl community.
	32
	33	Quite often you want or need your Perl module (CPAN or otherwise)
	34	to have access to a large amount of read-only data that is stored
	35	on the file-system at run-time.
	36
	37	On a linux-like system, this would be in a place such as /usr/share,
	38	however Perl runs on a wide variety of different systems, and so
	39	the use of any one location is unreliable.
	40
	41	Perl provides a little-known method for doing this, but almost
	42	nobody is aware that it exists. As a result, module authors often
	43	go through some very strange ways to make the data available to
	44	their code.
	45
	46	The most common of these is to dump the data out to an enormous
	47	Perl data structure and save it into the module itself. The
	48	result are enormous multi-megabyte .pm files that chew up a
	49	lot of memory needlessly.
	50
	51	Another method is to put the data "file" after the __DATA__ compiler
	52	tag and limit yourself to access as a filehandle.
	53
	54	The problem to solve is really quite simple.
	55
	56	1. Write the data files to the system at install time.
	57
	58	2. Know where you put them at run-time.
	59
	60	Perl's install system creates an "auto" directory for both
	61	every distribution and for every module file.
	62
	63	These are used by a couple of different auto-loading systems
	64	to store code fragments generated at install time, and various
65	other modules written by the Perl "ancient masters".
66
67	But the same mechanism is available to any dist or module to
68	store any sort of data.
69
70	=head2 Using Data in your Module
71
72	C<File::ShareDir> forms one half of a two part solution.
73
74	Once the files have been installed to the correct directory,
75	you can use C<File::ShareDir> to find your files again after
76	the installation.
77
78	For the installation half of the solution, see L<Module::Install>
79	and its C<install_share> directive.
80
81	=head1 FUNCTIONS
82
83	C<File::ShareDir> provides four functions for locating files and
84	directories.
85
86	For greater maintainability, none of these are exported by default
87	and you are expected to name the ones you want at use-time, or provide
88	the C<':ALL'> tag. All of the following are equivalent.
89
90	# Load but don't import, and then call directly
91	use File::ShareDir;
92	$dir = File::ShareDir::dist_dir('My-Dist');
93
94	# Import a single function
95	use File::ShareDir 'dist_dir';
96	dist_dir('My-Dist');
97
98	# Import all the functions
99	use File::ShareDir ':ALL';
100	dist_dir('My-Dist');
101
102	All of the functions will check for you that the dir/file actually
103	exists, and that you have read permissions, or they will throw an
104	exception.
105
106	=cut
107
108	use 5.005;
109	use strict;
110	use Carp 'croak';
111	use Config ();
112	use Exporter ();
113	use File::Spec ();
114	use Params::Util '_CLASS';
115	use Class::Inspector ();
116
117	use vars qw{$VERSION @ISA @EXPORT_OK %EXPORT_TAGS};
118	BEGIN {
119	$VERSION = '1.01';
120	@ISA = qw{ Exporter };
121	@EXPORT_OK = qw{
122	dist_dir dist_file
123	module_dir module_file
124	class_dir class_file
125	};
126	%EXPORT_TAGS = (
127	ALL => [ @EXPORT_OK ],
128	);
129	}
130
131	use constant IS_MACOS => !!($^O eq 'MacOS');
132
133
134
135
136
137	#####################################################################
138	# Interface Functions
139
140	=pod
141
142	=head2 dist_dir
143
144	# Get a distribution's shared files directory
145	my $dir = dist_dir('My-Distribution');
146
147	The C<dist_dir> function takes a single parameter of the name of an
148	installed (CPAN or otherwise) distribution, and locates the shared
149	data directory created at install time for it.
150
151	Returns the directory path as a string, or dies if it cannot be
152	located or is not readable.
153
154	=cut
155
156	sub dist_dir {
157	my $dist = _DIST(shift);
158	my $dir;
159
160	# Try the new version
161	$dir = _dist_dir_new( $dist );
162	return $dir if defined $dir;
163
164	# Fall back to the legacy version
165	$dir = _dist_dir_old( $dist );
166	return $dir if defined $dir;
167
168	# Ran out of options
169	croak("Failed to find share dir for dist '$dist'");
170	}
171
172	sub _dist_dir_new {
173	my $dist = shift;
174
175	# Create the subpath
176	my $path = File::Spec->catdir(
177	'auto', 'share', 'dist', $dist,
178	);
179
180	# Find the full dir withing @INC
181	foreach my $inc ( @INC ) {
182	next unless defined $inc and ! ref $inc;
183	my $dir = File::Spec->catdir( $inc, $path );
184	next unless -d $dir;
185	unless ( -r $dir ) {
186	croak("Found directory '$dir', but no read permissions");
187	}
188	return $dir;
189	}
190
191	return undef;
192	}
193
194	sub _dist_dir_old {
195	my $dist = shift;
196
197	# Create the subpath
198	my $path = File::Spec->catdir(
199	'auto', split( /-/, $dist ),
200	);
201
202	# Find the full dir within @INC
203	foreach my $inc ( @INC ) {
204	next unless defined $inc and ! ref $inc;
205	my $dir = File::Spec->catdir( $inc, $path );
206	next unless -d $dir;
207	unless ( -r $dir ) {
208	croak("Found directory '$dir', but no read permissions");
209	}
210	return $dir;
211	}
212
213	return undef;
214	}
215
216	=pod
217
218	=head2 module_dir
219
220	# Get a module's shared files directory
221	my $dir = module_dir('My::Module');
222
223	The C<module_dir> function takes a single parameter of the name of an
224	installed (CPAN or otherwise) module, and locates the shared data
225	directory created at install time for it.
226
227	In order to find the directory, the module B<must> be loaded when
228	calling this function.
229
230	Returns the directory path as a string, or dies if it cannot be
231	located or is not readable.
232
233	=cut
234
235	sub module_dir {
236	my $module = _MODULE(shift);
237	my $dir;
238
239	# Try the new version
240	$dir = _module_dir_new( $module );
241	return $dir if defined $dir;
242
243	# Fall back to the legacy version
244	return _module_dir_old( $module );
245	}
246
247	sub _module_dir_new {
248	my $module = shift;
249
250	# Create the subpath
251	my $path = File::Spec->catdir(
252	'auto', 'share', 'module',
253	_module_subdir( $module ),
254	);
255
256	# Find the full dir withing @INC
257	foreach my $inc ( @INC ) {
258	next unless defined $inc and ! ref $inc;
259	my $dir = File::Spec->catdir( $inc, $path );
260	next unless -d $dir;
261	unless ( -r $dir ) {
262	croak("Found directory '$dir', but no read permissions");
263	}
264	return $dir;
265	}
266
267	return undef;
268	}
269
270	sub _module_dir_old {
271	my $module = shift;
272	my $short = Class::Inspector->filename($module);
273	my $long = Class::Inspector->loaded_filename($module);
274	$short =~ tr{/}{:} if IS_MACOS;
275	substr( $short, -3, 3, '' );
276	$long =~ m/^(.*)\Q$short\E\.pm\z/s or die("Failed to find base dir");
277	my $dir = File::Spec->catdir( "$1", 'auto', $short );
278	unless ( -d $dir ) {
279	croak("Directory '$dir', does not exist");
280	}
281	unless ( -r $dir ) {
282	croak("Directory '$dir', no read permissions");
283	}
284	return $dir;
285	}
286
287	=pod
288
289	=head2 dist_file
290
291	# Find a file in our distribution shared dir
292	my $dir = dist_file('My-Distribution', 'file/name.txt');
293
294	The C<dist_file> function takes two params of the distribution name
295	and file name, locates the dist dir, and then finds the file within
296	it, verifying that the file actually exists, and that it is readable.
297
298	The filename should be a relative path in the format of your local
299	filesystem. It will simply added to the directory using L<File::Spec>'s
300	C<catfile> method.
301
302	Returns the file path as a string, or dies if the file or the dist's
303	directory cannot be located, or the file is not readable.
304
305	=cut
306
307	sub dist_file {
308	my $dist = _DIST(shift);
309	my $file = _FILE(shift);
310
311	# Try the new version first
312	my $path = _dist_file_new( $dist, $file );
313	return $path if defined $path;
314
315	# Hand off to the legacy version
316	return _dist_file_old( $dist, $file );;
317	}
318
319	sub _dist_file_new {
320	my $dist = shift;
321	my $file = shift;
322
323	# If it exists, what should the path be
324	my $dir = _dist_dir_new( $dist );
325	my $path = File::Spec->catfile( $dir, $file );
326
327	# Does the file exist
328	return undef unless -e $path;
329	unless ( -f $path ) {
330	croak("Found dist_file '$path', but not a file");
331	}
332	unless ( -r $path ) {
333	croak("File '$path', no read permissions");
334	}
335
336	return $path;
337	}
338
339	sub _dist_file_old {
340	my $dist = shift;
341	my $file = shift;
342
343	# Create the subpath
344	my $path = File::Spec->catfile(
345	'auto', split( /-/, $dist ), $file,
346	);
347
348	# Find the full dir withing @INC
349	foreach my $inc ( @INC ) {
350	next unless defined $inc and ! ref $inc;
351	my $full = File::Spec->catdir( $inc, $path );
352	next unless -e $full;
353	unless ( -r $full ) {
354	croak("Directory '$full', no read permissions");
355	}
356	return $full;
357	}
358
359	# Couldn't find it
360	croak("Failed to find shared file '$file' for dist '$dist'");
361	}
362
363	=pod
364
365	=head2 module_file
366
367	# Find a file in our module shared dir
368	my $dir = module_file('My::Module', 'file/name.txt');
369
370	The C<module_file> function takes two params of the module name
371	and file name. It locates the module dir, and then finds the file within
372	it, verifying that the file actually exists, and that it is readable.
373
374	In order to find the directory, the module B<must> be loaded when
375	calling this function.
376
377	The filename should be a relative path in the format of your local
378	filesystem. It will simply added to the directory using L<File::Spec>'s
379	C<catfile> method.
380
381	Returns the file path as a string, or dies if the file or the dist's
382	directory cannot be located, or the file is not readable.
383
384	=cut
385
386	sub module_file {
387	my $module = _MODULE(shift);
388	my $file = _FILE(shift);
389	my $dir = module_dir($module);
390	my $path = File::Spec->catfile($dir, $file);
391	unless ( -e $path ) {
392	croak("File '$file' does not exist in module dir");
393	}
394	unless ( -r $path ) {
395	croak("File '$file' cannot be read, no read permissions");
396	}
397	$path;
398	}
399
400	=pod
401
402	=head2 class_file
403
404	# Find a file in our module shared dir, or in our parent class
405	my $dir = class_file('My::Module', 'file/name.txt');
406
407	The C<module_file> function takes two params of the module name
408	and file name. It locates the module dir, and then finds the file within
409	it, verifying that the file actually exists, and that it is readable.
410
411	In order to find the directory, the module B<must> be loaded when
412	calling this function.
413
414	The filename should be a relative path in the format of your local
415	filesystem. It will simply added to the directory using L<File::Spec>'s
416	C<catfile> method.
417
418	If the file is NOT found for that module, C<class_file> will scan up
419	the module's @ISA tree, looking for the file in all of the parent
420	classes.
421
422	This allows you to, in effect, "subclass" shared files.
423
424	Returns the file path as a string, or dies if the file or the dist's
425	directory cannot be located, or the file is not readable.
426
427	=cut
428
429	sub class_file {
430	my $module = _MODULE(shift);
431	my $file = _FILE(shift);
432
433	# Get the super path ( not including UNIVERSAL )
434	# Rather than using Class::ISA, we'll use an inlined version
435	# that implements the same basic algorithm.
436	my @path = ();
437	my @queue = ( $module );
438	my %seen = ( $module => 1 );
439	while ( my $cl = shift @queue ) {
440	push @path, $cl;
441	no strict 'refs';
442	unshift @queue, grep { ! $seen{$_}++ }
443	map { s/^::/main::/; s/\'/::/g; $_ }
444	( @{"${cl}::ISA"} );
445	}
446
447	# Search up the path
448	foreach my $class ( @path ) {
449	local $@;
450	my $dir = eval {
451	module_dir($class);
452	};
453	next if $@;
454	my $path = File::Spec->catfile($dir, $file);
455	unless ( -e $path ) {
456	next;
457	}
458	unless ( -r $path ) {
459	croak("File '$file' cannot be read, no read permissions");
460	}
461	return $path;
462	}
463	croak("File '$file' does not exist in class or parent shared files");
464	}
465
466
467
468
469	#####################################################################
470	# Support Functions
471
472	sub _module_subdir {
473	my $module = shift;
474	$module =~ s/::/-/g;
475	return $module;
476	}
477
478	sub _dist_packfile {
479	my $module = shift;
480	my @dirs = grep { -e } ( $Config::Config{archlibexp}, $Config::Config{sitearchexp} );
481	my $file = File::Spec->catfile(
482	'auto', split( /::/, $module), '.packlist',
483	);
484
485	foreach my $dir ( @dirs ) {
486	my $path = File::Spec->catfile( $dir, $file );
487	next unless -f $path;
488
489	# Load the file
490	my $packlist = ExtUtils::Packlist->new($path);
491	unless ( $packlist ) {
492	die "Failed to load .packlist file for $module";
493	}
494
495	die "CODE INCOMPLETE";
496	}
497
498	die "CODE INCOMPLETE";
499	}
500
501	# Matches a valid distribution name
502	### This is a total guess at this point
503	sub _DIST {
504	if ( defined $_[0] and ! ref $_[0] and $_[0] =~ /^[a-z0-9+_-]+$/is ) {
505	return shift;
506	}
507	croak("Not a valid distribution name");
508	}
509
510	# A valid and loaded module name
511	sub _MODULE {
512	my $module = _CLASS(shift) or croak("Not a valid module name");
513	if ( Class::Inspector->loaded($module) ) {
514	return $module;
515	}
516	croak("Module '$module' is not loaded");
517	}
518
519	# A valid file name
520	sub _FILE {
521	my $file = shift;
522	unless ( defined $file and ! ref $file and length $file ) {
523	croak("Did not pass a file name");
524	}
525	if ( File::Spec->file_name_is_absolute($file) ) {
526	croak("Cannot use absolute file name '$file'");
527	}
528	$file;
529	}
530
531	1;
532
533	=pod
534
535	=head1 SUPPORT
536
537	Bugs should always be submitted via the CPAN bug tracker
538
539	L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=File-ShareDir>
540
541	For other issues, contact the maintainer.
542
543	=head1 AUTHOR
544
545	Adam Kennedy E<lt>adamk@cpan.orgE<gt>
546
547	=head1 SEE ALSO
548
549	L<File::HomeDir>, L<Module::Install>, L<Module::Install::Share>,
550	L<File::ShareDir::PAR>
551
552	=head1 COPYRIGHT
553
554	Copyright 2005 - 2009 Adam Kennedy.
555
556	This program is free software; you can redistribute
557	it and/or modify it under the same terms as Perl itself.
558
559	The full text of the license can be found in the
560	LICENSE file included with this module.
561
562	=cut