Mojo-UserAgent-Cached

 view release on metacpan or  search on metacpan

lib/Mojo/UserAgent/Cached.pm  view on Meta::CPAN


    $flattened_sorted_url .= '?' . join '&', sort { $a cmp $b } List::Util::pairmap { (($b ne '') ? (join '=', $a, $b) : $a); } @{ $url->query }
        if scalar @{ $url->query };

    return $flattened_sorted_url;
}

sub _serialize_tx {
    my ($tx) = @_;

    $tx->res->headers->header('X-Mojo-UserAgent-Cached', time);

    return {
        method  => $tx->req->method,
        url     => $tx->req->url,
        code    => $tx->res->code,
        body    => $tx->res->body,
        json    => $tx->res->json,
        headers => $tx->res->headers->to_hash,
    };
}

sub _build_fake_tx {
    my ($opts) = @_;

    # Create transaction object to return so we look like a regular request
    my $tx = Mojo::Transaction::HTTP->new();

    $tx->req->method($opts->{method});
    $tx->req->url(Mojo::URL->new($opts->{url}));

    $tx->res->headers->from_hash($opts->{headers});

    my $now = time;
    $tx->res->headers->header('X-Mojo-UserAgent-Cached-Age', $now - ($tx->res->headers->header('X-Mojo-UserAgent-Cached') || $now));

    $tx->res->code($opts->{code});
    $tx->res->{json} = $opts->{json};
    $tx->res->body($opts->{body});

    $tx->{events} = $opts->{events};
    $tx->req->{events} = $opts->{req_events};
    $tx->res->{events} = $opts->{res_events};

    return $tx;
}

sub _parse_local_file_res {
    my ($self, $url) = @_;

    my $headers;
    my $body = Mojo::File->new($url)->slurp;
    my $code = $HTTP_OK;
    my $msg  = 'OK';

    if ($body =~ m{\A (?: DELETE | GET | HEAD | OPTIONS | PATCH | POST | PUT ) \s }gmx) {
        my $code_msg_headers;
        my $code_msg;
        my $http;
        my $msg;
        (undef, $code_msg_headers, $body) = split m{(?:\r\n|\n){2,}}mx, $body,             3; ## no critic (ProhibitMagicNumbers)
        ($code_msg, $headers)             = split m{(?:\r\n|\n)}mx,     $code_msg_headers, 2;
        ($http, $code, $msg)              = $code_msg =~ m{ \A (?:(\S+) \s+)? (\d+) \s+ (.*) \z}mx;

        $headers = Mojo::Headers->new->parse("$headers\n\n")->to_hash;
    }

    return { body => $body, code => $code, message => $msg, headers => $headers };
}

sub _write_local_file_res {
    my ($self, $tx, $dir) = @_;

    return unless ($dir && -e $dir && -d $dir);

    my $method = $tx->req->method;
    my $url  = $tx->req->url;
    my $body = $tx->res->body;
    my $code = $tx->res->code;
    my $message = $tx->res->message;

    my $target_file = File::Spec->catfile($dir, split '/', $url->path_query);
    File::Path::make_path(File::Basename::dirname($target_file));
    Mojo::File->new($target_file)->spurt((
        join "\n\n",
           (join " ", $method, "$url\n"  ) . $tx->req->headers->to_string,
           (join " ", $code, "$message\n") . $tx->res->headers->to_string,
           $body
        )
    ) and $self->logger->debug("Wrote request+response to: '$target_file'");
}

sub _log_line {
    my ($self, $tx, $opts) = @_;

    $self->_write_local_file_res($tx, $ENV{MUAC_CLIENT_WRITE_LOCAL_FILE_RES_DIR});

    my $callers = $self->_get_stacktrace;
    my $created_stacktrace = $self->created_stacktrace;

    # Remove common parts to get smaller created stacktrace
    my $strings = Algorithm::LCSS::CSS_Sorted( [ split /,/, $callers ] , [ split /,/, $created_stacktrace ] );
    map {
        my @lcss = @{$_};
        my $pat = join ",", @lcss[1..$#lcss-1];
        if (scalar @lcss > 2) { $created_stacktrace =~ s{$pat}{,}mx }
    } @{ $strings || [] };

    $self->logger->debug(sprintf(q{Returning %s '%s' => %s for %s (%s)}, (
        $opts->{type},
        String::Truncate::elide( $tx->req->url, 150, { truncate => 'middle'} ),
        ($tx->res->code || $tx->res->error->{code} || $tx->res->error->{message}),
        $callers, $created_stacktrace
    )));

    return unless $self->access_log;

    my $elapsed_time = sprintf '%.3f', (time-$opts->{start_time});

    my $NONE = q{-};

    my $http_host              = $tx->req->url->host                                   || $NONE;



( run in 1.463 second using v1.01-cache-2.11-cpan-71847e10f99 )