#!/usr/bin/perl -w
#=====================================================================
#
#         FILE:  pm-css-test.pl
#
#        USAGE:  ./pm-css-test.pl
#
#     SYNOPSIS:  Stand-alone script for testing CSS for PerlMonks.
#
#  DESCRIPTION:  Acts as stand-alone server for testing CSS markup 
#                  for the PerlMonks website
#      OPTIONS:  [-addr address] [-port n] [-listen n] [-timeout n] 
#                  [-help]
# REQUIREMENTS:  Data::Dumper, Getopt::Long, HTTP::Daemon, 
#                  HTTP::Status, and URI::Escape
#         BUGS:  Lacks good test page content, others sure to be found
#        NOTES:  Based on conversation with Corion,
#                and code from perl.com article by Robert Spier
#                ( "Embedding Web Servers"
#                 - http://www.perl.com/pub/a/2002/09/17/ewispp.html )
#       AUTHOR:  atcroft
#      VERSION:  0.0a
#      CREATED:  09/23/2004 06:54:14 AM EDT
#     REVISION:  ---
#=====================================================================

use strict;
use vars qw(%service_ops $sample_page);
use Data::Dumper;
use Getopt::Long;
use HTTP::Daemon;
use HTTP::Status;
use URI::Escape;

$| = 1;

%service_ops = (
    'LocalAddr' => 'localhost',
    'LocalPort' => 65080,
    'Proto'     => 'tcp',
    'Listen'    => 5,
    'Timeout'   => 600,
    'ToHandle'  => 100
);

if ( scalar( grep( /^-/, @ARGV ) ) ) {
    my ($listen);
    my ($localaddr);
    my ($localport);
    my ($proto);
    my ($timeout);
    my ($tohandle);
    GetOptions(
        'addr:s'     => \$localaddr,
        'port:i'     => \$localport,
        'listen:i'   => \$listen,
        'timeout:i'  => \$timeout,
        'tohandle:i' => \$tohandle,
        'help'       => \&help
    );
    $service_ops{'Listen'} = $listen if ( defined($listen) );
    $service_ops{'LocalAddr'} = $localaddr
      if ( defined($localaddr) );
    $service_ops{'LocalPort'} = $localport
      if ( defined($localport) );
    $service_ops{'Timeout'} = $timeout if ( defined($timeout) );
    $service_ops{'ToHandle'} = $tohandle
      if ( defined($tohandle) );
}

{
    my @lines = <DATA>;
    $sample_page = join( "\n", @lines );
}

my $d = HTTP::Daemon->new(%service_ops)
  or die("Could not create HTTP::Daemon object: $!\n");

printf
  <<CONNECTION_DATA, $service_ops{'LocalAddr'}, $service_ops{'LocalPort'}, $service_ops{'Timeout'}, $service_ops{'Listen'};
Please point your browser to the following address:
    http://%s:%s/

Other current values
Timeout (seconds):      %d
Maximum connections:    %d

CONNECTION_DATA

my ($c);
my ($client);
while ( ( $c, $client ) = $d->accept ) {
    if (fork) {
        print "forking...\n";
    }
    else {
        my (@remote_addr);
        my ($remote_port);
        my $to_handle = $service_ops{'ToHandle'};
        ( $remote_port, @remote_addr ) =
          unpack( "x2nC4", $client );
        while ( ( my $r = $c->get_request ) and ($to_handle) ) {
            $to_handle--;
            print join(
                ' ',
                scalar(localtime),
                join( ':',
                    join( '.', @remote_addr ), $remote_port ),
                $r->method,
                $r->url->path,
                $r->content_length
              ),
              "\n";
            my $test    = $r->url;
            my $content = $r->content;

# print Data::Dumper->Dump( [ \$test ], [qw(*test)] ), "\n";
# print Data::Dumper->Dump( [ \$r, \$content ], [qw(*r *content)] ), "\n";
            if (    $r->method eq 'POST'
                and $r->url->path eq "/xyzzy" )
            {
                my $buf = $r->content;
                while ( my $a = $c->read_buffer ) {
                    $buf .= $a if ( defined($a) );
                }
                $content = generate_page_content( $buf, 1 );
                $c->send_response($content);
            }
            elsif ( $r->method eq 'GET'
                and $r->url->path eq '/sample.html' )
            {
                $content = generate_sample_content();
                $c->send_response($content);
            }
            elsif ( $r->method eq 'GET'
                and $r->url->path eq '/sample.css' )
            {
                $c->send_file_response( $0 . '.css' );
            }
            elsif ( $r->method eq 'GET'
                and $r->url->path eq '/' )
            {
                $content = generate_page_content( '', 0 );
                $c->send_response($content);
            }
            else {
                $c->send_error(RC_FORBIDDEN);
            }
        }
        $c->close;
        undef($c);
    }
}

