#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);

my $sequence = "";

# read data from our data.txt file (with our own demo sequence)
open( INFILE, "data.txt");
 while(<infile>){
 my $line = $_;
 chomp $line;
 $sequence = $sequence . $line;
 }
close(INFILE);

# create a CGI object in order to create the HTML file
my $q = new CGI;

# read the parameters sent thru the form and do necessary initializations
my $new_seq = $q->param("sequence") || "No Sequence";
my $action = $q->param("action");
my $actions = { 'all' => [0], 'length' => [0], 'monomers' => [0], 'dimers' => [0], 'trimers' => [0], 'fourmers' => [0] };

$actions->{'all'}->[0]++ unless defined $actions->{$action};
$actions->{$action}->[0]++ if defined $actions->{$action};

$new_seq =~ s/[\s\n\t]+//g unless $new_seq =~ /No Sequence/;
$new_seq = "No Sequence" if $new_seq =~ /[^AaCcTtGg]/;
$sequence = $new_seq unless $new_seq =~ /No Sequence/ ;
$sequence = uc $sequence;

# define the monomers
my $aw_monomers = { 'A' => [0], 'G' => [0], 'C' => [0], 'T' => [0] };

# define the dimers
my $aw_dimers = { 'AA' => [0], 'AC' => [0], 'AT' => [0], 'AG' => [0],
                                'GC' => [0], 'GT' => [0], 'GG' => [0], 'GA' => [0],
                                'CT' => [0], 'CG' => [0], 'CC' => [0], 'CA' => [0],
                                'TG' => [0], 'TC' => [0], 'TT' => [0], 'TA' => [0] };

# define the trimers
my $aw_trimers = {
                                'AAA' => [0], 'AAC' => [0], 'AAT' => [0], 'AAG' => [0],
                                'AGC' => [0], 'AGT' => [0], 'AGG' => [0], 'AGA' => [0],
                                'ACT' => [0], 'ACG' => [0], 'ACC' => [0], 'ACA' => [0],
                                'ATG' => [0], 'ATC' => [0], 'ATT' => [0], 'ATA' => [0],

                                'CAA' => [0], 'CAC' => [0], 'CAT' => [0], 'CAG' => [0],
                                'CGC' => [0], 'CGT' => [0], 'CGG' => [0], 'CGA' => [0],
                                'CCT' => [0], 'CCG' => [0], 'CCC' => [0], 'CCA' => [0],
                                'CTG' => [0], 'CTC' => [0], 'CTT' => [0], 'CTA' => [0],

                                'GAA' => [0], 'GAC' => [0], 'GAT' => [0], 'GAG' => [0],
                                'GGC' => [0], 'GGT' => [0], 'GGG' => [0], 'GGA' => [0],
                                'GCT' => [0], 'GCG' => [0], 'GCC' => [0], 'GCA' => [0],
                                'GTG' => [0], 'GTC' => [0], 'GTT' => [0], 'GTA' => [0],

                                'TAA' => [0], 'TAC' => [0], 'TAT' => [0], 'TAG' => [0],
                                'TGC' => [0], 'TGT' => [0], 'TGG' => [0], 'TGA' => [0],
                                'TCT' => [0], 'TCG' => [0], 'TCC' => [0], 'TCA' => [0],
                                'TTG' => [0], 'TTC' => [0], 'TTT' => [0], 'TTA' => [0] };

# define the fourmers
my $aw_fourmers = {
                                'GCGC' => [0], 'CGCG' => [0], 'AGAG' => [0], 'GAGA' => [0],
                                'TGTG' => [0], 'GTGT' => [0], 'TCTC' => [0], 'CTCT' => [0],
                                'ACAC' => [0], 'CACA' => [0], 'TATA' => [0], 'ATAT' => [0] };

# start printing the HTML file
print $q->header();

# print the sequence that has been pasted
$q->print("<html><head><title>Sequence Results </title></head><body onLoad='javascript:focus()'>");
$q->print("<table border=0 cellpadding=3 cellspacing=2 width=\"700\"><tr width='650'><td width=\"650\">");

