#!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");