view release on metacpan or  search on metacpan

socialcalc/socialcalcserver.pl  view on Meta::CPAN

#!/usr/bin/perl

#
# SocialCalc Server
#
# This is a simple Perl CGI server that uses SocialCalc in the browser
# to edit files stored on the server or a regular personal computer.
#

   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;

   # Defaults

   my $settingsfile = "socialcalcserversettings.txt"; # file with values for the following
   my $datadir = "se2-data/"; # The subdirectory of where the code is that holds the socialcalc data files
   my $versionstr = "0.2.3";
   my $titlestr = "SocialCalc Server $versionstr";
   my $jsdir = "/sgi/scjs/"; # The subdirectory of the server home page (when run thru CGI)
                                 # where the .js files are, and ./images/ subdirectory.
   my $imagedir = "/images/sc-";

#
# 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 "socialcalcserver\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;