/usr/share/perl5/HTTP/CookieJar/LWP.pm is in libhttp-cookiejar-perl 0.008-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 | use 5.008001;
use strict;
use warnings;
package HTTP::CookieJar::LWP;
# ABSTRACT: LWP adapter for HTTP::CookieJar
our $VERSION = '0.008';
use parent 'HTTP::CookieJar';
sub add_cookie_header {
my ( $self, $request ) = @_;
my $url = _get_url( $request, $request->uri );
return unless ( $url->scheme =~ /^https?\z/ );
my $header = $self->cookie_header($url);
$request->header( Cookie => $header );
return $request;
}
sub extract_cookies {
my ( $self, $response ) = @_;
my $request = $response->request
or return;
my $url = _get_url( $request, $request->uri );
$self->add( $url, $_ ) for $response->_header("Set-Cookie");
return $response;
}
#--------------------------------------------------------------------------#
# helper subroutines
#--------------------------------------------------------------------------#
sub _get_url {
my ( $request, $url ) = @_;
my $new_url = $url->clone;
if ( my $h = $request->header("Host") ) {
$h =~ s/:\d+$//; # might have a port as well
$new_url->host($h);
}
return $new_url;
}
sub _url_path {
my $url = shift;
my $path;
if ( $url->can('epath') ) {
$path = $url->epath; # URI::URL method
}
else {
$path = $url->path; # URI::_generic method
}
$path = "/" unless length $path;
$path;
}
sub _normalize_path # so that plain string compare can be used
{
my $x;
$_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/
$x = uc($1);
$x eq "2F" || $x eq "25" ? "%$x" :
pack("C", hex($x));
/eg;
$_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
}
1;
# vim: ts=4 sts=4 sw=4 et:
__END__
=pod
=encoding UTF-8
=head1 NAME
HTTP::CookieJar::LWP - LWP adapter for HTTP::CookieJar
=head1 VERSION
version 0.008
=head1 SYNOPSIS
use LWP::UserAgent;
use HTTP::CookieJar::LWP;
my $ua = LWP::UserAgent->new(
cookie_jar => HTTP::CookieJar::LWP->new
);
=head1 DESCRIPTION
This module is an experimental adapter to make L<HTTP::CookieJar> work with
L<LWP>. It implements the two methods that C<LWP> calls from L<HTTP::Cookies>.
It is not a general-purpose drop-in replacement for C<HTTP::Cookies> in any
other way.
=for Pod::Coverage method_names_here
add_cookie_header
extract_cookies
=head1 AUTHOR
David Golden <dagolden@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2013 by David Golden.
This is free software, licensed under:
The Apache License, Version 2.0, January 2004
=cut
|