Changeset 16595 for misc/runpugs

Timestamp:

06/01/07 18:08:37 (18 months ago)

Author:

andara

Message:

[runpugs] - Settings now go in $HOME/.webtermrc (using Config::General).

Look at webtermrc for example settings.

• Prompt detection now more robust.
• Easier back-end testing with command-line REPLs (see /bin).

Location:

misc/runpugs

Files:

• README (modified) (4 diffs)
• bin/perl_repl.pl (modified) (1 diff)
• bin/test_session.pl (modified) (1 diff)
• bin/test_session_dispatcher.pl (modified) (2 diffs)
• lib/Repl.pm (modified) (1 diff)
• lib/Web/Terminal/Dispatcher.pm (modified) (1 diff)
• lib/Web/Terminal/Server.pm (modified) (4 diffs)
• lib/Web/Terminal/Server/Session.pm (modified) (10 diffs)
• lib/Web/Terminal/Settings.pm (modified) (2 diffs)
• webtermrc (added)

misc/runpugs/README

@@ -1 +1 @@
 ==============================================================================
-2007/05/07      Release of version 0.4.0 of runpugs/Web::Terminal
+2007/06/01      Release of version 0.4.0 of runpugs/Web::Terminal
 ==============================================================================
 
 NAME
-    runpugs: a web teminal for interactive pugs 
+    runpugs: a web terminal for interactive pugs 
     Web::Terminal: library for building a web terminal for interactive shells
 
@@ -20 +20 @@
         Net::Telnet 
         IO::Pty
+        Config::General
 
-    * make sure that you change the following settings in lib/Web/Terminal/Settings.pm
-        $rel_root       (Release pugs)
-        $dev_root       (Development pugs)
-        $root           (web root)
-        $port           (usually should be 2059)
-        $server         (bin/termserv4.pl)
+    * create a $HOME/.webtermrc configuration file (start from the webtermrc file in the repository)
+    * make sure that you change the following settings
+        rel_root        (Release pugs)
+        dev_root        (Development pugs)
+        root            (web root)
+        port            (default 2059; any free TCP port is OK)
+        server          (bin/termserv.pl)
         
-    * Start the terminal server script (bin/termserv4.pl) 
+    * Start the terminal server script (bin/termserv.pl) 
     
     * To run, simply point your browser to /runpugs/ 
@@ -34 +36 @@
 DESCRIPTION
     runpugs has two main components: 
-    -a mod_perl script (/perl/runpugs3.pl) which uses an html template
-    (/data/runpugs_async3.html). The latter calls the runpugs.css stylesheet from
+    -a mod_perl script (/perl/runpugs.pl) which uses an html template
+    (/data/runpugs_async.html). The latter calls the runpugs.css stylesheet from
     /htdocs/runpugs.css. The script is called from /htdocs/runpugs/index.html
-    -a server (/bin/termserv3.pl) which handles the interactive pugs sessions and communicates with
+    -a server (/bin/termserv.pl) which handles the interactive pugs sessions and communicates with
     the mod_perl script. The pugs sessions stay alive for some time (currently 10') if
     left inactive.
 
     This version has some AJAX goodness and runs under mod_perl.
-    The entrypoint is /htdocs/runpugs/index.html, which calls /perl/runpugs3.pl
+    The entrypoint is /htdocs/runpugs/index.html, which calls /perl/runpugs.pl
 
    The underlying library, Web/Terminal, can in principle be used for any
@@ -62 +64 @@
     -Better session management
     -use Moose for Session objects
-    -More generic (Settings.pm)
+    -More generic (Settings.pm uses Config::General) 
 
 CHANGES IN VERSION 0.3.0

misc/runpugs/bin/perl_repl.pl

@@ -4 +4 @@
 #use lib '../lib','/home/andara/lib/perl/5.8.8';
 use Repl;
-
+my $prompt ='pugs> ';
+my $motd ='Simple Perl REPL';
 my $subref = sub {
         my $cmd = shift;
         my $res = eval($cmd);
-        return $res;
+        return ($res,$prompt);
 };
-my $prompt ='pugs> ';
-my $motd ='Simple Perl REPL';
+
 
 my $repl = new Repl {subref=>$subref,prompt=>$prompt,motd=>$motd};

misc/runpugs/bin/test_session.pl

@@ -13 +13 @@
 my $session=create_session($app);
 
-my $subref = sub {my $cmd=shift;my $res=$session->write($cmd);chomp $res; return $res;};
+my $subref = sub {my $cmd=shift;my $res=$session->write($cmd);chomp $res; return ($res,$session->{'prompt'});};
 
 my $prompt =$session->prompt;

misc/runpugs/bin/test_session_dispatcher.pl

@@ -7 +7 @@
 use Web::Terminal::Dispatcher;
 $Web::Terminal::Settings::port=2059;
-
-my $app=(defined $ARGV[0])?$ARGV[0]:2;
+my $app;
+if (defined $ARGV[0]){
+        $app=$ARGV[0];
+} else {
+die "Usage: $0 app (0|1|2) [id (default 42)].\n";
+}
 my $id=(defined $ARGV[1])?$ARGV[1]:42;
 $id='testsession'.$id;
@@ -17 +21 @@
 (my $reply,my $prompt,my $histref) =
 &Web::Terminal::Dispatcher::send($id,$ip,$app,1,$cmd);
-return $reply;
+return ($reply,$prompt);
 };
 

