use strict;
use warnings;

use threads qw(yield);
use threads::shared;
use Thread::Queue;

use IO::Socket;
use Net::hostent;

use XML::Parser;
use XML::XPath;

# server and client handle declaration
# Also summons listener socket
my ($server,$client);
$server = IO::Socket::INET->new( Proto          => 'tcp',
                                 LocalPort      => PORT,
                                 Listen         => SOMAXCONN,
                                 Type           => SOCK_STREAM,
                                 Reuse          => 1) or die "MAIN: Ca
+n't bind socket: $!";

#DoneFlag, raised when the XML File is done
my $DoneFlag : shared;

#Timeout flag, raised upon timing out
my $Timeout : shared;

#Data Queue, this is the queue that pulled in client data goes into

#Spawn Process Child
my $child = threads->new(\&Process,$DataQueue);

#Spawn Timeout timer and detach
my $timeoutTime = time + $opt_timeout;
my $timer = threads->create(\&Timer,$timeoutTime);
$timer->detach();

#Spawn Main reaper and detach
my $reap = threads->create(\&MainReaper);
$reap->detach();
my $DataQueue = Thread::Queue->new;

#The main loop, while we accept from the server socket.
print "MAIN: Looking.\n";
LOOK: while ($client = $server->accept()) {

  #Check for timeout
  if ($Timeout) {
    print "MAIN: Timed out.\n";
    last LOOK;
  }
  #Check for done
  if ($DoneFlag) {
    print "MAIN: Child said done.\n";
    last LOOK;
  }

  # Spawn a parser child to handle the connection.
  print "MAIN: Spawning ParserChild.\n";
  my $unimpChild = threads->new(\&Parse,$client,$DataQueue);

print "MAIN: Done Listening. Cleaning up.\n";

#Join every thread to cleanup
foreach my $thr (threads->list()) {
  if ($thr->tid && !threads::equal($thr, threads->self) && !threads::e
+qual($thr,$child) && !threads::equal($thr,$timer)) {
    $thr->join;
  }
}

#Kill Process with the terminating undef, then join
$DataQueue->enqueue(undef);
my $ret = $child->join();

#Close the server socket
close $server;

print "MAIN: Done Looking.\n";

#Here ends the main loop

sub Process {
  my $queue = shift;
  my $dat;

  # Set up XML::XPath to run in a creation mode with a base of <base/>
  my $parser = XML::XPath::XMLParser->new(xml=>qq|<base/>|);
  my $xp = XML::XPath->new();
  my $xmlRoot = $parser->parse;
  my $docRoot = $xp->find(q{/base},$xmlRoot)->shift();

  # Dequeue data until its undef
  while ($dat = $queue->dequeue()) {

  #do some preprocessing, create @data from $dat

   # For every param passed by a parser
    foreach (@data) {
      last unless /\S/; #We're done if its blank
      #parse out data to place into XML
      #uses the SWITCH: {  /foo/ && do BLOCK } construct to do this

  #Make sure we didn't get garbage
      if(defined($parsedFoo)) {
        #in here the following xml calls are made:
        # exists, if it returns true:
        #   find, getAttribute, setAttribute 4 times
        # else 
        #   XML::XPath::Node::Element->new()
        #   setAttribute 5 times
        #   appendChild
      } else {
        warn "BAD DATA";
      }
    } continue {
      open XML,"> $fileloc" or die "FATAL ERROR CANNOT XML OUTPUT";
      print XML q|<?xml version="1.0"?>|.$xmlRoot->toString;
      close XML;

      # A done check goes here, basically we do 2 xpath queries and if
+ they return > a certain number of nodes we're done and we exit this 
+thread.
    }
  }
  return;
}

sub Parse {
  sub ParseFL {
  my $sock = shift;
  my $Dqueue = shift;
  my $ret;
  # Read all the data the socket has to say
  while(<$sock>) {
    last unless /\S/; #Blank line means done
    chomp; #Strip the newline
    # Pre-pre processing and addition to $ret
  }
  close $sock;
  $Dqueue->enqueue($ret) if $ret; # Send it on to Process if it exists
  return;
}

sub Timer {
  my $outtime = shift;
  my $difference = $outtime - time();
  print "Timer: timing until now is $outtime.\n";
  $difference = $outtime - time(),threads->yield() until($difference <
+= 0 || $DoneFlag);
  unless($DoneFlag) {
    $Timeout = 1;
    print "Timer: Setting Timeout Flag.\n";
  }
}

sub MainReaper {
  #Wait
  threads->yield() until ($DoneFlag || $Timeout);
  #Gank
  print "MainReaper: Reaping the main loop with a blank packet.\n";
  $reap = IO::Socket::INET->new( Proto => 'tcp', PeerAddr => 'localhos
+t', PeerPort => '77777');
}
[download]