File Coverage

blib/lib/WWW/Chat.pm

Criterion	Covered	Total	%
statement	6	55	10.9
branch	0	22	0.0
condition	0	21	0.0
subroutine	2	10	20.0
pod	0	8	0.0
total	8	116	6.9

package WWW::Chat;
$VERSION = '0.65';
use strict;
require Exporter;
*import = \&Exporter::import;
#use vars qw(@EXPORT_OK);
#@EXPORT_OK=qw(fail OK ERROR);

use Carp ();

sub fail
{
    my ($reason, $mres, $mct) = @_;
    $mres ||= $main::res;
    $mct  ||= $main::ct;
    Carp::carp("FAILED $reason");

    # Print current response too...
    my $res = $mres->clone;
    my $cref = $res->content_ref;
    if ($mct =~ m,^text/,) {
	substr($$cref, 256) = "..." if length($$cref) > 512;
    } else {
	$$cref = "";
    }
    $res = $res->as_string;
    $res =~ s/^/  /gm;
    print STDERR $res;

    die "ASSERT";
}

sub check_eval
{
    return unless $_[0];
    return if $_[0] =~ /^ASSERT /;
    print STDERR $_[0];
}


sub OK
{
    my $mstatus = shift;
    $mstatus ||= $main::status;
    $mstatus == 200;
}

sub ERROR
{
    my $mstatus = shift;
    $mstatus ||= $main::status;
    $mstatus >= 400 && $mstatus < 600;
}

sub request
{
    my ($req, $mua, $MTRACE) = @_;
    $mua    ||= $main::ua;
    $MTRACE ||= $main::TRACE;
    print STDERR ">> " . $req->method . " " . $req->uri . " ==> "
	if $MTRACE;
    #print STDERR "\nCC " . $req->content . "\n" if $MTRACE;
    my $res = $mua->request($req);
    print STDERR $res->status_line . "\n"
	if $MTRACE;
    $res;
}

sub findform
{
    my($forms, $no, $uri) = @_;
    my $f = $forms->[$no-1];
    Carp::croak("No FORM number $no") unless $f;
    my $furi = $f->uri;
    Carp::croak("Wrong FROM name ($furi)") if $uri && $furi !~ /$uri$/;
    $f;
}

sub extract_links
{
    require HTML::TokeParser;
    my $p = HTML::TokeParser->new(\$_[0]);
    my @links;

    while (my $token = $p->get_tag("a")) {
	my $url = $token->[1]{href};
	next unless defined $url;   # probably just a name link
	my $text = $p->get_trimmed_text("/a");
	push(@links, [$url => $text]);
    }
    return @links;
}

sub locate_link
{
    my($where, $links, $base) = @_;
    my $no_links = @$links;
    Carp::croak("Only $no_links links on this page ($where)") if $where >= $no_links;
    require URI;
    URI->new_abs($links->[$where][0], $base);
}

1;

__END__