#! /usr/bin/perl
print "Content-type: text/html\n\n";


if($ENV{"REQUEST_METHOD"} eq "GET")
{
  $querystring= $ENV{"QUERY_STRING"};		
}
elsif($ENV{"REQUEST_METHOD"} eq "POST")
{
  read(STDIN, $querystring, $ENV{"CONTENT_LENGTH"});
}
else
{
  print "Offline execution detected\n";
  print "Please enter a querystring.\n";
  $querystring = <>;
  chomp $querystring;
  print "== querystring accepted == HTML output follows ==\n";
}

@nameValuePairs = split(/&/, $querystring);	#step 1.
foreach $pair (@nameValuePairs)
{
  ($name, $value) = split(/=/, $pair);		#step 2.
  $name =~tr/+/ /;                                 #step 3.
  $name =~s/%([\da-fA-F]{2})/pack("C",hex($1))/eg; #step 3.
  $value =~tr/+/ /;                                #step 3.
  $value =~s/%([\da-fA-F]{2})/pack("C",hex($1))/eg;#step 3.
  $value =~s/[<>]//g;					#precaution
  
  if(exists $formHash{$name})	#Improved step 4.
  {
    $formHash{$name} = $formHash{$name}.";".$value;
  }
  else
  {
    $formHash{$name} = $value;
  }   	
}

#################################################################
# code for decoding input $datastring into %formHash            #
#################################################################

### Some global variables ###################

if($formHash{"request"} eq "count"){&count;}
else{&welcome_page;}
################################

sub welcome_page {
  printForm("", "");
}

sub printForm{
 my ($x, $y) = @_;

 print <<PAGE;
 <html><head><title>Multigram Frequency Count</title></head>
  <body>
   <h2>Count Frequencies and multigrams of some text</h2>
    <form action="$ENV{SCRIPT_NAME}" method="GET">
     <input type="hidden" name="request" value="count">
     <textarea name="txt" rows="15" cols="80">$x</textarea><br />
     <input type="submit" value="Count frequencies and multigrams of letters in text">
    </form>
    $y
 </body>
</html>
PAGE
}

#########

sub count {
 my $t = $formHash{"txt"};
 if(!($t=~/\w/)){$t="Please type in some text.";}
 my $ans=getResult($t);
 printForm($t, $ans);
}
#####
sub errorPage {
 my $message = $_[0]; # the incoming parameter, store in localized variable
 print<<ALL;
 <html>
 <head>
  <title>Error encountered</title>
 </head>
 <body>
  <h1>Error Encountered</h1>
  <h3>$message</h3>
  Please try again, or report the problem to the webmaster.
 </body>
 </html>
ALL
 exit;
}


### Statistical count on monograms, digrams, trigrams.

sub getResult{
  my ($txt)=@_;
  my $ans="<pre>\n";
$digramsDisplayed=20;
$trigramsDisplayed=5;
$quadgramsDisplayed=5;
$pentagramsDisplayed=5;

%freq=(
a=>.082,
b=>.015,
c=>.028,
d=>.043,
e=>.127,
f=>.022,
g=>.020,
h=>.061,
i=>.070,
j=>.002,
k=>.008,
l=>.040,
m=>.024,
n=>.067,
o=>.075,
p=>.019,
q=>.001,
r=>.060,
s=>.063,
t=>.091,
u=>.028,
v=>.010,
w=>.023,
x=>.001,
y=>.020,
z=>.001
);

@sorted = sort{$freq{$b}<=>$freq{$a}}(keys %freq);

$ansNotused.= "This program shows character frequency counts,\n".
  "and up to $digramsDisplayed digrams".
  " and up to $trigramsDisplayed trigrams,".
 " $quadgramsDisplayed quadgrams,".
 " $pentagramsDisplayed pentagrams.\n";


my $p=uc $txt;
$p=~s/[^A-Z]//g;
@p=split(//,$p);

$ans.= "Cipher stream of ". (scalar @p). " characters read.\n";
$ans.= ("-"x40)."\n";


$ans.=printMonograms($p);
$ans.=printMultigrams(2,$digramsDisplayed,"digram",$p);
$ans.=printMultigrams(3,$trigramsDisplayed,"trigram",$p);
$ans.=printMultigrams(4,$quadgramsDisplayed,"quadgram",$p);
$ans.=printMultigrams(5,$pentagramsDisplayed,"pentagram",$p);

return $ans;
}


sub printMonograms{
  my ($p) = @_;
  my $len = length $p;
  my %f = ();
  my @a = ('A'..'Z');
  my @t;
  my ($c, $i);
  my $ans="";
  foreach $c (@a){
    @t = ($p=~/$c/g);
    $f{$c} = (scalar @t)/$len;
  }
  my @k = sort{$f{$b}<=>$f{$a}} @a;
  $ans.= "Monogram frequencies:\n";
  $ans.= "Observed      English\n";
  for($i=0; $i<26; $i++){
    $ans.=sprintf ("%1s %.3f       %1s %.3f\n",
      $k[$i], $f{$k[$i]}, $sorted[$i], $freq{$sorted[$i]});
  }
  return $ans;
}

sub printMultigrams{
  my ($x,$disp,$word, $p) = @_;
  my $len = length $p;
  my %f=();
  my ($i,$c);
  my $ans="";
  for($i=0;$i<=$len-$x;$i++){
    $c = substr($p,$i,$x);
    if(exists $f{$c}){$f{$c}++;}else{$f{$c}=1;}
  }
  my @k = sort{$f{$b}<=>$f{$a}} (keys %f);
  $ans.= "----------------------------\nTop $disp $word counts:\n----------------------------\n";
  if($disp > scalar @k){$disp = scalar @k;}
  $disp--; ## last index
  if($f{$k[$disp]}>1){
    while(($disp<$#k)&&($f{$k[$disp+1]}==$f{$k[$disp]})){
      $disp++
    }
  }
  if($f{$k[$disp]}==1){
    while(($f{$k[$disp]}==1)&&($disp>=0)){$disp--;}
  }
  foreach $c (@k[0..$disp]){
    $ans.=sprintf( "%1s %d\n", $c, $f{$c});
  }
  return $ans;
}
