package Test::MockFile::Light;

use warnings;
use strict;

use v5.8.0;

=head1 NAME

Test::MockFile::Light - provides a mechanism for mocking files to support
testing file operations in a way transparent to the file-processing-module(s).

=head1 VERSION

Version 0.2.0

=cut

use version; our $VERSION = qv('0.2.0');

use Carp;

=head1 SYNOPSIS

	use Test::MockFile::Light module => 'Foo::Bar';
	# or
	use Test::MockFile::Light modules => [qw/Foo::Bar Foo::Baz/];
	# or
	# shorthand for
	# use Test::MockFile::Light module => __PACKAGE__;
	use Test::MockFile::Light;

	# to define a mocker to replace a file;
	define_file_mocker($file_name, $file_content);
	# or
	# if the content is empty;
	define_file_mocker($file_name);

	# to undefine (delete) a mocker;
	undefine_file_mocker($file_name);

	# to read the content;
	$file_content = get_file_mocker_content($file_name);

=head1 DESCRIPTION

This module was created to help testing of basic file operations. This module
does not mimic files for every module, but the ones declared in the use
statement for this module.

There are two reasons why there is a "Light" on the module name;

=over

=item *

This module overrides the open builtin in the scope of the declared modules.
Since the open() builtin is a complex function, just the basic use is mimiced.

=item *

During the testing of this module, only the use of reading, writing and
appending to file is tested. Although, it is expected that other file
operations like seek, truncate, ... can also be used with the module.
The reason is that still a file, an in-memory file, is used on the back-end.

=back

B<Note:> It is important that the statement C<use Test::MockFile::Light module =E<gt> 'Foo::Bar'> should come before C<use Foo::Bar> or C<use_ok('Foo::Bar')>.

=head1 EXAMPLES

=head2 Example of mimicing a file and reading it

assume that the content of Foo/Bar.pm is;

	package Foo::Bar;

	sub calculate_the_sum_of_numbers_inside {
		my ($class, $file_name) = @_;

		my $sum = 0;

		open my $fh, '<', $file_name or die $!;

		while (defined(my $line = <$fh>)) {
			chomp $line;
			$sum += $line;
		}

		close $fh;

		return $sum;
	}

	1;

... and inside a test script;

	use warnings;
	use strict;

	use Test::Exception;
	use Test::More tests => 3;

	# We declare that the module Foo::Bar will not
	# access the file system, but the mock-up.
	use Test::MockFile::Light module => 'Foo::Bar';

	use_ok('Foo::Bar');

	my $file_name = 'some_file_name';
	my $file_content = "1\n2\n3";
	my $expected_result = 1+2+3;

	# Since, we have not defined a file mocker yet,
	# it will be like there is no such file as the given name.
	throws_ok {
		Foo::Bar->calculate_the_sum_of_numbers_inside($file_name);
	} qr/No such file or directory/
	, 'attempting to read an unexisting file';

	define_file_mocker($file_name, $file_content);

	# We defined a file mocker above;
	# now the Foo::Bar module can access its content.
	my $result = Foo::Bar->calculate_the_sum_of_numbers_inside($file_name);
	is($result, $expected_result, 'some test messages');

=head2 Example of mimicing a file and writing onto it

assume that the content of Foo/Bar.pm is;

	package Foo::Bar;

	sub write_the_square_into {
		my ($class, $file_name, $number) = @_;

		open my $fh, '>>', $file_name or die $!;

		print $fh $number**2, "\n";

		close $fh;
	}

	1;

... and inside a test script;

	use warnings;
	use strict;

	use Test::Exception;
	use Test::More tests => 2;

	# We declare that the module Foo::Bar will not
	# access the file system, but the mock-up.
	use Test::MockFile::Light module => 'Foo::Bar';

	use_ok('Foo::Bar');

	my $file_name = 'some_file_name';
	my $expected_result = "1\n4\n9\n";

	Foo::Bar->write_the_square_into($file_name, 1);
	Foo::Bar->write_the_square_into($file_name, 2);
	Foo::Bar->write_the_square_into($file_name, 3);

	is (get_file_mocker_content($file_name), $expected_result, 'some message');

