File Coverage

blib/lib/Data/Package/File.pm

Criterion	Covered	Total	%
statement	41	57	71.9
branch	4	14	28.5
condition	2	3	66.6
subroutine	14	17	82.3
pod	2	3	66.6
total	63	94	67.0

package Data::Package::File;

=pod

=head1 NAME

Data::Package::File - Data::Package base class for data stored in a local file

=head1 DESCRIPTION

The B base class provides a series of additional
methods that ease the development of L classes that source
their data from files on the local filesystem.

=head1 METHODS

B extends the interface of L with a few
additional methods.

=cut

use 5.005;
use strict;
use Data::Package    ();
use File::Spec       ();
use IO::File         ();
use Params::Util     qw{ _STRING };
use Class::Inspector ();
use File::ShareDir   ();

use vars qw{$VERSION @ISA};
BEGIN {
	$VERSION = '1.05';
	@ISA     = 'Data::Package';
}





#####################################################################
# Data::File::Package Methods

# Apply checks to the class
sub import {
	my $class = shift;

	# The method should give us a file name as a string
	my $file  = $class->file;
	unless ( defined _STRING($file) ) {
		die "The ->file method for data package $class did not return a string";
	}

	# Check that the file is absolute, exists and is readable
	unless ( File::Spec->file_name_is_absolute($file) ) {
		die "The data file path for $class is not an absolute path ($file)";
	}
	unless ( -f $file ) {
		die "The data file for $class does not exist ($file)";
	}
	unless ( -r $file ) {
		die "The data file for $class does not have read permissions ($file)";
	}

	return 1;
}

=pod

=head1 file

  my $to_load = My::Data:Class->file;

The C method can be defined by a L subclass,
and should return an absolute path for a file reable by the current user,
in the form of a simple scalar string.

At load-time, this value will be checked for correctness, and if the value
returned is invalid, loading of the file will fail.

=cut

sub file {
	my $class = ref($_[0]) || $_[0];

	# Support the dist_file method
	my @dist_file = $class->dist_file;
	if ( @dist_file ) {
		return File::Spec->rel2abs(
			File::ShareDir::dist_file( @dist_file )
		)
	}

	# Support the module_file method
	my @module_file = $class->module_file;
	if ( @module_file ) {
		if ( @module_file == 1 ) {
			unshift @module_file, $class;
		}
		return File::Spec->rel2abs(
			File::ShareDir::module_file( @module_file )
		)
	}

	return undef;
}

=pod

=head2 dist_file

  package My::Dist::DataSubclass;

  sub dist_file {
      return ( 'My-Dist', 'data.txt' );
  }

The C method is one of two that provide integration with
L. Instead of defining a C method, you can
instead define C.

If C exists, and any values are returned, those values
will be passed through to the C function,
with the resulting value converted to an absolute path (if needed)
and used to provide the appropriate object to the caller.

Should return a list with two values, the name of the distribution
the package is in, and the file path within the package's F
directory.

=cut

sub dist_file {
	return ();
}


=pod

=head2 module_file

  package My::DataClass;

  # Get a file from this module
  sub module_file {
      return 'data.txt';
  }

  # Get a file for another (loaded) module
  sub module_file {
      return ( 'My::RelatedClass', 'data.txt' );
  }

The C method is one of two that provide integration with
L. Instead of defining a C method, you can
instead define C.

If C exists, and any values are returned, those values
will be passed through to the C function,
with the resulting value converted to an absolute path (if needed)
and used to provide the appropriate object to the caller.

Should return a list with two values, the module to get the shared files
for, and the the file path within the module's F directory.

If C returns a single value, the name of the class will
be automatically prepended as the module name.

=cut

sub module_file {
	return ();
}





#####################################################################
# Add support for IO::File, Path::Class and URI

sub __as_IO_File {
	IO::File->new( $_[0]->file );
}

sub __as_Path_Class_File {
	require Path::Class;
	Path::Class::file( $_[0]->file );
}

sub __as_URI_file {
	require URI::file;
	URI::file->new( $_[0]->file );
}

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 COPYRIGHT

Copyright 2007 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