grep the CPAN — search Perl distributions with regex

LWP-CurlLog

view release on metacpan or search on metacpan

Revision history for LWP::CurlLog

0.03 Wed May 23 17:13:52 CDT 2018
    - Use options from the use line

0.02 Fri Jul 21 16:16:34 CDT 2017
    - Include dependency of LWP::UserAgent

0.01 Mon May 29 16:43:01 CDT 2017
    - LWP::CurlLog a way of logging LWP requests as curl command options

MANIFEST view on Meta::CPAN

Changes
lib/LWP/CurlLog.pm
Makefile.PL
MANIFEST			This list of files
README
t/test.t
META.yml                                 Module YAML meta-data (added by MakeMaker)
META.json                                Module JSON meta-data (added by MakeMaker)

META.json view on Meta::CPAN

{
   "abstract" : "Log LWP::UserAgent / HTTP::Tiny requests as curl commands",
   "author" : [
      "Jacob Gelbman <gelbman@gmail.com>"
   ],
   "dynamic_config" : 1,
   "generated_by" : "ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010",
   "license" : [
      "perl_5"
   ],
   "meta-spec" : {
      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
      "version" : 2
   },
   "name" : "LWP-CurlLog",
   "no_index" : {
      "directory" : [
         "t",
         "inc"
      ]
   },
   "prereqs" : {
      "build" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "0"
         }
      },
      "configure" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "0"
         }
      },
      "runtime" : {
         "requires" : {
            "HTTP::Tiny" : "0",
            "LWP::UserAgent" : "0",
            "perl" : "5.006",
            "strict" : "0",
            "warnings" : "0"
         }
      },
      "test" : {
         "requires" : {
            "Test::More" : "0.88"
         }
      }
   },
   "release_status" : "stable",
   "resources" : {
      "repository" : {
         "type" : "git",
         "url" : "https://github.com/zorgnax/lwpcurllog.git",
         "web" : "https://github.com/zorgnax/lwpcurllog"
      }
   },
   "version" : "0.04",
   "x_serialization_backend" : "JSON::PP version 4.06"
}

META.yml view on Meta::CPAN

---
abstract: 'Log LWP::UserAgent / HTTP::Tiny requests as curl commands'
author:
  - 'Jacob Gelbman <gelbman@gmail.com>'
build_requires:
  ExtUtils::MakeMaker: '0'
  Test::More: '0.88'
configure_requires:
  ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: LWP-CurlLog
no_index:
  directory:
    - t
    - inc
requires:
  HTTP::Tiny: '0'
  LWP::UserAgent: '0'
  perl: '5.006'
  strict: '0'
  warnings: '0'
resources:
  repository: https://github.com/zorgnax/lwpcurllog.git
version: '0.04'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'

Makefile.PL view on Meta::CPAN

use 5.006;
use strict;
use warnings;
use ExtUtils::MakeMaker;

my $mm_ver = $ExtUtils::MakeMaker::VERSION;
if ($mm_ver =~ /_/) {
    $mm_ver = eval $mm_ver;
    die $@ if $@;
}

my %params = (
    NAME => "LWP::CurlLog",
    VERSION_FROM => "lib/LWP/CurlLog.pm",
    ABSTRACT_FROM  => "lib/LWP/CurlLog.pm",
    AUTHOR => "Jacob Gelbman <gelbman\@gmail.com>",
    clean => {FILES => "LWP-CurlLog-*.tar.gz *.bak"},
);

my @requires = (
    "strict" => 0,
    "warnings" => 0,
    "LWP::UserAgent" => 0,
    "HTTP::Tiny" => 0,
);

my @test_requires = (
    "Test::More" => 0.88,
);

if ($mm_ver < 6.64) {
    $params{PREREQ_PM} = {@requires, @test_requires};
}
else {
    $params{PREREQ_PM} = {@requires};
    $params{TEST_REQUIRES} = {@test_requires};
}

if ($mm_ver >= 6.31) {
    $params{LICENSE} = "perl";
}

if ($mm_ver >= 6.48) {
    $params{MIN_PERL_VERSION} = 5.006;
}

if ($mm_ver > 6.45) {
    $params{META_MERGE} = {
        "meta-spec" => {version => 2},
        resources => {
            repository => {
                type => "git",
                web => "https://github.com/zorgnax/lwpcurllog",
                url => "https://github.com/zorgnax/lwpcurllog.git",
            }
        }
    };
}

WriteMakefile(%params);

README view on Meta::CPAN

LWP::CurlLog

INSTALLATION

To install this module type the following:

   perl Makefile.PL
   make
   make test
   make install

MORE INFO

perldoc LWP::CurlLog

COPYRIGHT AND LICENCE

Copyright (C) 2017 by Jacob Gelbman

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.18.2 or,
at your option, any later version of Perl 5 you may have available.

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

package LWP::CurlLog;
use strict;
use warnings;

BEGIN {
    eval {
        require LWP::UserAgent;
    };
    eval {
        require HTTP::Tiny;
    };
}

our $VERSION = "0.04";
our %opts = (
    file => undef,
    response => 1,
    options => "-k",
    timing => 0,
    trace => 0,
);

sub import {
    my ($package, %args) = @_;
    for my $key (keys %args) {
        $opts{$key} = $args{$key};
    }

    if (!$opts{file}) {
        $opts{fh} = \*STDERR;
    }
    else {
        my $expanded_file = $opts{file};
        if ($expanded_file =~ m{^~/}) {
            my $home = $ENV{HOME} || (getpwuid($<))[7];
            $expanded_file =~ s{^~/}{$home/};
        }
        open $opts{fh}, ">>", $expanded_file or die "Can't open $opts{file}: $!";
    }
    select($opts{fh});
    $| = 1;
    select(STDOUT);
}

