view release on metacpan or  search on metacpan

DoubleHelix.pm  view on Meta::CPAN

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;