hzPop.pl

#!perl

$|					= 1;

print "Content-type: text/html\n\n";

my $soapCommand			= "hsp_getCurrentShardCapacity_All";

my $soapCountPayload	= <<SOAPEND;
<soap:Envelope
	xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
	xmlns:xsd="http://www.w3.org/2001/XMLSchema"
	xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
	<soap:Body>
		<$soapCommand xmlns="https://horizons.istaria.com/DataAccess/">
		<userKeyID></userKeyID>
		</$soapCommand>
	</soap:Body>
</soap:Envelope>
SOAPEND

my $soapLen			= length( $soapPayload );

#my $headerPayload	= <<HDREND;
#POST /DataAccess/dataAccessLayerWS.asmx HTTP/1.1
#User-Agent: 
#Content-Type: 
#Content-length: $soapLen
#HDREND
#Expect: 100-continue
#SOAPAction: "$soapAction"


my $soapUrl			= "http://play.istaria.com/DataAccess/dataAccessLayerWS.asmx";


# Setup the transfer
{
	my( $ua, $req, $res, $proxyCount, $content );
	use LWP::UserAgent;
	$ua				= LWP::UserAgent->new();
	$ua->agent( "Mozilla/4.0 (compatible; MSIE 6.0; MS Web Services Client Protocol 1.1.4322.2032)" );
	$ua->timeout( 2 );
	$ua->default_headers->push_header( "Expect" => "100" );
	
	$req			= HTTP::Request->new( POST => "http://horizons.istaria.com/DataAccess/dataAccessLayerWS.asmx" );
	$req->content_type( "text/xml; charset=utf-8" );
	
	# Now that we have a request object, let's do some majic.
	
	$req->header( "SOAPAction", "\"https://horizons.istaria.com/DataAccess/$soapCommand\"" );
	$req->content( $soapCountPayload );

	$res			= $ua->request( $req );
	$content		= $res->content();
	#print $content;
	
	# Success!....?
	
	$content	=~ s/^.*<NewDataSet xmlns="">//;
	
	# Filter out the real shards
	while ( $content =~ s!<Table diffgr:id="Table\d+" msdata:rowOrder="\d+"><connection_count>(\d+)</connection_count><shard_id>\d+</shard_id><shard_name>(\w+?)</shard_name><is_active>(\w+?)</is_active><capacity>\d+</capacity><description>[^<]*</description><UnlimitedUse>\w+?</UnlimitedUse></Table>!!i )
	{
		my( $count, $name, $active );
		$count		= $1;
		$name		= $2;
		$active		= $3;
		
		if ( $active eq "true" )
		{
			print "$name: $count connections<br>\n";
		}
	}
}