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: Can'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::equal($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
my $parser = XML::XPath::XMLParser->new(xml=>qq||);
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||.$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 => 'localhost', PeerPort => '77777');
}