File Coverage

blib/lib/Acme/DoubleHelix.pm

Criterion	Covered	Total	%
statement	7	15	46.6
branch			n/a
condition			n/a
subroutine	2	3	66.6
pod	1	3	33.3
total	10	21	47.6

package Acme::DoubleHelix;
our $VERSION = '0.01';

my $promoter ='
 CG
T--A
A---T
A----T
 C----G
  T----A
   A---T
    G--C
     AT
     CG
    C--G
   G---C
  G----C
 C----G
A----T
C---G
G--C
 TA
';

my (%dict)    = qw/00 A 01 C 10 G 11 T/;
my (%inverse) = qw/A 00 C 01 G 10 T 11/;
my (%spouse)   = qw/A T T A C G G C/;


sub encode($) {
    local $_ = unpack "b*", shift;
    my (@offset) = qw/1 0 0 0 1 2 3 4 5 5 4 3 2 1 0 0 0 1/;
    my (@dist)   = qw/0 2 3 4 4 4 3 2 0 0 2 3 4 4 4 3 2 0/;
    s/(..)/$dict{$1}/g;
    my ($dh, $i);
    for my $base (split //){
	$dh .= join q//,
	q/ /x$offset[($i%@offset)], "$base", q/-/x$dist[($i++%@dist)], "$spouse{$base}\n";
    }
    $promoter.$dh;
}

sub decode($) {
    local $_ = shift;
    s/^$promoter//;
    s/.*([ACGT]).*[ACGT]\n/$1/gm;
    s/(.)/$inverse{$1}/ge;
    pack "b*", $_;
}

sub promoted($) { $_[0] =~ /^$promoter/ }

open 0 or print "Can't open '$0'\n" and exit;
(my $sequence = join "", <0>) =~ s/.*^\s*use\s+Acme::DoubleHelix\s*;\n//sm;

do { eval decode $sequence; exit } if promoted $sequence;

open 0, ">$0" or print "Cannot encode '$0'\n" and exit;
print {0} "use Acme::DoubleHelix;\n", encode $sequence and exit;


1;
__END__