[system] / trunk / xmlrpc / daemon / Frontier / Daemon_ww.pm Repository:
ViewVC logotype

View of /trunk/xmlrpc/daemon/Frontier/Daemon_ww.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (download) (as text) (annotate)
Fri May 17 21:44:04 2002 UTC (17 years, 5 months ago) by gage
File size: 4129 byte(s)
Experimental xmlrpc WeBWorK webservices

    1 #
    2 # Copyright (C) 1998 Ken MacLeod
    3 # Frontier::Daemon is free software; you can redistribute it
    4 # and/or modify it under the same terms as Perl itself.
    5 #
    6 # $Id$
    7 #
    8 
    9 # NOTE: see Net::pRPC for a Perl RPC implementation
   10 
   11 ###
   12 ### NOTE: $self is inherited from HTTP::Daemon and the weird access
   13 ### comes from there (`${*$self}').
   14 ###
   15 
   16 use strict;
   17 print "Reading file /u/gage/xmlrpc/daemon/Frontier/Daemon_ww.pm\n";
   18 package Frontier::Daemon_ww;
   19 use vars qw{@ISA};
   20 
   21 @ISA = qw{HTTP::Daemon};
   22 
   23 use Frontier::RPC2;
   24 use HTTP::Daemon;
   25 use HTTP::Status;
   26 
   27 
   28 #sub logTimingInfo{
   29 #    my ($beginTime,$endTime,) = @_;
   30 #    my $out = "";
   31 #    $out .= timestr( timediff($endTime , $beginTime) ) . " seconds elapsed  \n";
   32 #    open(OUT, ">>daemonTimingLog") or die "Can't open daemonTimingLog";
   33 #    print OUT $out;
   34 #    close(OUT);
   35 #    $out;
   36 #}
   37 
   38 
   39 # MEG modification
   40 my ($begin, $end, $save_content);
   41 my $logfile= '/u/gage/xmlrpc/logs/timing_log';
   42 my $process_name = 'Daemon_ww.pm (Ken McLeod)';
   43 sub log_it {
   44     my ($begin,$end,$file_name) = @_;
   45   open(LOGFILE,">>$logfile") or print "Couldn't open $logfile";
   46   my $out = "Process: $process_name, File Name: $file_name,\n Time: " .Benchmark::timestr(Benchmark::timediff($end,$begin)) . "\n\n";
   47     print LOGFILE $out;
   48     close(LOGFILE);
   49   $out;
   50 }
   51 #end MEG modification
   52 
   53 my $rpcModule = new Frontier::RPC2;
   54 sub new {
   55     my $class = shift; my %args = @_;
   56     my $self = $class->SUPER::new(%args);
   57     return undef unless $self;
   58 
   59     ${*$self}{'methods'} = $args{'methods'};
   60     ${*$self}{'decode'} = new Frontier::RPC2;
   61 
   62     ${*$self}{'response'} = new HTTP::Response 200;
   63     ${*$self}{'response'}->header('Content-Type' => 'text/xml');
   64 
   65     my $conn;
   66     my $i;
   67     my $maximumNumberOfAccepts = 10000;
   68     while ($conn = $self->accept and $maximumNumberOfAccepts > $i++) {
   69 
   70         my $pid=fork();
   71     if ($pid) {wait ;}
   72     else {
   73 
   74       $begin = Benchmark->new;
   75       my $rq = $conn->get_request;
   76 
   77       if ($rq) {
   78           if ($rq->method eq 'POST' && $rq->url->path eq '/RPC2') {
   79 
   80                     ${*$self}{'response'}->content(${*$self}{'decode'}->serve($rq->content, ${*$self}{'methods'}));
   81                     #${*$self}{'response'}->content($rpcModule->serve($rq->content,${*$self}{'methods'}));#MEG
   82                     my $end = Benchmark->new;
   83                     my $answer = ${*$self}{'response'}->{_content};
   84                     my $compute_time = log_it($begin, $end, "----" );  # timing code MEG modification
   85               $compute_time =~s/\n/<BR>/g;# timing code MEG modification
   86               $answer =~ s|(<member><name>compute_time</name><value><string>)([^<]*)(</string></value></member>)| $1 $2 &lt;BR&gt; $compute_time $3|;  #timing code modification by MEG
   87             ${*$self}{'response'}->{_content} = $answer;
   88             $conn->send_response(${*$self}{'response'});
   89           } else {
   90         $conn->send_error(RC_FORBIDDEN);
   91           }
   92       }
   93       $conn = undef;    # close connection
   94       $save_content = $rq->content; #MEG modification
   95 
   96       $save_content =~m|<member>\s*<name>\s*fileName\s*</name>\s*<value>([^<]*)</value>|; # MEG modification
   97       my $fileName = $1; #MEG modification
   98       $end = Benchmark->new; # MEG modification
   99       log_it($begin, $end, "$fileName, including return time"); #MEG modification
  100       #print "one time through Daemon_ww.pm  $begin $end $fileName\n";
  101       exit(0);
  102     }
  103 
  104 
  105 
  106     }
  107 }
  108 
  109 =head1 NAME
  110 
  111 Frontier::Daemon - receive Frontier XML RPC requests
  112 
  113 =head1 SYNOPSIS
  114 
  115  use Frontier::Daemon;
  116 
  117  Frontier::Daemon->new(methods => {
  118      'rpcName' => \&sub_name,
  119         ...
  120      });
  121 
  122 =head1 DESCRIPTION
  123 
  124 I<Frontier::Daemon> is an HTTP/1.1 server that listens on a socket for
  125 incoming requests containing Frontier XML RPC2 method calls.
  126 I<Frontier::Daemon> is a subclass of I<HTTP::Daemon>, which is a
  127 subclass of I<IO::Socket::INET>.
  128 
  129 I<Frontier::Daemon> takes a `C<methods>' parameter, a hash that maps
  130 an incoming RPC method name to reference to a subroutine.
  131 
  132 =head1 SEE ALSO
  133 
  134 perl(1), HTTP::Daemon(3), IO::Socket::INET(3), Frontier::RPC2(3)
  135 
  136 <http://www.scripting.com/frontier5/xml/code/rpc.html>
  137 
  138 =head1 AUTHOR
  139 
  140 Ken MacLeod <ken@bitsko.slc.ut.us>
  141 
  142 =cut
  143 
  144 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9