my $pp = $sequence;
$pp =~ s/(\w{40})/$1\n/g;
$q->print("$pp \n");
undef $pp;
$q->print("</td></tr></table>");

# parameters initialization
my $size = length $sequence;

my $no_of_dimers = 0;
my $no_of_trimers = 0;
my $no_of_As_and_Ts = 0;
my $no_of_Cs_and_Gs = 0;

#compute the requested parameters

for( my $i=0; $i<$size; $i++){
 my $base = substr( $sequence, $i, 1 );
 my $dimer = substr( $sequence, $i, 2 );
 my $trimer = substr( $sequence, $i, 3 );
 my $fourmer = substr( $sequence, $i, 4 );

                $aw_monomers->{$base}->[0]++ if defined $aw_monomers->{$base};
                $aw_dimers->{$dimer}->[0]++ if defined $aw_dimers->{$dimer};
                $aw_trimers->{$trimer}->[0]++ if defined $aw_trimers->{$trimer};
                $aw_fourmers->{$fourmer}->[0]++ if defined $aw_fourmers->{$fourmer};

}

# print the [length] and/or [monomers] and/or [dimers] and/or [trimers] and/or [fourmers]

&showLength($size) if ($actions->{'length'}->[0] || $actions->{'all'}->[0]);
&showMonomers($aw_monomers) if ($actions->{'monomers'}->[0] || $actions->{'all'}->[0]);
&showDimers($aw_dimers) if ($actions->{'dimers'}->[0] || $actions->{'all'}->[0]);
&showTrimers($aw_trimers) if ($actions->{'trimers'}->[0] || $actions->{'all'}->[0]);
&showFourmers($aw_fourmers) if ($actions->{'fourmers'}->[0] || $actions->{'all'}->[0]);

# close the HTML file
$q->print("</body></html>");

#__subs__#

sub showMonomers{
my $aw_monomers = shift;

foreach my $monos (sort keys %$aw_monomers){
 $q->print("$monos\t $aw_monomers->{$monos}->[0] \n");
 };

$no_of_As_and_Ts = $aw_monomers->{'A'}->[0] + $aw_monomers->{'T'}->[0];
$no_of_Cs_and_Gs = $aw_monomers->{'G'}->[0] + $aw_monomers->{'C'}->[0];

my $ratio_of_As_and_Ts = sprintf("%d.02%d", 100 * $no_of_As_and_Ts / $size);
my $ratio_of_Cs_and_Gs = sprintf("%d.02%d", 100 * $no_of_Cs_and_Gs / $size);

$q->print("The number of As and Ts is: $no_of_As_and_Ts \n");
 $q->print("The number of Cs and Gs is: $no_of_Cs_and_Gs \n");
 $q->print("The ratio of As and Ts is: $ratio_of_As_and_Ts% \n");
 $q->print("The ratio of Cs and Gs is: $ratio_of_Cs_and_Gs% \n");

return;
}

sub showDimers{
my $aw_dimers = shift;

foreach my $duos (sort keys %$aw_dimers){
 $q->print("$duos $aw_dimers->{$duos}->[0] \n");
 };

map{$no_of_dimers = $no_of_dimers + $aw_dimers->{$_}->[0]} (keys %$aw_dimers);
$q->print("The number of dimers is: $no_of_dimers \n");

return;
}

sub showTrimers{
my $aw_trimers = shift;

foreach my $trios (sort keys %$aw_trimers){
 $q->print("$trios\t $aw_trimers->{$trios}->[0] \n");
 };

map{$no_of_trimers = $no_of_trimers + $aw_trimers->{$_}->[0]} (keys %$aw_trimers);
$q->print("The number of trimers is: $no_of_trimers \n");

return;
}

sub showFourmers{
my $aw_fourmers = shift;

foreach my $quatros (sort keys %$aw_fourmers){
 $q->print("$quatros\t $aw_fourmers->{$quatros}->[0] \n");
 };

return;
}

sub showLength{
my $size = shift;
$q->print("The length of the sequence is: $size \n");

return;
}

</pre>