Roxen.git / server / perl / bin / perlhelper

version» Context lines:

Roxen.git/server/perl/bin/perlhelper:1:   #! /usr/local/bin/perl      # Perl helper script for Roxen Webserver. By Leif Stensson.   # - # $Id: perlhelper,v 1.6 2001/04/18 12:48:59 leif Exp $ + # $Id: perlhelper,v 1.7 2003/09/16 17:48:31 mast Exp $      package Roxen::Internal;      use strict;   use vars '%Cache';      sub packagename   { my($string) = @_;       $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
Roxen.git/server/perl/bin/perlhelper:264:    sub remote_addr { die "Perl: Arrgh! \$r->connection->remote_addr\n";}    sub user { return $Roxen::Request::req_info{'auth_user'};}    # Note: this one exists in both Request and Connection:    sub auth_type { return $Roxen::Request::req_info{'auth_type'};}         package Roxen::_helper;      use IO::Handle;    - my ($infd, $outfd) = (-1, -1); +    my ($cmdin ) = (new IO::Handle);   my ($cmdout) = (new IO::Handle);    - for(; $ARGV[0] =~ /^-/; shift @ARGV) - { if ($ARGV[0] =~ /^--cmdsocket=(\d+)$/) -  { $infd = $1; $outfd = $1;} -  else -  { die "Invalid option: $ARGV[0]\n";} - } + # for(; $ARGV[0] =~ /^-/; shift @ARGV) + # { if ($ARGV[0] =~ /^--cmdsocket=(\d+)$/) + # { $infd = $1; $outfd = $1;} + # else + # { die "Invalid option: $ARGV[0]\n";} + # }      sub diag   {   # print STDERR join('', @_);   }         sub Getdata($)   { my ($bytes, $len, $tmp, @lens) = (shift);    $cmdin->sysread($tmp, $bytes) == $bytes or die "$$/Getdata: exiting.\n";
Roxen.git/server/perl/bin/perlhelper:359:   *CORE::GLOBAL::exit = \&_CatchExit;      $SIG{ALRM} = \&_CatchAlarm;      tie(*STDOUT, 'Roxen::TieStdio');      # Main loop.   { my ($cmd, $var, $len, $data) = ();    my ($starttime, $runcount) = (time, 0);    -  $cmdin->fdopen($infd, "r") or die "Unable to open command input.\n"; -  $cmdout->fdopen($outfd, "w") or die "Unable to open command output.\n"; +  $cmdin->fdopen(0, "r") or die "Unable to open command input.\n"; +  $cmdout->fdopen(1, "w") or die "Unable to open command output.\n";    $cmdout->autoflush(1);       $Roxen::Request::req_req = Roxen::Request->new();       %Roxen::Request::req_config = ( "timeout" => 180,    "lifelength" => 300    );       while (1)    { $Roxen::Request::req_state = 0;
Roxen.git/server/perl/bin/perlhelper:443:    last if $starttime+1800 < time; # Final timeout after 30 minutes.       $Roxen::Request::req_req = Roxen::Request->new();    }    elsif ($cmd eq "Q")    { $cmdin->sysread($cmd, 1) == 1 or die "perlhelper $$/MLQ: exiting.\n";    diag "{Q$cmd}";    if ($cmd eq "P")    { Sendreply(""); }    elsif ($cmd eq "V") -  { Sendreply('Roxen Perl Helper: $Id: perlhelper,v 1.6 2001/04/18 12:48:59 leif Exp $'); } +  { Sendreply('Roxen Perl Helper: $Id: perlhelper,v 1.7 2003/09/16 17:48:31 mast Exp $'); }    else    { die "perlhelper $$/MLQQ: exiting.\n"; }    }    }   # die "$$ perlhelper: exiting normally.\n";    CORE::exit(0);   }