File Coverage

blib/lib/WWW/Crawl4AI/Client.pm

Criterion	Covered	Total	%
statement	139	238	58.4
branch	49	122	40.1
condition	26	136	19.1
subroutine	38	60	63.3
pod	35	35	100.0
total	287	591	48.5

package WWW::Crawl4AI::Client;
# ABSTRACT: UA-agnostic REST client for the Crawl4AI Docker API
use Moo;
use Carp qw( croak );
use HTTP::Request ();
use JSON::MaybeXS ();
use URI ();
use URI::Escape ();
use MIME::Base64 ();
use Safe::Isa;
use WWW::Crawl4AI::Markdown qw( resolve_markdown_chain );
use WWW::Crawl4AI::Request ();
use WWW::Crawl4AI::Error ();

our $VERSION = '0.001';


has base_url => (
  is      => 'ro',
  default => sub { $ENV{CRAWL4AI_URL} || $ENV{CRAWL4AI_BASE_URL} || 'http://localhost:11235' },
);


has api_token => (
  is      => 'ro',
  default => sub { $ENV{CRAWL4AI_API_TOKEN} },
);


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

has user_agent_string => (
  is      => 'ro',
  default => sub { "WWW-Crawl4AI/$VERSION" },
);


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


has ua => ( is => 'lazy' );


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


has retry_backoff  => ( is => 'ro', default => sub { [ 1, 2, 4 ] } );


has retry_statuses => ( is => 'ro', default => sub { [ 429, 502, 503, 504 ] } );


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


has sleep_sub => (
  is      => 'ro',
  default => sub {
    require Time::HiRes;
    return sub { Time::HiRes::sleep( $_[0] ) };
  },
);


has _retry_status_set => ( is => 'lazy' );
sub _build__retry_status_set {
  return { map { $_ => 1 } @{ $_[0]->retry_statuses } };
}

sub _build_ua {
  my ( $self ) = @_;
  require LWP::UserAgent;
  return LWP::UserAgent->new(
    agent   => $self->user_agent_string,
    timeout => $self->timeout,
  );
}

sub is_request { $_[1]->$_isa('HTTP::Request') }


sub _uri {
  my ( $self, $path ) = @_;
  ( my $base = $self->base_url ) =~ s{/+$}{};
  return URI->new( $base . $path );
}

sub _request {
  my ( $self, $method, $path, $body ) = @_;
  my $req = HTTP::Request->new( $method => $self->_uri($path) );
  $req->header( Accept => 'application/json' );
  $req->header( Authorization => 'Bearer ' . $self->api_token ) if defined $self->api_token;
  if ( defined $body ) {
    $req->header( 'Content-Type' => 'application/json' );
    $req->content( $self->_json->encode($body) );
  }
  return $req;
}

#----------------------------------------------------------------------
# Request builders (no I/O)
#----------------------------------------------------------------------

sub crawl_request {
  my ( $self, $request ) = @_;
  return $self->_request( POST => '/crawl', $self->_payload( $request, 'to_crawl_payload' ) );
}


sub md_request {
  my ( $self, $request ) = @_;
  return $self->_request( POST => '/md', $self->_payload( $request, 'to_md_payload' ) );
}

sub job_submit_request {
  my ( $self, $request ) = @_;
  return $self->_request( POST => '/crawl/job', $self->_payload( $request, 'to_crawl_payload' ) );
}

sub job_status_request {
  my ( $self, $task_id ) = @_;
  croak "job_status_request needs a task_id" unless defined $task_id && length $task_id;
  return $self->_request( GET => '/crawl/job/' . $task_id );
}

sub health_request { $_[0]->_request( GET => '/health' ) }

sub screenshot_request {
  my ( $self, $url, %opts ) = @_;
  croak "screenshot_request needs a url" unless defined $url && length $url;
  my %body = ( url => $url );
  $body{screenshot_wait_for} = $opts{wait_for}    if defined $opts{wait_for};
  $body{output_path}         = $opts{output_path} if defined $opts{output_path};
  $body{wait_for_images} =
    $opts{wait_for_images} ? WWW::Crawl4AI::Request::JSON_true() : WWW::Crawl4AI::Request::JSON_false()
    if exists $opts{wait_for_images};
  return $self->_request( POST => '/screenshot', \%body );
}


