File Coverage

blib/lib/WWW/Crawl4AI/Result.pm

Criterion	Covered	Total	%
statement	44	45	97.7
branch	16	24	66.6
condition	7	13	53.8
subroutine	12	12	100.0
pod	8	8	100.0
total	87	102	85.2

package WWW::Crawl4AI::Result;
# ABSTRACT: normalized result of a WWW::Crawl4AI strategy chain
use Moo;
use JSON::MaybeXS ();
use URI ();

our $VERSION = '0.001';


has ok         => ( is => 'ro', default => sub { 0 } );


has url        => ( is => 'ro' );


has final_url  => ( is => 'ro' );


has status     => ( is => 'ro' );


has markdown   => ( is => 'ro' );


has html       => ( is => 'ro' );


has title      => ( is => 'ro' );


has backend    => ( is => 'ro' );


has cost_class => ( is => 'ro' );


has signals    => ( is => 'ro', default => sub { {} } );


has why_failed => ( is => 'ro' );


has error      => ( is => 'ro' );


has attempts   => ( is => 'ro', default => sub { [] } );


has links      => ( is => 'ro', default => sub { { internal => [], external => [] } } );


has response_headers => ( is => 'ro', default => sub { {} } );


has _json => (
  is      => 'lazy',
  default => sub { JSON::MaybeXS->new( utf8 => 0, canonical => 1, convert_blessed => 1 ) },
);

sub from_attempt {
  my ( $class, $attempt, %extra ) = @_;
  my $page = $attempt->page || {};
  return $class->new(
    ok         => $attempt->ok,
    url        => $page->{url},
    final_url  => $page->{final_url} // $page->{url},
    status     => $page->{status_code},
    markdown   => $page->{markdown},
    html       => $page->{html},
    title      => $page->{title},
    backend    => $attempt->backend,
    cost_class => $attempt->cost_class,
    signals    => $attempt->signals,
    why_failed => $attempt->why_failed,
    links            => $page->{links} // { internal => [], external => [] },
    response_headers => _lc_headers( $page->{response_headers} ),
    %extra,
  );
}


sub attempt_count { scalar @{ $_[0]->attempts } }


sub internal_links { $_[0]->links->{internal} || [] }


sub external_links { $_[0]->links->{external} || [] }


sub urls {
  my ( $self ) = @_;
  my $base = $self->final_url // $self->url;
  my ( %seen, @urls );
  for my $link ( @{ $self->internal_links }, @{ $self->external_links } ) {
    my $href = ref $link eq 'HASH' ? $link->{href} : $link;
    next unless defined $href && length $href;
    next if $href =~ m{\A(?:javascript|mailto|tel|data):}i;
    next if $href =~ /\A#/;
    my $abs = $base ? URI->new_abs( $href, $base )->as_string : $href;
    next unless $abs =~ m{\Ahttps?://}i;
    next if $seen{$abs}++;
    push @urls, $abs;
  }
  return \@urls;
}


sub to_hash {
  my ( $self ) = @_;
  return {
    ok         => $self->ok ? \1 : \0,
    url        => $self->url,
    final_url  => $self->final_url,
    status     => $self->status,
    backend    => $self->backend,
    cost_class => $self->cost_class,
    title      => $self->title,
    markdown   => $self->markdown,
    signals    => $self->signals,
    why_failed => $self->why_failed,
    links            => $self->links,
    urls             => $self->urls,
    response_headers => $self->response_headers,
    ( defined $self->error ? ( error => "@{[ $self->error ]}" ) : () ),
    attempts   => [ map { $_->to_hash } @{ $self->attempts } ],
  };
}


sub TO_JSON { $_[0]->to_hash }

sub attempts_json {
  my ( $self ) = @_;
  return $self->_json->encode( [ map { $_->to_hash } @{ $self->attempts } ] );
}


# Lowercase all header keys for deterministic, case-insensitive matching by callers.
sub _lc_headers {
  my ($h) = @_;
  return {} unless ref $h eq 'HASH';
  return { map { lc($_) => $h->{$_} } keys %$h };
}

1;

__END__