The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!usr/bin/env perl5
use strict;
use warnings;

use Test::More;
use Device::CableModem::Zoom5341;


# See if we can setup a HTTP server
my $ip = '127.0.0.1';
my ($port, $fret, $ischild);

eval
{
	use HTTP::Daemon;

	# Try setting it up
	my $d = HTTP::Daemon->new(LocalAddr => $ip)
			or plan skip_all => "Can't setup HTTP::Daemon";
	$port = $d->sockport;

	# Now, we'll want to fork() off and run this in another process
	$fret = fork();
	if($fret > 0)
	{
		# Parent; just fall through and finish the tests
		return;
	}
	elsif(!defined($fret))
	{
		# Something went bad
		print STDERR "XXX badfret\n";
		plan skip_all => "fork failed: $@";
	}

	# Else we're the child.  Do the HTTP serving
	$ischild = 1;

	# Make sure we don't accidentally hang around forever
	$SIG{ALRM} = sub { die "$0 child: Timed out\n" };
	alarm 3;

	# Accept one connection, and return a 404
	my $c = $d->accept;
	my $r = $c->get_request;
	if($r->method ne 'GET' || $r->uri ne '/status_connection.asp')
	{
		die "Unexpected request1 '@{[$r->method]} @{[$r->uri]}'";
	}
	$c->send_error(404);
	$c->close;

	# Take the next, and return data
	$c = $d->accept;
	$r = $c->get_request;
	if($r->method ne 'GET' || $r->uri ne '/status_connection.asp')
	{
		die "Unexpected request2 '@{[$r->method]} @{[$r->uri]}'";
	}
	$c->send_response(HTTP::Response->new(200, 'OK',
			['Content-Type', 'text/plain'], "Ohai\n"));
	$c->close;

	# Done; shut down
	exit;
};

# The child process shouldn't get here
if($ischild)
{
	die "Child: $@" if $@;
	die "Child: shouldn't get here\n";
}

# The parent shouldn't see an error or bad fork() return.
if($@ || !defined($fret))
{
	plan skip_all => "Couldn't get local HTTP::Daemon working: $@";
}


# OK, should be good; run the tests
plan tests => 6;

my $cm = Device::CableModem::Zoom5341->new(modem_addr => "$ip:$port");
isa_ok($cm, 'Device::CableModem::Zoom5341', "Object built OK");

# First, we expect a 404
eval { $cm->fetch_connection };
like($@, qr/404 Not Found/, "Got expected 404");

# Next, we expect some real data
eval { $cm->fetch_connection };
ok(!$@, "Fetch didn't error");
is($cm->{conn_html}[0], "Ohai", "Got expected data");

# Check that calling the fetch makes sure everything's clear
$cm->{conn_stats} = "hey, this is set";
$cm->{__TESTING_NO_FETCH} = 1;
$cm->fetch_connection;
is($cm->{conn_html},  undef, "Cached HTML is cleared out");
is($cm->{conn_stats}, undef, "Cached stats are cleared out");