view release on metacpan or  search on metacpan

lib/LWP/ConsoleLogger.pm  view on Meta::CPAN

    default => 1,
);

has headers_to_redact => (
    is      => 'rw',
    isa     => ArrayRef,
    lazy    => 1,
    builder => '_build_headers_to_redact',
);

has html_restrict => (
    is      => 'rw',
    isa     => InstanceOf ['HTML::Restrict'],
    lazy    => 1,
    default => sub { HTML::Restrict->new },
);

has logger => (
    is      => 'rw',
    isa     => InstanceOf ['Log::Dispatch'],
    lazy    => 1,
    handles => { _debug => 'debug' },
    default => sub {
        return Log::Dispatch->new(
            outputs => [
                [ 'Screen', min_level => 'debug', newline => 1, utf8 => 1, ],
            ],
        );
    },
);

has params_to_redact => (
    is      => 'rw',
    isa     => ArrayRef,
    lazy    => 1,
    builder => '_build_params_to_redact',
);

has pretty => (
    is      => 'rw',
    isa     => Bool,
    default => 1,
);

has term_width => (
    is       => 'rw',
    isa      => PositiveInt,
    required => 0,
    lazy     => 1,
    builder  => '_build_term_width',
);

has text_pre_filter => (
    is  => 'rw',
    isa => CodeRef,
);

sub _build_headers_to_redact {
    my $self = shift;
    return $ENV{LWPCL_REDACT_HEADERS}
        ? [ split m{,}, $ENV{LWPCL_REDACT_HEADERS} ]
        : [];
}

sub _build_params_to_redact {
    my $self = shift;
    return $ENV{LWPCL_REDACT_PARAMS}
        ? [ split m{,}, $ENV{LWPCL_REDACT_PARAMS} ]
        : [];
}

sub request_callback {
    my $self = shift;
    my $req  = shift;
    shift;

    if ( $self->dump_uri ) {
        my $uri_without_query = $req->uri->clone;
        $uri_without_query->query(undef);

        $self->_debug( $req->method . q{ } . $uri_without_query . "\n" );
    }

    if ( $req->method eq 'GET' ) {
        $self->_log_params( $req, 'GET' );
    }
    else {
        $self->_log_params( $req, $_ ) for ( 'GET', $req->method );
    }

    $self->_log_headers( 'request (before sending)', $req->headers );

    # This request might have a body.
    return unless $req->content;

    $self->_log_content($req);
    $self->_log_text($req);
    return;
}

sub response_callback {
    my $self = shift;
    my $res  = shift;
    my $ua   = shift;

    $self->_log_headers( 'request (after sending)', $res->request->headers );

    if ( $self->dump_status ) {
        $self->_debug( '==> ' . $res->status_line . "\n" );
    }
    if ( $self->dump_title && $ua->can('title') && $ua->title ) {
        $self->_debug(
            'Title: ' . $self->_decode_header_value( $ua->title ) . "\n" );
    }

    $self->_log_headers( 'response', $res->headers );
    $self->_log_cookies( 'response', $ua->cookie_jar, $res->request->uri );

    $self->_log_content($res);
    $self->_log_text($res);
    return;
}

sub _decode_header_value {
    my ( $self, $val ) = @_;
    return $val unless defined $val && length $val;
    return $val if utf8::is_utf8($val);