sub pdf_request {
  my ( $self, $url, %opts ) = @_;
  croak "pdf_request needs a url" unless defined $url && length $url;
  my %body = ( url => $url );
  $body{output_path} = $opts{output_path} if defined $opts{output_path};
  return $self->_request( POST => '/pdf', \%body );
}

sub html_request {
  my ( $self, $url ) = @_;
  croak "html_request needs a url" unless defined $url && length $url;
  return $self->_request( POST => '/html', { url => $url } );
}

sub execute_js_request {
  my ( $self, $url, $scripts ) = @_;
  croak "execute_js_request needs a url" unless defined $url && length $url;
  $scripts = [$scripts] unless ref $scripts eq 'ARRAY';
  croak "execute_js_request needs at least one script" unless @$scripts && defined $scripts->[0];
  return $self->_request( POST => '/execute_js', { url => $url, scripts => $scripts } );
}

sub llm_request {
  my ( $self, $url, $query, %opts ) = @_;
  croak "llm_request needs a url"   unless defined $url   && length $url;
  croak "llm_request needs a query" unless defined $query && length $query;
  # The page URL is a path segment ({url:path}); escape it so its own scheme and
  # query string don't merge into ours. The question and tuning go in the query.
  my $path = URI->new( '/llm/' . URI::Escape::uri_escape_utf8($url) );
  $path->query_form(
    q => $query,
    ( defined $opts{provider}    ? ( provider    => $opts{provider} )    : () ),
    ( defined $opts{temperature} ? ( temperature => $opts{temperature} ) : () ),
    ( defined $opts{base_url}    ? ( base_url     => $opts{base_url} )    : () ),
  );
  return $self->_request( GET => $path->as_string );
}

sub token_request {
  my ( $self, $email, %opts ) = @_;
  croak "token_request needs an email" unless defined $email && length $email;
  my %body = ( email => $email );
  $body{api_token} = $opts{api_token} if defined $opts{api_token};
  return $self->_request( POST => '/token', \%body );
}

sub _payload {
  my ( $self, $request, $method ) = @_;
  return $request->$method if $request->$_isa('WWW::Crawl4AI::Request');
  return $request if ref $request eq 'HASH';
  croak "expected a WWW::Crawl4AI::Request or hashref payload";
}

#----------------------------------------------------------------------
# Response parsers (no I/O)
#----------------------------------------------------------------------

