view release on metacpan or  search on metacpan

lib/Acme/Pills.pm  view on Meta::CPAN

package Acme::Pills;

use strict;
use IO::File;
use File::Spec;

use vars '$VERSION';
$VERSION = '0.01';

sub import
{
	unshift @INC, \&fine_products;
}

sub fine_products
{
	my ($code, $module) = @_;
	(my $modfile        = $module . '.pm') =~ s{::}{/}g;
	my $fh              = bad_product()->( $module, $modfile );

	return unless $fh;

	$INC{$modfile} = 1;
	$fh->seek( 0, 0 );

	return $fh;
}

sub empty_box
{
	my ($module, $modpath) = @_;

	return _fake_module_fh(<<END_MODULE);
package $module;

sub DESTROY {}

sub AUTOLOAD
{
	return 1;
}

1;
END_MODULE

}

sub breaks_when_needed
{
	my ($module, $modfile) = @_;

	my    $file;
	local @INC = @INC;

	for my $path (@INC)
	{
		local @ARGV = File::Spec->catfile( $path, $modfile );
		next unless -e $ARGV[0];

		$file = do { local $/; <> } or return;
	}

	return unless $file;

	$file =~ s/(while\s*\()/$1 Acme::Incorporated::breaks() && /g;
	$file =~ s[(for[^;]+{)(\s*)]
		      [$1$2last unless Acme::Incorporated::breaks();$2]xsg;

	return _fake_module_fh( $file );
}

sub out_of_stock
{
	my ($module, $modfile) = @_;

	return _fake_module_fh(<<END_MODULE);
print "$module is out of stock at the moment.\n"
delete \$INC{$modfile};
END_MODULE

}

sub _fake_module_fh
{
	my $text = shift;
	my $fh   = IO::File->new_tmpfile() or return;

	$fh->print( $text );
	$fh->seek( 0, 0 );

	return $fh;
}

sub bad_product
{
	my $weight = rand();

	return \&empty_box          if $weight <= 0.10;
	return \&breaks_when_needed if $weight <= 0.20;
	return \&out_of_stock       if $weight <= 0.30;

	return sub {};
}

sub breaks
{
	return rand() <= 0.10;
}

1;
__END__

=head1 NAME

Acme, Inc. produces fine and wonderful products for your pleasure. 

=head1 SYNOPSIS