view release on metacpan or  search on metacpan

lib/Cookies/Roundtrip.pm  view on Meta::CPAN

package Cookies::Roundtrip;

# NOTE: HTTP::Cookies and HTTP::CookieJar and
# Firefox::Marionette::Cookie
# have expires or expiry fields.
# some can be undef which has a special meaning:
# they are session cookies (which are deleted when session/browser/tab is closed).
# THEY ALL store expiry as unix epoch seconds.
# BUT SetCookie needs a "YYYY-MM-DD hh:mm:ssZ"-formatted string representing Universal Time.
# use this: HTTP::Date::time2isoz(epochsecs)

use strict;
use warnings;

our $VERSION = '0.01';

use HTTP::Cookies;
use HTTP::CookieJar;
use Firefox::Marionette::Cookie;
use HTTP::Date qw(str2time parse_date time2str);
use HTTP::Response;
use HTTP::Request;
use DateTime;
use HTTP::Headers::Util qw/join_header_words/;
use Data::Compare;
use Devel::StackTrace; # until the module is stable

use Data::Roundtrip qw/perl2dump no-unicode-escape-permanently/;

use Exporter; # you need to import 'import' if you don't define it further down
# the EXPORT_OK and EXPORT_TAGS is code by [kcott] @ Perlmongs.org, thanks!
# see https://perlmonks.org/?node_id=11115288
our (@EXPORT_OK, %EXPORT_TAGS);
# For all the EXPORT subs and tags see the BEGIN{} block at the end

sub	lwpuseragent_get_cookies {
	my ($ua, $verbosity) = @_;
	#$verbosity //= 0;
	#my $parent = ( caller(1) )[3] || "N/A";
	#my $whoami = ( caller(0) )[3];
	return $ua->cookie_jar
}

# Save cookies of LWP::UserAgent (they are HTTP::CookieJar)
# into a file. The file will be empty if no cookies.
# It returns 1 on failure, 0 on success.
sub	lwpuseragent_save_cookies_to_file {
	my ($ua, $filename, $skip_discard, $verbosity) = @_;
	$verbosity //= 0;
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];

	# LWP::UserAgent supports both HTTP::Cookies and HTTP::CookieJar
	# cookie jars (depending on the 'cookie_jar_class' param to their constructor)
	# we need to find the class of the cookie jar of mech
	# this is probably unsupported but there is no other way:
	my $cookie_jar_class = $ua->{'cookie_jar_class'};

	if( $cookie_jar_class eq 'HTTP::Cookies' ){
		if( httpcookies2file(
			defined($ua->cookie_jar) ? $ua->cookie_jar : $cookie_jar_class->new(),
			$filename, $skip_discard, $verbosity
		) ){ print STDERR "${whoami}, line ".__LINE__." (via $parent): error, call to ".'httpcookies2file()'." has failed.\n"; return 1 }
	} elsif( ($cookie_jar_class eq 'HTTP::CookieJar') || ($cookie_jar_class eq 'HTTP::CookieJar::LWP') ){
		if( httpcookiejar2file(
			defined($ua->cookie_jar) ? $ua->cookie_jar : $cookie_jar_class->new(),
			$filename, $skip_discard, $verbosity
		) ){ print STDERR "${whoami}, line ".__LINE__." (via $parent): error, call to ".'httpcookies2file()'." has failed.\n"; return 1 }
	} else {
		print STDERR "${whoami}, line ".__LINE__." (via $parent): error, input cookies type '$cookie_jar_class' is not known. Known cookies types are 'HTTP::Cookies' and 'HTTP::CookieJar'.\n";
		return 0
	}

	return 0 # success
}

# Convenience method to load any kind of cookies
# or a cookies file, into the LWP::UserAgent
# it returns the $ua's cookie_jar on success or undef on failure
sub	lwpuseragent_load_cookies {
	my ($ua, $cookies_or_file_etc, $verbosity) = @_;
	$verbosity //= 0;
	my $parent = ( caller(1) )[3] || "N/A";
	my $whoami = ( caller(0) )[3];

	my $r = ref($cookies_or_file_etc);
	if( $r eq 'HTTP::Cookies' ){
		my $ret = lwpuseragent_load_httpcookies($ua, $cookies_or_file_etc, $verbosity);