index.cgi

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib '../lib';
   7 use UCW::CGI;
   8 use File::Temp;
   9 use POSIX;
  10
  11 my $src;
  12 my $example;
  13 my $trace;
  14
  15 POSIX::nice(10);
  16
  17 UCW::CGI::parse_args({
  18         'src' => { 'var' => \$src, 'multiline' => 1 },
  19         'example' => { 'var' => \$example, 'check' => '\w+' },
  20         'trace' => { 'var' => \$trace, 'check' => '[0-2]', 'default' => 0 },
  21 });
  22
  23 if ($example ne '' && open EX, "ex-$example") {
  24         local $/;
  25         undef $/;
  26         $src = <EX>;
  27         close EX;
  28 }
  29
  30 my $src_html = html_escape($src);
  31 my @trsel = map { $trace == $_ ? "selected" : "" } 0..2;
  32
  33 print <<EOF ;
  34 Content-type: text/html; charset=utf-8
  35
  36 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html40/strict.dtd">
  37 <html><head>
  38 <title>Minsk-2 Emulator</title>
  39 <link rel=stylesheet title=Default href="minsk.css" type="text/css" media=all>
  40 </head><body>
  41 <h1>Minsk-2 Emulator</h1>
  42
  43 <p id=top>(see <a href='readme.html'>instructions</a>)
  44
  45 EOF
  46
  47 if ($src ne '') {
  48         print "<h2>Output</h2>\n\n<pre id=output><code>";
  49         my $tmpf = new File::Temp();
  50         print $tmpf $src, "\n";
  51         $tmpf->flush();
  52         my $in = $tmpf->filename;
  53         open SIM, "./minsk --trace=$trace --cpu-quota=1000 --print-quota=100 <$in |" or die;
  54         while (<SIM>) {
  55                 print html_escape($_);
  56         }
  57         close SIM;
  58         print "</code></pre>\n\n";
  59 }
  60
  61 print <<EOF ;
  62
  63 <h2>Input</h2>
  64 <form action='?' method=POST accept-charset='US-ASCII UTF-8'>
  65 <textarea name=src rows=20 cols=80>$src_html</textarea>
  66 <p><button name=submit type=submit>Run</button>
  67 <select name=trace>
  68         <option $trsel[0] value=0>Tracing off</option>
  69         <option $trsel[1] value=1>Brief tracing</option>
  70         <option $trsel[2] value=2>Detailed tracing</option>
  71 </select>
  72 </form>
  73 EOF
  74
  75 print <<EOF ;
  76 <hr>
  77 <p>Written by <a href='http://mj.ucw.cz/'>Martin Mareš</a>. Version 1.0 (2010-12-27).
  78 </body></html>
  79 EOF