view release on metacpan or  search on metacpan

t/245-roundtrip-firefoxmarionettecookies-setcookies-via-httpcookies.t  view on Meta::CPAN

#!/usr/bin/env perl

###################################################################
#### NOTE env-var PERL_TEST_TEMPDIR_TINY_NOCLEANUP=1 will stop erasing tmp files
###################################################################

use strict;
use warnings;

#use utf8;

our $VERSION = '0.01';

use Test::More;
use Test::More::UTF8;
use Test::Deep '!blessed';
use FindBin;
use Test::TempDir::Tiny;
use HTTP::CookieJar;

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

use lib ($FindBin::Bin, 'blib/lib');

use Cookies::Roundtrip qw/:all/;

my $VERBOSITY = 4; # we need verbosity of 10 (max), so this is not used

my $curdir = $FindBin::Bin;

require(File::Spec->catfile($curdir, 'MY', 'CookieMaker.pm'));
# if you don't use any of these it will complain:
#   "..." used only once: possible typo at ...
#ok(@MY::CookieMaker::HTTPCookieJar_cases, "Library 'CookieMaker.pm' loaed OK/1.") or BAIL_OUT;
ok(@MY::CookieMaker::HTTPCookies_cases, "Library 'CookieMaker.pm' loaed OK/2.") or BAIL_OUT;

# if for debug you change this make sure that it has path in it e.g. ./xyz
#my $tmpdir = tempdir(); # will be erased unless a BAIL_OUT or env var set
#ok(-d $tmpdir, "tmpdir exists $tmpdir") or BAIL_OUT;

my $skip_discard = 0;

for my $c (@MY::CookieMaker::HTTPCookies_cases) {
	
	#next unless $c->{label} =~ /path prefix \/foo\/ stored$/;

	# these creates problems, do not use:
	#next if $c->{label} =~ / localhost treated as host only$/;

        diag "\n==================\ntest " . $c->{label} . "\n==================\n";    

	my $httpcookies = $c->{getcookie}->();
	ok(defined $httpcookies, "(label : ".$c->{'label'}.") : got the HTTP::Cookies object by running the test sub.") or BAIL_OUT;

	# now do the roundtrip

	if( $VERBOSITY > 2 ){ explain $httpcookies->{store} }

	my $setcookies = httpcookies2setcookies($httpcookies, undef, $skip_discard, $VERBOSITY);
	ok(defined $setcookies, 'httpcookies2setcookies()'." : called and got good result.") or BAIL_OUT(as_string_cookies($httpcookies)."\nno it failed for above httpcookies.");

	# HTTP::Cookies need domain to start with a dot
	# and we use setcookies2httpcookies internally so:
	#for (@$setcookies){
	#	$_ =~ s/;\s*Domain=([^.])/; Domain=.$1/i;
	#}

	# cookiejar -> firefoxmarionettecookies
	my $firefoxmarionettecookies = setcookies2firefoxmarionettecookies($setcookies, undef, $skip_discard, $VERBOSITY);
	ok(defined $firefoxmarionettecookies, 'setcookies2firefoxmarionettecookies()'." (label '".$c->{label}."') : called and got good result.") or BAIL_OUT;

	if( $VERBOSITY > 2 ){ diag "HTTP::Cookies: ".as_string_cookies($firefoxmarionettecookies) }

	# firefoxmarionettecookies -> cookiejar
	my $new_setcookies = firefoxmarionettecookies2setcookies($firefoxmarionettecookies, undef, $skip_discard, $VERBOSITY);
	ok(defined($new_setcookies), 'firefoxmarionettecookies2setcookies()'." : (label '".$c->{label}."') : called and got good results.") or BAIL_OUT;

	if( $VERBOSITY > 2 ){
		diag "OLD (label '".$c->{label}."') :\n"; diag explain $setcookies;
		diag "NEW (label '".$c->{label}."') :\n"; diag explain $new_setcookies;
	}