sub _decode {
  my ( $self, $res, $backend ) = @_;
  my $code = $res->code;
  my $body = $res->decoded_content // $res->content // '';
  my $data = eval { length $body ? $self->_json->decode($body) : undef };
  if ( !$res->is_success ) {
    die WWW::Crawl4AI::Error->new(
      type        => 'api',
      message     => "Crawl4AI HTTP $code: " . ( $res->message // 'error' ),
      response    => $res,
      data        => $data,
      status_code => $code,
      backend     => $backend,
    );
  }
  return $data;
}

sub parse_crawl_response {
  my ( $self, $res, $backend ) = @_;
  my $data = $self->_decode( $res, $backend );
  return [ map { $self->_normalize_page($_) } @{ $self->_result_list($data) } ];
}


sub parse_md_response {
  my ( $self, $res, $backend ) = @_;
  my $data = $self->_decode( $res, $backend );
  return $data if !ref $data;
  # /md commonly returns { markdown => ... } or { result => ... }
  return $data->{markdown} // $data->{result} // $data->{md} // $data;
}

sub parse_job_submit_response {
  my ( $self, $res, $backend ) = @_;
  my $data = $self->_decode( $res, $backend );
  my $id = $data->{task_id} // $data->{job_id} // $data->{id};
  croak "Crawl4AI job submit returned no task_id" unless defined $id;
  return { task_id => $id, raw => $data };
}

sub parse_job_status_response {
  my ( $self, $res, $backend ) = @_;
  my $data = $self->_decode( $res, $backend );
  my $status = uc( $data->{status} // $data->{state} // 'UNKNOWN' );
  my $pages;
  if ( $status eq 'COMPLETED' ) {
    my $results = $data->{results} // $data->{result} // $data->{data};
    $pages = [ map { $self->_normalize_page($_) } @{ $self->_result_list($results) } ]
      if defined $results;
  }
  if ( $status eq 'FAILED' ) {
    die WWW::Crawl4AI::Error->new(
      type    => 'job',
      message => "Crawl4AI job failed: " . ( $data->{error} // $data->{detail} // 'unknown' ),
      data    => $data,
      backend => $backend,
    );
  }
  return { status => $status, pages => $pages, raw => $data };
}

sub parse_health_response {
  my ( $self, $res ) = @_;
  return 0 unless $res->is_success;
  my $data = eval { $self->_json->decode( $res->decoded_content // '' ) };
  return $data if ref $data;
  return 1;
}

sub parse_screenshot_response {
  my ( $self, $res, $backend ) = @_;
  return $self->_decode_b64_artifact( $self->_decode( $res, $backend ), 'screenshot', $backend );
}


sub parse_pdf_response {
  my ( $self, $res, $backend ) = @_;
  return $self->_decode_b64_artifact( $self->_decode( $res, $backend ), 'pdf', $backend );
}

# /screenshot and /pdf return { success => bool,  => base64 }. Decode to raw
# bytes; raise a content error if the server reported nothing usable.
sub _decode_b64_artifact {
  my ( $self, $data, $key, $backend ) = @_;
  my $b64 = ref $data eq 'HASH' ? $data->{$key} : undef;
  unless ( defined $b64 && length $b64 ) {
    die WWW::Crawl4AI::Error->new(
      type    => 'content',
      message => "Crawl4AI returned no $key",
      data    => $data,
      backend => $backend,
    );
  }
  return MIME::Base64::decode_base64($b64);
}

sub parse_html_response {
  my ( $self, $res, $backend ) = @_;
  my $data = $self->_decode( $res, $backend );
  return ref $data eq 'HASH' ? $data->{html} : $data;
}


sub parse_execute_js_response {
  my ( $self, $res, $backend ) = @_;
  my $data = $self->_decode( $res, $backend );
  # /execute_js returns a single crawl result (same shape as one /crawl page)
  # with the script output added under js_execution_result.
  my $page = $self->_normalize_page( ref $data eq 'HASH' ? $data : { raw => $data } );
  $page->{js_result} = ref $data eq 'HASH' ? $data->{js_execution_result} : undef;
  return $page;
}


sub parse_llm_response {
  my ( $self, $res, $backend ) = @_;
  my $data = $self->_decode( $res, $backend );
  return ref $data eq 'HASH' ? ( $data->{answer} // $data->{result} // $data ) : $data;
}


sub parse_token_response {
  my ( $self, $res, $backend ) = @_;
  return $self->_decode( $res, $backend );
}


# Crawl4AI has returned the page list in several shapes across versions;
# accept all of them rather than pin to one.
sub _result_list {
  my ( $self, $data ) = @_;
  return [] unless defined $data;
  return $data if ref $data eq 'ARRAY';
  if ( ref $data eq 'HASH' ) {
    for my $key (qw( results data result )) {
      my $v = $data->{$key} or next;
      return $v if ref $v eq 'ARRAY';
      return [$v] if ref $v eq 'HASH';
    }
    # Looks like a single page itself.
    return [$data] if exists $data->{markdown} || exists $data->{html} || exists $data->{success};
  }
  return [];
}

sub _normalize_page {
  my ( $self, $page ) = @_;
  return { raw => $page } unless ref $page eq 'HASH';
  my $meta = $page->{metadata} || {};
  return {
    success          => $page->{success},
    url              => $meta->{sourceURL} // $page->{url} // $meta->{url},
    final_url        => $page->{redirected_url} // $page->{url} // $meta->{url},
    status_code      => $page->{status_code} // $page->{status} // $meta->{statusCode},
    markdown         => $self->_extract_markdown($page),
    html             => $page->{cleaned_html} // $page->{html},
    raw_html         => $page->{html},
    title            => $meta->{title},
    links            => $self->_extract_links($page),
    metadata         => $meta,
    error            => $page->{error_message} // $page->{error},
    response_headers => $self->_lc_headers( $page->{response_headers} ),
    raw              => $page,
  };
}

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

# Crawl4AI returns links as { internal => [...], external => [...] }, each entry
# a hash with href/text/title (older servers may send bare strings). Normalize
# to a stable { internal => [{href,text,title}], external => [...] } shape so the
# Result can expose them without callers reaching into raw.
sub _extract_links {
  my ( $self, $page ) = @_;
  my $links = $page->{links};
  return { internal => [], external => [] } unless ref $links eq 'HASH';
  return {
    internal => $self->_normalize_link_list( $links->{internal} ),
    external => $self->_normalize_link_list( $links->{external} ),
  };
}

sub _normalize_link_list {
  my ( $self, $list ) = @_;
  return [] unless ref $list eq 'ARRAY';
  return [ map { $self->_normalize_link($_) } @$list ];
}

sub _normalize_link {
  my ( $self, $link ) = @_;
  return { href => $link } unless ref $link eq 'HASH';
  my $text = $link->{text};
  $text = undef unless defined $text && length $text;
  return {
    href  => $link->{href},
    text  => $text,
    title => $link->{title},
  };
}

# markdown is a plain string on old servers and a structured object on new ones.
# fit_markdown is preferred but is frequently an empty string (no content
# filter matched), so skip empty candidates instead of stopping at the first
# defined one.
sub _extract_markdown {
  my ( $self, $page ) = @_;
  return resolve_markdown_chain( $page->{markdown} );
}

#----------------------------------------------------------------------
# I/O + retry
#----------------------------------------------------------------------

sub do_request {
  my ( $self, $req, $backend ) = @_;
  croak "do_request needs an HTTP::Request" unless $self->is_request($req);
  my $max = $self->max_attempts;
  my $res;
  for my $attempt ( 1 .. $max ) {
    $res = $self->ua->request($req);
    last if $res->is_success;
    my $code = $res->code;
    my $transport = $code == 599 || ( ( $res->header('Client-Warning') // '' ) eq 'Internal response' );
    my $retryable = $transport || $self->_retry_status_set->{$code};
    if ( $retryable && $attempt < $max ) {
      my $delay = $self->retry_backoff->[ $attempt - 1 ] // $self->retry_backoff->[-1] // 1;
      if ( my $ra = $res->header('Retry-After') ) {
        $delay = $ra if $ra =~ /^\d+$/;
      }
      $self->on_retry->( $attempt, $delay, $res ) if $self->on_retry;
      $self->sleep_sub->($delay);
      next;
    }
    last;
  }
  if ( !$res->is_success && ( $res->code == 599 ) ) {
    die WWW::Crawl4AI::Error->new(
      type        => 'transport',
      message     => "Crawl4AI transport error: " . ( $res->content // $res->message // 'unreachable' ),
      response    => $res,
      status_code => 0,
      backend     => $backend,
    );
  }
  return $res;
}


#----------------------------------------------------------------------
# Convenience (build + fire + parse)
#----------------------------------------------------------------------

sub crawl {
  my ( $self, $request, $backend ) = @_;
  return $self->parse_crawl_response( $self->do_request( $self->crawl_request($request), $backend ), $backend );
}


sub md {
  my ( $self, $url, %opts ) = @_;
  my $request = $url->$_isa('WWW::Crawl4AI::Request')
    ? $url
    : WWW::Crawl4AI::Request->new( urls => $url, %opts );
  return $self->parse_md_response( $self->do_request( $self->md_request($request) ) );
}

sub job_submit {
  my ( $self, $request ) = @_;
  return $self->parse_job_submit_response( $self->do_request( $self->job_submit_request($request) ) );
}

sub job_status {
  my ( $self, $task_id ) = @_;
  return $self->parse_job_status_response( $self->do_request( $self->job_status_request($task_id) ) );
}

sub health {
  my ( $self ) = @_;
  my $res = eval { $self->do_request( $self->health_request ) };
  return 0 if $@ || !$res;
  return $self->parse_health_response($res) ? 1 : 0;
}

sub screenshot {
  my ( $self, $url, %opts ) = @_;
  return $self->parse_screenshot_response( $self->do_request( $self->screenshot_request( $url, %opts ) ) );
}


sub pdf {
  my ( $self, $url, %opts ) = @_;
  return $self->parse_pdf_response( $self->do_request( $self->pdf_request( $url, %opts ) ) );
}

sub html {
  my ( $self, $url ) = @_;
  return $self->parse_html_response( $self->do_request( $self->html_request($url) ) );
}

sub execute_js {
  my ( $self, $url, $scripts ) = @_;
  return $self->parse_execute_js_response( $self->do_request( $self->execute_js_request( $url, $scripts ) ) );
}

sub llm {
  my ( $self, $url, $query, %opts ) = @_;
  return $self->parse_llm_response( $self->do_request( $self->llm_request( $url, $query, %opts ) ) );
}

sub token {
  my ( $self, $email, %opts ) = @_;
  return $self->parse_token_response( $self->do_request( $self->token_request( $email, %opts ) ) );
}


1;

__END__