#!/usr/bin/perl -T -w

#############################################################################
#                                                                           #
# This program is free software; you can redistribute it and/or             #
# modify it under the terms of the GNU General Public License               #
# as published by the Free Software Foundation; either version 2            #
# of the License, or (at your option) any later version.                    #
#                                                                           #
# This program is distributed in the hope that it will be useful,           #
# but WITHOUT ANY WARRANTY; without even the implied warranty of            #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the             #
# GNU General Public License for more details.                              #
#                                                                           #
# You should have received a copy of the GNU General Public License         #
# along with this program; if not, write to the Free Software Foundation,   #
# Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.           #
#############################################################################

use strict;
use utf8;
use lib '../lib/';
use Web::Terminal::Settings;
use Web::Terminal::Dispatcher;
#$Web::Terminal::Settings::port=2058;
#push (@INC, "$wwwpath$htmlpath$project");

my $MAX_SIZE_UPLOAD = 64;
use CGI qw(:standard);
if ($MAX_SIZE_UPLOAD) { $CGI::POST_MAX=1024 * $MAX_SIZE_UPLOAD; }
use CGI::Carp qw(fatalsToBrowser);
use HTML::Entities;

#CGI::nph();   # Treat script as a non-parsed-header script
$ENV{PATH} = ""; # no PATH should be needed
$ENV{SAFE_MODE}=1;

my $query=new CGI;

my $sessionid=$query->param("sessionid");

my $motd='';
if (not $sessionid) {
my $nid=crypt(rand(),'WV');
$nid=~tr/.\//WV/;
$nid=~s/^WV//;
my $now=time()-1159056000; # 36 year, 275 days offset
$sessionid=$nid.$now;
$motd='
<p class="warning">Please test the <em><a
href="http://feather.perl6.nl:8080/runpugs/">development version</a></em> of
<tt>runpugs</tt>, now with AJAX and mod_perl.</p> 
';

}

my $access_OK=1; # no restrictions

#my $lang_charset = 'iso-8859-1';
my $lang_charset = 'utf-8';

# once we print the header, we don't want to do it again if there's an error
my $headerprinted = 0;
my $validsession = 0;

my $ip=$ENV{'REMOTE_ADDR'};
#my $ip="127.0.0.".int(rand(100));
#if ($ip eq '86.0.200.34') {
#$ip='127.'.int(rand(100)).'.'.int(rand(100)).'.'.int(rand(100));
#}
    my $prompt=$Web::Terminal::Settings::prompt;
    my $allinone=1;
######### MAIN SITEMANAGER PROGRAM ###################

if ( $query->param()) {      # an action has been chosen

    my $cmd='';
    if ($allinone==1) {
    $cmd=$query->param("cmd");    
    my @cmdlines=split("\n",$cmd);
        for my $cmdline (reverse @cmdlines) {
            $cmdline=~/^\s*$/ && next;
            $cmdline=~/$Web::Terminal::Settings::prompt_pattern/
            && do {
                $cmd=$cmdline;
                $cmd=~s/$Web::Terminal::Settings::prompt_pattern//;
                chomp $cmd;
                last;
        };
        }
    } else {
    $cmd=$query->param("cmdline");
    }
    my $action =  $query->param("action")||'runpugs';
    if ($action =~ /^(\w+)$/) {
    	$action = $1;
    	if ($access_OK) {
	        if ($action eq "runpugs") {
		        &runpugs($query,$cmd,$sessionid,$ip);
	        } 
        } else {
            &runpugs($query,'init',$sessionid,$ip);
        }
    } else {            # no action has been taken, display login page
       my $warning_message="Action has illegal chars: $action";
       &runpugs($query,'init',$sessionid,$ip);
    }
} else {
	 &runpugs($query,'',$sessionid,$ip);
}
###################### END MAIN ##############################
=pod
runpugs receives a command and a session id and passes it on to the Dispatcher.
It returns the result
For the easy, simple version, the command is the last non-blank line of the form.
=cut