sub generate_sample_content {
    my $h = HTTP::Headers->new( 'Content_Type' => 'text/html' );
    my $t = HTTP::Response->new( 200, 'OK', $h );

    $t->content($sample_page);
    return ($t);
}

sub generate_page_content {
    my ( $s, $write_flag ) = @_;

    my (%params);
    if ( -e $0 . '.css' ) {
        open( DF, $0 . '.css' )
          or die("Could not open $0.css for input: $!\n");
        @{ $params{'content'} } = <DF>;
        chomp( @{ $params{'content'} } );
        close(DF);
    }
    foreach ( split( /\&/, $s ) ) {
        my @parts = split( /=/, $_, 2 );
        push( @{ $params{ $parts[0] } }, $parts[1] );
    }
    @{ $params{'content'} } = ('')
      unless ( defined( $params{'content'} ) );

    # local ( $\ = "\r\n" );
    my $h = HTTP::Headers->new( 'Content_Type' => 'text/html' );
    my $t = HTTP::Response->new( 200, 'OK', $h );

    my $escaped_content = join( "\n", @{ $params{'content'} } );
    my $submitted_content =
      uri_unescape( $escaped_content, "\x00-\xff" );
    $submitted_content =~ s/\+/ /g;
    my $html_content = sprintf
      <<CONTENT, $0, $submitted_content, $submitted_content;
<html>
<head>
  <title>test</title>
</head>
<body>
<div align="center">
  <p><a href="/sample.html" target="sample">Test CSS</a></p>
  <table border="1">
    <tr>
      <td align="center" width="50%%">Edit</td>
      <td align="center" width="50%%">Current (also in %s.css, if present)</td>
    </tr>
    <tr>
      <td align="center" width="50%%">
        <form action="/xyzzy" method="POST">
          <textarea name="content" rows="42" cols="132">%s</textarea>
          <input name="reset" type="reset" value="reset">
          <input name="submit" type="submit" value="submit">
        </form>
      </td>
      <td width="50%%">
        <pre>%s</pre>
      </td>
    </tr>
  </table>
</div>
</body>
</html>
CONTENT
    $t->content($html_content);

    if ($write_flag) {
        open( DF, '>' . $0 . '.css' )
          or die("Could not open $0.css for output: $!\n");
        print DF $submitted_content;
        close(DF);
    }

    return ($t);
}

sub help {
    print <<HELPTEXT;

$0 [-addr address] [-port n] [-listen n] [-timeout n] [-help]

    -addr       - local address (default: $service_ops{'LocalAddr'})
    -port       - local port (default: $service_ops{'LocalPort'})
    -listen     - maximum number of concurrent connections to handle (default: $service_ops{'Listen'})
    -timeout    - connection timeout value (default: $service_ops{'Timeout'})
    -help        - display this help text

HELPTEXT
    exit;
}
__DATA__
<html>
<head>
  <title>test</title>
  <link rel="stylesheet" type="text/css" href="/sample.css" media="all">
</head>
<body>
<div align="center">
  <p><a href="/sample.html" target="sample">Test CSS</a></p>
  <table border="1">
    <tr>
      <td align="center" width="50%">Edit</td>
      <td align="center" width="50%">Current (also in $0.css, if present)</td>
    </tr>
    <tr>
      <td align="center" width="50%">
        <form action="/xyzzy" method="POST">
          <textarea name="content" rows="42" cols="132">%s</textarea>
          <input name="reset" type="reset" value="reset">
          <input name="submit" type="submit" value="submit">
        </form>
      </td>
      <td width="50%">
        <pre>%s</pre>
      </td>
    </tr>
  </table>
</div>
</body>
</html>