no strict "refs";
no warnings "redefine";

my $orig_lusr = \&LWP::UserAgent::send_request;
*{"LWP::UserAgent::send_request"} = sub {
    my ($self, $req) = @_;
    my $headers = {};
    for my $name ($req->headers()->header_field_names()) {
        $headers->{$name} = $req->{headers}{$name};
    }
    my $content = $req->decoded_content();
    my $res = request("LWP", $orig_lusr, \@_, $req->method(), $req->uri(), $headers, $content);
    return $res;
};

my $orig_htr = \&HTTP::Tiny::_request;
*{"HTTP::Tiny::_request"} = sub {
    my ($self, $method, $url, $args) = @_;
    my $res = request("HT", $orig_htr, \@_, $method, $url, $args->{headers}, $args->{content});
    return $res;
};

sub request {
    my ($module, $orig_sub, $orig_args, $method, $url, $headers, $content) = @_;

    my $cmd = "curl ";
    if ($url =~ /[=&;?]/) {
        $cmd .= "\"$url\" ";
    }
    else {
        $cmd .= "$url ";
    }
    if ($opts{options}) {
        $cmd .= "$opts{options} ";
    }

    if ($method && ($method ne "GET" || length $content)) {
        $cmd .= "-X $method ";
    }

    for my $name (keys %$headers) {
        if ($name =~ /^(Content-Length|User-Agent)$/i) {
            next;
        }
        my $value = $headers->{$name};
        $value =~ s{([\\\$"])}{\\$1}g;
        $cmd .= "-H \"$name: $value\" ";
    }

    if (defined $content && length $content) {
        $content =~ s{([\\\$"])}{\\$1}g;
        $cmd .= "-d \"$content\" ";
    }
    $cmd =~ s/\s*$//;

    log_print("# " . localtime() . " $module request\n");
    log_print_stack();
    log_print("$cmd\n");
    my $time1 = time();
    my $res = $orig_sub->(@$orig_args);
    my $time2 = time();

    if ($opts{response}) {
        log_print("\n# " . localtime() . " $module response\n");
        my $str;
        if (eval {$res->isa("HTTP::Response")}) {
            $str = $res->as_string();
        }
        else {
            $str = "$res->{protocol} $res->{status} $res->{reason}\n";
            for my $name (keys %{$res->{headers}}) {
                $str .= "$name: $res->{headers}{$name}\n";
            }
            $str .= "\n";
            $str .= $res->{content};
        }
        $str =~ s/\s*$//g;
        log_print("$str\n");
    }
    if ($opts{timing}) {
        my $diff = $time2 - $time1;
        log_print("# ${diff}s\n");
    }

    log_print("\n");

    return $res;
}

sub log_print {
    my (@args) = @_;
    my $mesg = join("", @args);
    print {$opts{fh}} $mesg;
}


sub log_print_stack {
    my @callers;
    for (my $i = 0; my @caller = caller($i); $i++) {
        push @callers, \@caller;
    }

    my @filtered_callers;
    CALLER: for my $caller (reverse @callers) {
        my ($package, $file, $line, $long_name) = @$caller;
        for my $test_package ("LWP::CurlLog", "HTTP::Tiny", "HTTP::AnyUA", "LWP::UserAgent") {
            if ($package =~ /^${test_package}($|::)/) {
                last CALLER;
            }
        }
        push @filtered_callers, $caller;

    }
    if (!$opts{trace}) {
        @filtered_callers = ($filtered_callers[-1]);
    }

    for my $caller (@filtered_callers) {
        my ($package, $file, $line, $long_name) = @$caller;
        my $name = $long_name;
        $name =~ s/.*:://;
        log_print("#     $name $file $line\n");
    }
}

1;

__END__

=encoding utf8

=head1 NAME

LWP::CurlLog - Log LWP::UserAgent / HTTP::Tiny requests as curl commands

=head1 SYNOPSIS

    use LWP::CurlLog;

=head1 DESCRIPTION

This module can be used to log LWP::UserAgent or HTTP::Tiny requests as curl
commands so you can redo requests the perl script makes, manually, on the
command line. Just include a statement "use LWP::CurlLog;" to the top of your
perl script and then check the output for curl commands.

The default location is to STDERR, but you can change it
by setting the file option on the use line like this:

    use LWP::CurlLog file => "~/curl.log";

The log will include the response in it's output. If that's unwanted,
do this:

    use LWP::CurlLog response => 0;

You can include timing information like this:

    use LWP::CurlLog timing => 1;

=head1 METACPAN

L<https://metacpan.org/pod/LWP::CurlLog>

=head1 REPOSITORY

L<https://github.com/zorgnax/lwpcurllog>

=head1 AUTHOR

Jacob Gelbman, E<lt>gelbman@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2017 by Jacob Gelbman

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.18.2 or,
at your option, any later version of Perl 5 you may have available.

=cut

t/test.t view on Meta::CPAN

use strict;
use warnings;
use lib "lib";
use Test::More;
use LWP::CurlLog file => "curl.log", response => 0;
use LWP::UserAgent;

my $ua = LWP::UserAgent->new();
$ua->get("http://www.google.com/");

my $content = `cat curl.log`;

my $test = $content =~ m{^#.* LWP request\n}m &&
           $content =~ m{^curl http://www.google.com/ -k\n}m;
ok $test, "log lines are as expected";

done_testing();

END {
    unlink "curl.log";
}

( run in 2.622 seconds using v1.01-cache-2.11-cpan-5837b0d9d2c )