#!/usr/bin/env perl
#########
# fa.cgi - finite automata web engine
# $Id: fa.cgi 20288 2008-02-06 23:42:42Z mahoney $
#########
use strict;
use warnings;
use CGI qw(param);
use CGI::Carp qw(fatalsToBrowser);
use IO::All qw(io);

print "Content-type: text/html\n\n";
print page_html();
exit;

# ===========================================================

sub page_html {
  my $script           = 'fa.cgi';
  my $sample           = '_sample';
  my $page_template    = 'template.html';
  my $finite_automata  = pwd() . '/finite_automata';

  my $submit = param('submit') || '';
  my $reset = $submit =~ m/reset/;
  (my $file = param('file') || param('filesubmit') || $sample) =~ s/\.fa$//;
  $file = $sample if $reset;
  if (param('newfile')){
    ($file = param('newfile')) =~ s/\..*$//;   # remove trailing .fa extension
    $file=lc($file);                           # lowercase
    $file =~ s/[^a-z0-9_]//g;                  # only a-z 0-9 _ chars
  }
  my $fa_input_file    = $file . '.fa';
  my $fa_output_file   = $file . '.txt';
  my $fa_input = param('fa_input') || get_file($fa_input_file) || sample_fa();
  $fa_input = sample_fa() if $reset;
  for ($fa_input){
    s/\x0D\x0A|\x0D/\n/g;   # unix line endings
    s/\s*\n/\n/sg;          # no trailing whitespace (makes YAML unhappy)
  }
  $fa_input .= "\n";        # make sure it ends in a newline.

  if (param('submit') =~ m/save as _sample/){
    $file = '_sample';
    $fa_input_file = '_sample.fa';
    $fa_output_file = '_sample.txt';
  }

  put_file($fa_input_file, $fa_input);
  `$finite_automata --diagram $fa_input_file > $fa_output_file 2>&1`;
  my $fa_output = get_file($fa_output_file);

  my $choices = join ' | ', map {qq(<a href="?file=$_">$_</a>)} 
                            sort glob "*.fa";
  $choices =~ s/\.fa"/"/g;

  my %replace = ( file       => $file,
                  choices    => $choices,
                  fa_output  => $fa_output,
                  fa_input   => $fa_input,
                 );

  (my $page_html=io($page_template)->all) =~ s[\$(\w+)]
                                              [ $replace{$1} || '$' . $1 ]ge;
  if ($reset){ 
    $page_html =~ 
      s{</head>}{<meta http-equiv="refresh" content="0;url=$script"></head>};
  }
  return $page_html;
}

# Usage: $text = get_file('filename');
sub get_file {
  my ($filename) = @_;
  my $text = '';
  eval { $text = io($filename)->all };
  return $text;
}

# Usage: put_file('filename', $text);
sub put_file {
  my ($filename, $text) = @_;
  eval { io($filename)->print($text) };
}

sub sample_fa {
  return q(
#
# This is a *.fa (i.e. finite automata) definition file 
# which follows the yaml.org data format.
# The ~ character is used to refer to the empty string.
# The automata below is non-deterministic, since both
# ~ and lists of symbols are used in the transition table.
# 
start: s
accept: [ q0, r0 ]
transitions :  
  #   state x alpha -> state
  - [ s,      ~,       q0   ]
  - [ s,      ~,       r0   ]
  - [ q0,     1,       q1   ]
  - [ q1,     1,       q0   ]
  - [ r0,     [0,1],   r1   ]
  - [ r1,     [0,1],   r2   ]
  - [ r2,     [0,1],   r0   ]
tests :
  - [ yes, ~      ]
  - [ no,  00000  ]
  - [ yes, 1111   ]
  - [ no,  1010   ]
  - [ yes, 111000 ]
);
}

# Usage: $pwd = pwd;
sub pwd {
  chomp(my $pwd = `/bin/pwd`);
  return $pwd;
}