view release on metacpan or  search on metacpan

socialcalc/simpleedit15.pl  view on Meta::CPAN

#!/usr/bin/perl

   use strict;
   use CGI qw(:standard);
   use URI;
   use HTTP::Daemon;
   use HTTP::Status;
   use HTTP::Response;
   use Socket;
   use CGI::Cookie;
   use LWP::UserAgent;

   use SocialCalcServersideUtilities;


   my $datadir = "se2-data/";
   my $versionstr = "2.02";
   my $jsdir = "/sgi/scjstest/";

#
# This whole first section lets this code run either as a CGI script on a server
# or standalone on the desktop run from the Perl command line.
#
# The main processing starts with process_request.
#

   if ($ENV{REQUEST_METHOD}) { # being run as a CGI on a server
      print "Content-type: text/html\n\n";
      my $q = new CGI;
      print process_request($q);
      exit;
      }

   # running locally - do mini-server

   my $d = HTTP::Daemon->new (
                    LocalPort => 6557,
                    Reuse => 1);

   if (!$d) {
      print "simpleedit could not start on 127.0.0.1:6557\n";
      exit;
      }

   print "simpleedit15\nAccess at: http://127.0.0.1:6557/\n";

   while (my $c = $d->accept) {

      # Make sure the request is from our machine

      if ($c) {
         my ($port, $host) = sockaddr_in(getpeername($c));
         if ($host ne inet_aton("127.0.0.1")) {
            $c->close;  # no - ignore request completely
            undef($c);
            next;
            }
         }

      # Process the request

      while ((defined $c) && (my $r = $c->get_request)) {
         if ($r->method eq 'POST' || $r->method eq 'GET') {
            $c->force_last_request;
            my $uri = $r->uri;
            if ($uri =~ /favicon/) {   # if this is a request for favicon.ico, ignore
               $c->send_error(RC_NOT_FOUND);
               next;
               }
            if ($uri =~ /\/quit$/) {
               $c->send_file_response("quitmessage.html");
               $c->close;
               undef($c);
               exit;
               }
            if ($uri =~ /\/([a-z\-0-9]+)\.(gif|js|css)$/) { # ok request
               $uri = "$1.$2";
               $uri = "images/$uri" if $2 eq "gif";
#               if ($2 eq "js") {
#                  $res->content_type("text/html; charset=UTF-8");
#                  }
               $c->send_file_response($uri);