sub runpugs {
    my $query=shift;
    my $cmd=shift;
    my $sessionid=shift;
    my $ip=shift;
    my $dev=$query->param('reldev')||0;
    $dev=$dev*1;
    my $devc='';
    my $relc='checked';
    if($dev==1) {
        $devc='checked';
        $relc='';
        }
    my $ia=$query->param('ia');
    if (not defined $ia) {$ia=1}
    my $interactive=$ia*1;
    my $html='';
    if ($interactive==1) {
    my $clear=0;
    my $nprompt=$query->param('prompt')||$prompt;
    my $preply='';    
    if($allinone==0 and $query->param('output')) {
        $preply=$query->param('output');
    } elsif ($allinone==1 and $query->param('cmd')) {
    $preply=$query->param('cmd');
    }
    my $reply=$Web::Terminal::Settings::prompt;
    my @history=();
    my $prevcmd='';
    my $testing=0;
    if ($testing==1) {
        $reply = "Sorry, runpugs is not available at the moment.";
    } else {
        if(not $query->param('history') or ($query->param('history') eq '')) {
#            $cmd=~s/^.+?${Web::Terminal::Settings::prompt_pattern}/$1/s;
        } else {
#            $cmd=$Web::Terminal::Settings::prompt;
#            $cmd.=$query->param('history');
            $cmd=$query->param('history');
        }
        if ($cmd=~/clear/) {
        $clear=1;
            $cmd='';
            $preply='';
        } elsif ($cmd!~/^\p{IsASCII}*$/) { #NO UNICODE!
            $cmd='';
            $reply = "Sorry, Unicode is not yet supported.\n".$Web::Terminal::Settings::prompt;
        } else {
            if ($cmd=~/>\s+(\:*help)\b/) {
                $cmd=~s/$1/:h/;
            } elsif ($cmd=~/>\s+(\:*(quit|bye))\b/) {
                $cmd=~s/$1/:q/;
            } 
            ($reply, $nprompt, my $histref) = &Web::Terminal::Dispatcher::send($sessionid,$ip,$dev,$interactive,$cmd);
            if (defined $histref) {
                @history=@{$histref};
                $prevcmd=$history[-1];
            }
            #$cmd=$prompt.$history[-1];
            $prompt=$nprompt;
            #$reply="\n".$reply.$prompt;
        }
    }
    my $npromptw=HTML::Entities::encode_entities($nprompt);
    my $replyw="$preply$prompt$prevcmd\n$reply";
    if($allinone==1){
    $replyw="$preply\n$reply";
    }
    if($clear==1) {
        $replyw='';
    }
   my $nrows=scalar split("\n",$replyw); 
#    $nrows++;
     ($replyw=~/^\s*$/) && ($nrows=1);
    if ($nrows>20) {$nrows=20;}
    my $historylist="\n";
    for my $entry (@history) {
        my $entryw=HTML::Entities::encode_entities($entry);
        $historylist.='<option value="'.$entryw.'">'.$entryw.'</option>'."\n";
    }
    if ($allinone==1) {
        $replyw.=$nprompt;
    }
    open(HTML,"<../data/runpugs_cgi_bin.html");
    while(<HTML>) {
        /_HIST_/ && do {
            $html.=$historylist;
            next;
        };
        /_SKIPT_/ && ($allinone==1) && next;
        /_SKIPC_/ && ($allinone==0) && next;
    /_MOTD_/ && do {
        $html.=$motd;
            next;
                };
        s/_DEV_/$devc/;
        s/_REL_/$relc/;
    	/input.*name=\"sessionid\"/ && do {
            $html.='<input type="hidden" name="sessionid" value="'.$sessionid.'">'."\n";
            next; 
            };
        s/_PROMPTW_/$npromptw/;
=not_now        
    	/_PREPLYW_/ && do {
#            $html.=$preplyw;
            next;
    	};
        /_CMDW_/ && do {
#            chomp $html;
#            $html.=$prevcmdw."\n\n";
            next;
        };
        /_BSKIP_/ && do {
#        ($replyw=~/^\s*$/) && ($html.='<!--');
        next;
        };
        /_ESKIP_/ && do {
#        ($replyw=~/^\s*$/) && ($html.='-->');
        next;
        };
=cut
        (/_REPLYW_/ && ($allinone==0))||
        (/_ALL_/ && ($allinone==1))
        and do {
            chomp $html;
            $html.=$replyw;
            next;
        };
        /_NPROMPTW_/ && ($allinone==0) && do {
            chomp $html;
            $html.=$npromptw;
            next;
        };
        s/_NROWS_/$nrows/;
    	/([^\`\\]+$)/ && do {$html.=$1};
    }
	close HTML;

    } else { #not-interactive
    my $script=$query->param('script')||'';
            (my $reply,my $nprompt, my $histref) =
            &Web::Terminal::Dispatcher::send($sessionid,$ip,$dev,$interactive,$script);
   my $nrows=scalar split("\n",$reply); 
#    $nrows++;
     ($reply=~/^\s*$/) && ($nrows=1);
    if ($nrows>20) {$nrows=20;}
    open(HTML,"<../data/runp6script.html");
    while(<HTML>) {
        s/_DEV_/$devc/;
        s/_REL_/$relc/;
        s/_NROWS_/$nrows/;
        /_REPLYW_/ && do {
            chomp $html;
            $html.=$reply;
            next;
        };
        /_SCRIPT_/ && do {
            chomp $html;
            $html.=$script;
            next;
        };
        /([^\`\\]+$)/ && do {$html.=$1};
    }
    close HTML;
    }
	&printhttpheader();
	print $html;
}
################## END main_page ######################

################### PRINTHTTPHEADER #######################
sub printhttpheader {
     unless ($headerprinted) {
        $headerprinted=1;
         print $query->header(-pragma=>'no-cache',
                      -charset=>$lang_charset,
			      );
   }
   }
################### END PRINTHTTPHEADER #######################