File Coverage

blib/lib/Acme/DotDotGone.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	14	16	87.5
condition	0	3	0.0
subroutine	9	9	100.0
pod			n/a
total	63	68	92.6

package Acme::DotDotGone;

use 5.006;
use strict;
use warnings;

our $VERSION = '1.01';

our %dots;
BEGIN {
 	%dots = (
		toDots => sub {
			join ' ', map { $dots{$_}() } split '', unpack "b*", shift;
		},
		fromDots => sub {
			pack "b*", join '', map { $dots{$_}() } split ' ', shift;
		},
		'.' => sub { 0 },
		'..' => sub { 1 },
		0 => sub { '.' },
		1 => sub { '..' },
		stderr => sub { print @_ }
	);
	close STDERR; # *\o/*
}

sub import {
	open FH, "<$0";

	my $reg = $_[1]
		? qr/(.*)\1^\s*use\s+Acme::DotDotGone\s+($_[1]);\n/
		: qr/.*^\s*use\s+Acme::DotDotGone;\n/;

	($_[2] = (join '', )) =~ s/$reg//sm;
	$_[2] = $1 . $_[2] if $1;

	close FH;

	($_[2], $_[3], $_[4]) = (($2)
		? ($2 eq 'dot')
			? sub {
				$_[1] = $dots{toDots}($_[0]);
				$_[0], $_[1], $_[1];
			}
			: sub {
				$_[1] = $dots{fromDots}($_[0]);
				$_[1], $_[0], $_[1];
			}
		: ($_[2] =~ m/[a-zA-Z]/)
			? sub {
				undef
			}
			: sub {
				$_[1] = $dots{fromDots}($_[0]);
				$_[1], $_[0];
			}
	)->($_[2]);

	if ($_[4]) {
		open FH, ">$0" or print "Cannot encode. '$0'\n" and exit;
		print FH "use Acme::DotDotGone;\n";
		print FH $_[4];
		close FH;
	}

	do { eval "$_[2]"; $dots{stderr}($@); } if $_[2];
}

1;

__END__