misc/runpugs/lib/Repl.pm

@@ -18 +18 @@
                 /\:q(uit)*$/i && exit();
                 chomp $_;
-                my $res=$s->subref->($_);
-                print $res,"\n",$s->prompt;
+                (my $res,my $prompt)=$s->subref->($_);
+                print $res,"\n",$prompt;
         }
 }

misc/runpugs/lib/Web/Terminal/Dispatcher.pm

@@ -21 +21 @@
                                          DEFAULT => [],
 );
-my $v = (1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test);
+my $v = 1;#(1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test);
 
 sub send {

misc/runpugs/lib/Web/Terminal/Server.pm

@@ -43 +43 @@
 
 # verbose
-my $v                 = (1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test);
+my $v                 = 1;#(1 - $Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test);
 
 # Datastructures per app, so $session{$app}{...}, $inactive[$app][...] or @{$inactive[$app]}
@@ -387 +387 @@
                                 }
                         } else {
-print "    Session $id ($app,$cmd) is not active:", exists( $active_sessions[$app]{$id}),"\n" if $v;
+print "    Session $id ($app,$cmd) is not active:", (defined $active_sessions[$app])?exists( $active_sessions[$app]{$id}):'(empty)',"\n" if $v;
                                 # new session
                            assert($n_inactive_sessions[$app]==scalar( @{ $inactive_sessions[$app] }));
@@ -421 +421 @@
                                                 # asynchronously create new sessions
                                                 &async_init_create();
-                                                return $ret;
+                                                my $term = $sessions[$app]{$ret};
+                                                my $motd=$term->{'motd'};
+                                                return $motd;
                                         } else {
                                                 print
@@ -696 +698 @@
         return 1;
     } else {
+        print "PUGS_SAFEMODE=1 $cmd -e \"print 42\" 2>/dev/null\n";
     my $reply=`PUGS_SAFEMODE=1 $cmd -e \"print 42\" 2>/dev/null`;
     if ($reply==42) {

misc/runpugs/lib/Web/Terminal/Server/Session.pm

@@ -15 +15 @@
 $SIG{CHLD}='IGNORE';
 
-my $v=(1-$Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test);
+my $v=1;#(1-$Web::Terminal::Settings::daemon)*(1-$Web::Terminal::Settings::test);
 
     my $prompt ='/'.$Web::Terminal::Settings::prompt.'/';
@@ -30 +30 @@
     has 'pty' => (is=>'rw',isa=>'Any');
     has 'pid' => (is=>'rw',isa=>'Int');
+    has 'motd' => (is=>'rw',isa=>'Str');
     
     sub BUILD {
@@ -37 +38 @@
     my $app=$self->app;
     my $command=$Web::Terminal::Settings::commands[$app];
-    if (not $Web::Terminal::Settings::test) {
+    if ($Web::Terminal::Settings::test!=1) {
     if ($self->ia==0) {
         #1. Create a file with the content of $cmd using $id.p6 for name, store in data
@@ -68 +69 @@
                 -telnetmode      => 0,
                 -cmd_remove_mode => 0,
+                -input_record_separator => "\n",
         );
     }
@@ -76 +78 @@
         print "Reading Pugs startup message...\n" if $v;
     my $m=$self->readlines();
+    $self->{'motd'}=$m;
       if ($self->{'error'}==1 and not $Web::Terminal::Settings::test) {
           # should close the TTY
@@ -170 +173 @@
 sub DESTROY {
     my $obj = shift;
-    if (not $Web::Terminal::Settings::test) {
+    if ( $Web::Terminal::Settings::test!=1) {
         if (defined $obj->{'pty'}) {
     $obj->{'pty'}->close();
@@ -193 +196 @@
                 my $i     = 1;
         my $lline = '';
-if (not $Web::Terminal::Settings::test) {
+if ( $Web::Terminal::Settings::test!=1) {
         if ( $cmd eq $Web::Terminal::Settings::quit_command ) {
         $obj->{pugs}->close();
@@ -206 +209 @@
         while ($i<$Web::Terminal::Settings::nlines) {
                 my $line = $pugs->getline;
-        my $msg=$pugs->errmsg;
-            print "L:",$line,":",$msg if $v;
-            if($msg=~/timed/) {
-            $msg='';
-            $pugs->errmsg([]);
-            $lline="${Web::Terminal::Settings::prompt} Sorry, that took too long! Aborted.\n";
-            $pugs->close();
-            $ps=$Web::Terminal::Settings::prompt;
-            $obj->{'error'}=1;
-            last;
-        }
-        $msg='';
-        if ( ($line =~ /$Web::Terminal::Settings::prompt_pattern/ or
-        ($line=~/$Web::Terminal::Settings::quit_pattern/)) and $i > 1 ) { $ps = $1; last }
+                my $msg=$pugs->errmsg;
+                    print "L:{",$line,"}\n",$msg if $v;
+                    if($msg=~/timed/) {
+                            $msg='';
+                            $pugs->errmsg([]);
+                            $lline="${Web::Terminal::Settings::prompt} Sorry, that took too long! Aborted.\n";
+                            $pugs->close();
+                            $ps=$Web::Terminal::Settings::prompt;
+                            $obj->{'error'}=1;
+                            last;
+                        }
+                $msg='';
+# print "\nTEST",$Web::Terminal::Settings::prompt_pattern,"\n"; 
+#print ('(^(pugs|\.\.\.\.)>\s+)' eq $Web::Terminal::Settings::prompt_pattern);
+#if ($line=~/pugs/) {
+#print "OK!\n";
+#}
+                if ( ($line =~ /$Web::Terminal::Settings::prompt_pattern/ or
+                ($line=~/$Web::Terminal::Settings::quit_pattern/)) and $i > 1 ) { 
+                        $ps = $1;
+                       my $ps1=$ps;     
+                        my $charnum=ord(chop $ps1);
+                        if ($charnum<32) {
+                                $ps=$ps1;
+                        }
+                        last;
+                }
                 $lline .= $line unless $line =~
-        /$Web::Terminal::Settings::prompt_pattern/;
+                /$Web::Terminal::Settings::prompt_pattern/;
                 $i++;
         }
@@ -252 +268 @@
 #       my $i     = 1;
         my $lline = '';
-        if (not $Web::Terminal::Settings::test) {
+        if ( $Web::Terminal::Settings::test!=1) {
     my $pugs=$obj->{'pugs'};
     $pugs->errmode(sub {kill 9,$obj->{'pid'}; });
@@ -275 +291 @@
 #    #} else {die;$prev=1;}
 #    }
-  
+# print "TEST",$Web::Terminal::Settings::prompt,"\n"; 
         ($line, $ps)=$pugs->waitfor(String=>$Web::Terminal::Settings::prompt);
           $pugs->buffer_empty(); # maybe redundant, but play safe   

misc/runpugs/lib/Web/Terminal/Settings.pm

@@ -5 +5 @@
 use vars qw( $VERSION );
 $VERSION = '0.4.0';
-use utf8;
+#use utf8
 use strict;
+
+use Config::General;
 
 use Exporter;
@@ -51 +53 @@
 );
 
-#ghci
-##GHCi
-#our $command='/usr/local/bin/ghci';
-#our $prompt='Prelude> ';
-#our $prompt_pattern='(^(Prelude)>\s+)';
-#our $quit_pattern='^Leaving\ GHCi\.';
-#our $quit_message='Leaving GHCi.';
-#cut
+#my %config = Config::General::ParseConfig("./wtrc");
+ my $conf = new Config::General(
+         -ConfigFile => $ENV{'HOME'}.'/.webtermrc',
+         -InterPolateVars=>1,
+         -InterPolateEnv=>1
+                );
+my %config=$conf->getall();
 
-#Pugs
-my $ulimit='ulimit -m 64000; ulimit -v 64000;';
-my $nice='/usr/bin/nice';
-my $pugs='/usr/bin/pugs';
-my $rel_root='/home/andara/pugs-rel';
-my $dev_root='/home/andara/pugs-dev';
-my $rel_lib="-I$rel_root/blib6/lib";
-my $dev_lib="-I$dev_root/blib6/lib";
+no strict 'refs';
 
-#$ulimit='';
-#$nice='';#/bin/nice';
-#$pugs='/usr/bin/pugs';
-#$rel_root='/usr/bin';
-#$dev_root='/usr/bin';
-#$rel_lib='';
-#$dev_lib='';
+for my $key (keys %config) {
+        my $fkey="Web::Terminal::Settings::$key";
+        if ($config{$key}=~/^\(\d+(,\d+)*\)/) {
+                my $vals=$config{$key};
+                $vals=~s/[\(\)]//g;
+                @{$fkey}=split(/,/,$vals);
+        } else {
+                ${$fkey}=$config{$key};
+        }
+}
 
 our @commands=(
-"$ulimit $nice $rel_root/pugs $rel_lib",
-"$ulimit $nice $dev_root/pugs $dev_lib",
-#"perl ./perl_repl.pl"
+"$Web::Terminal::Settings::ulimit $Web::Terminal::Settings::nice $Web::Terminal::Settings::rel_root/pugs $Web::Terminal::Settings::rel_lib",
+"$Web::Terminal::Settings::ulimit $Web::Terminal::Settings::nice $Web::Terminal::Settings::dev_root/pugs $Web::Terminal::Settings::dev_lib",
 );
 
-our $test=0;
-our $appname='runpugs';
-our $prompt='pugs> ';
-#$prompt='perl> ';
-our $prompt_pattern='(^(pugs|\.\.\.\.)>\s+)';
-our $quit_pattern='^Leaving\ pugs\.';
-our $quit_message='Leaving pugs.';
+if ($Web::Terminal::Settings::test==2) {
+        push @commands,"perl ./perl_repl.pl";
+        push @Web::Terminal::Settings::n_max,1;
+        push @Web::Terminal::Settings::npreloaded_sessions,1;
+        push @Web::Terminal::Settings::n_inactive_min,1;
+}
 
-our $init_pattern='(\>\s+)';
-our $quit_command=':q';
-our $reset_command=':r';
-our $abort_command=':A'; # To simulate abort in test mode
+our @n_inactive_max=@Web::Terminal::Settings::npreloaded_sessions;
 
-our $filter=0;
-our $filter_pattern='';
-my $root='/home/andara/apache';
-
-our $cgi_path="$root/cgi-bin/";
-our $lib_path="$root/lib/";
-our $bin_path="$root/bin/";
-our $data_path="$root/data/";
-our $tmp_path="$root/data/tmp/";
-our $log_path="$root/data/log";
-our $daemon=1;
-our $port=2057;
-our $host='localhost';
-
-our $restart_parent=0; # restart parent server from child if 1
-our $server="$bin_path/termserv.pl"; # used to restart parent server from child
-
-our $nsessions=50; # obsolete
-our @n_max=(20,50);#,5);
-our $nsessions_ip=10; 
-our @npreloaded_sessions=(5,10);#,2); 
-our @n_inactive_max=@npreloaded_sessions;
-our @n_inactive_min=(2,5);#,0);
-
-our $timeout_idle=90; # was 600
-our $timeout_call=30; #  was 30
-our $check_interval=60; 
-our $create_interval=5; # should be 30 I guess
-our $nlines=250;
-our $nchars=250;
-our $nrecent=10;
-our $perl='/usr/bin/perl';
+1;
 
 __END__