use strict;
use warnings;

use Socket;      # CKN so that we can work with TCP/IP sockets
use IO::Select;  # CKN so that we can use the select system call
                 # CKN see man select for details
                 # CKN not much use of STDIN, but lots of I/O anyway

use threads;
use threads::shared;


$|  = 1;         # CKN tells perl to flush the output buffer automatically

# The following variables should be set within init_webserver_extension
# CKN the default port for a web server is 80, but requires privileges
# CKN other popular ports for web servers include 1080 and 8080
use vars qw/
 $port_listen
/;


require "http_handler.pl";
init_webserver_extension();

local *S;  # CKN this will be a socket pointer - yes, Perl has pointers, much syntax like C
           # CKN local is like my, but makes a local copy of a global variable, use with care

# CKN open a socket and start listening
socket     (S, PF_INET   , SOCK_STREAM , getprotobyname('tcp')) or die "couldn't open socket: $!";
setsockopt (S, SOL_SOCKET, SO_REUSEADDR, 1);
bind       (S, sockaddr_in($port_listen, INADDR_ANY));
listen     (S, 5)                                               or die "don't hear anything:  $!";

my $ss = IO::Select->new();
$ss -> add (*S);   # CKN lets us do some select ops on the newly opened socket


while(1) {
  my @connections_pending = $ss->can_read();  # CKN once we have a connection request,
  foreach (@connections_pending) {
    my $fh;
    my $remote = accept($fh, $_);     # CKN accept the connection and open a file handler

    my($port,$iaddr) = sockaddr_in($remote);
    my $peeraddress = inet_ntoa($iaddr);

    my $t = threads->create(\&new_connection, $fh);  # CKN spawn off a sub-process
    $t->detach();
  }
}

sub extract_vars {
  my $line = shift;
  my %vars;

  foreach my $part (split '&', $line) {
    $part =~ /^(.*)=(.*)$/;

    my $n = $1;    # CKN get name and value of parameters
    my $v = $2;
  
    $n =~ s/%(..)/chr(hex($1))/eg;
    $v =~ s/%(..)/chr(hex($1))/eg;
    $vars{$n}=$v;
  }

  return \%vars;
}

sub new_connection {
  my $fh = shift;

  binmode $fh;         # CKN this is useful for Unicode files too

  my %req;

  $req{HEADER}={}; 

  my $request_line = <$fh>;
  my $first_line = "";

  while ($request_line ne "\r\n") {
     unless ($request_line) {
       close $fh; 
     }

     chomp $request_line;

     unless ($first_line) {
       $first_line = $request_line;

      my @parts = split(" ", $first_line);
       if (@parts != 3) {
         close $fh;
       }

       $req{METHOD} = $parts[0];
       $req{OBJECT} = $parts[1];
     }
     else {
       my ($name, $value) = split(": ", $request_line);
       $name       = lc $name;
       $req{HEADER}{$name} = $value;
     }

     $request_line = <$fh>;
  }

  http_request_handler($fh, \%req);

  close $fh;
}
