Changeset 15408 for misc/runpugs/perl

Show
Ignore:
Timestamp:
03/02/07 17:08:05 (21 months ago)
Author:
andara
Message:

[runpugs]
-refactoring Server.pm to catch race hazard in preloaded session management.
-adding testing framework.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • misc/runpugs/perl/runpugs.pl

    r14930 r15408  
    6868                last; 
    6969        }; 
     70        $cmdline=~/$Web::Terminal::Settings::quit_message|Aborted/  
     71        && do { 
     72        $cmd='clear'; 
     73        }; 
    7074        } 
    7175    my $action =  $query->param("action")||'runpugs'; 
    … …  
    9498    my $sessionid=shift; 
    9599    my $ip=shift; 
    96     my $dev=$query->param('reldev')||0; 
    97     $dev=$dev*1; 
    98     my $devc=''; 
    99     my $relc='checked'; 
     100    my $dev=$query->param('reldev');#||0; 
     101    if ($dev!=0){ 
     102    $dev=1; 
     103    } 
     104    my $devc='checked'; 
     105    my $relc=''; 
    100106    if($dev==1) { 
    101107        $devc='checked'; 
    102108        $relc=''; 
     109        } else { 
     110        $devc=''; 
     111        $relc='checked'; 
    103112        } 
    104113    my $html=''; 
    … …  
    117126            $cmd=$query->param('history'); 
    118127        } 
     128        if ($cmd=~//) {} 
    119129        if ($cmd=~/clear/) { 
    120130        $clear=1; 
    … …  
    125135            $reply = "Sorry, Unicode is not yet supported.\n".$Web::Terminal::Settings::prompt; 
    126136        } else { 
    127             if ($cmd=~/>\s+(\:*help)\b/) { 
     137            if ($cmd=~/\s*(\:*help)\b/) { 
    128138                $cmd=~s/$1/:h/; 
    129             } elsif ($cmd=~/>\s+(\:*(quit|bye))\b/) { 
     139            } elsif ($cmd=~/\s*(\:*(quit|bye))\b/) { 
    130140                $cmd=~s/$1/:q/; 
    131141            }  
    … …  
    140150    my $npromptw=HTML::Entities::encode_entities($nprompt); 
    141151#    my $replyw="$preply$prompt$prevcmd\n$reply"; 
    142 #    if($reply=~/$Web::Terminal::Dispatcher::quit_message/) { 
    143 #        $nprompt=''; 
    144 #        } 
    145152    my $replyw="$preply\n$reply"; 
    146153    if($clear==1) { 
    … …  
    156163        $historylist.='<option value="'.$entryw.'">'.$entryw.'</option>'."\n"; 
    157164    } 
     165    if($replyw!~/Leaving\ pugs\.$/) { 
    158166        $replyw.=$nprompt; 
    159     open(HTML,"<../data/runpugs_async.html"); 
     167        }  
     168 
     169    open(HTML,"<../data/runpugs.html"); 
    160170    while(<HTML>) { 
    161171        /_HIST_/ && do {