=cut

my %file;

=head1 FUNCTIONS

=head2 C<define_file_mocker($file_name, $file_content)>

This subroutine defines a new file mocker.
The modules which are declared in the use statement of Test::MockFile::Light
will access this mocker instead of the file in the file system.
If a mocker is already defined with the same name, then the content is
overriden.

The subroutine takes two arguments; C<$file_name> and C<$file_content>. The
second argument is optional, in which case the content is assumed to be the
empty string ''.

=cut

sub define_file_mocker {
	my ($name, $content) = @_;

	if (! defined $name) {
		croak 'The first parameter should be the name of the file to be mocked';
	}

	$content ||= '';

	$file{$name} = $content;
}

=head2 C<undefine_file_mocker($file_name)>

This subroutine deletes a file mocker, defined via C<define_file_mocker()>.
If the file does not exist, the subroutine does nothing.

=cut

sub undefine_file_mocker {
	my ($name, $content) = @_;

	if (! defined $name) {
		croak 'The first parameter should be the name of the file to be mocked';
	}

	delete $file{$name};
}

=head2 C<get_file_mocker_content($file_name)>

This subroutine gets the content of a file in the mock-up file system. The
aim of this subroutine is to compare the content with the expectation.
This can be utilized in test subroutines (like is(), etc...)

=cut

sub get_file_mocker_content {
	my ($name, $content) = @_;

	if (! defined $name) {
		croak 'The first parameter should be the name of the file mocker';
	}

	if (! defined $file{$name}) {
		croak 'No such file or directory';
	}

	return $file{$name};
}

# ---

sub import {
	my ($class, %arg) = @_;

	my $package = caller;

	_export_functions_to($package);

	my @modules = defined $arg{modules} ? @{$arg{modules}} : ();

	if (defined $arg{module}) {
		push @modules, $arg{module};
	}

	if (scalar @modules == 0) {
		push @modules, $package;
	}

	_override_open_builtin_for(@modules);
}

# ---

##
# Usage       : _export_functions_to($caller);
# Description : Exports the module subroutines to the caller package.
# Parameters  : The name of the caller module.
# Returns     : -
# Throws      : -
sub _export_functions_to {
	my ($package) = @_;

	no strict 'refs';

	*{"$package\::define_file_mocker"} = \&define_file_mocker;

	*{"$package\::undefine_file_mocker"} = \&undefine_file_mocker;

	*{"$package\::get_file_mocker_content"} = \&get_file_mocker_content;
}

# ---

my $mode_and_name_parser = qr/
	^
	\s*
	(|<|>|>>|\+<|\+>|\+>>)	# the mode
	\s*
	(\w.*?)					# the file name
	\s*
	$
/x;

##
# Usage       : _override_open_builtin_for( qw/main Foo::Bar/ );
# Description : Overrides the open builtin for the module given as argument.
# Parameters  : The list of modules
# Returns     : -
# Throws      : -
sub _override_open_builtin_for {
	my (@modules) = @_;

	for my $module (@modules) {

		no strict 'refs';

		*{"$module\::open"} = sub (\[*$]$;$) {
			my ($fh, $mode, $name) = @_;

			$name ||= '';

			my $compound = "$mode $name";

			if ($compound =~ $mode_and_name_parser) {
				$mode = $1 || '<';
				$name = $2;
			}
			else {
				croak 'Unexpected open() parameters for file mocking';
			}

			if ($mode eq '<' && ! defined $file{$name}) {
				$! = 2;

				return 0;
			}

			return open $$fh, $mode, \$file{$name};
		};
	}
}

=head1 AUTHOR

Oguz Mut, C<< <mutoguz at gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-test-mockfile-light at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/mutoguz/ReportBug.html?Queue=Test-MockFile-Light>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Test::MockFile::Light

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Test-MockFile-Light>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Test-MockFile-Light>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/mutoguz/Bugs.html?Dist=Test-MockFile-Light>

=item * Search CPAN

L<http://search.cpan.org/dist/Test-MockFile-Light>

=back

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2007 Oguz Mut, all rights reserved.

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

=cut

1; # End of Test::MockFile::Light
