package Mojo::UserAgent::CookieJar; use Mojo::Base -base; use Mojo::Cookie::Request; use Mojo::Path; use Scalar::Util 'looks_like_number'; has 'ignore'; has max_cookie_size => 4096; sub add { my ($self, @cookies) = @_; my $size = $self->max_cookie_size; for my $cookie (@cookies) { # Convert max age to expires my $age = $cookie->max_age; $cookie->expires($age <= 0 ? 0 : $age + time) if looks_like_number $age; # Check cookie size next if length($cookie->value // '') > $size; # Replace cookie next unless my $domain = lc($cookie->domain // ''); next unless my $path = $cookie->path; next unless length(my $name = $cookie->name // ''); my $jar = $self->{jar}{$domain} ||= []; @$jar = (grep({ _compare($_, $path, $name, $domain) } @$jar), $cookie); } return $self; } sub all { my $jar = shift->{jar}; return [map { @{$jar->{$_}} } sort keys %$jar]; } sub collect { my ($self, $tx) = @_; my $url = $tx->req->url; for my $cookie (@{$tx->res->cookies}) { # Validate domain my $host = lc $url->ihost; $cookie->domain($host)->host_only(1) unless $cookie->domain; my $domain = lc $cookie->domain; if (my $cb = $self->ignore) { next if $cb->($cookie) } next if $host ne $domain && ($host !~ /\Q.$domain\E$/ || $host =~ /\.\d+$/); # Validate path my $path = $cookie->path // $url->path->to_dir->to_abs_string; $path = Mojo::Path->new($path)->trailing_slash(0)->to_abs_string; next unless _path($path, $url->path->to_abs_string); $self->add($cookie->path($path)); } } sub empty { delete shift->{jar} } sub find { my ($self, $url) = @_; my @found; my $domain = my $host = lc $url->ihost; my $path = $url->path->to_abs_string; while ($domain) { next unless my $old = $self->{jar}{$domain}; # Grab cookies my $new = $self->{jar}{$domain} = []; for my $cookie (@$old) { next if $cookie->host_only && $host ne $cookie->domain; # Check if cookie has expired if (defined(my $expires = $cookie->expires)) { next if time > $expires } push @$new, $cookie; # Taste cookie next if $cookie->secure && $url->protocol ne 'https'; next unless _path($cookie->path, $path); my $name = $cookie->name; my $value = $cookie->value; push @found, Mojo::Cookie::Request->new(name => $name, value => $value); } } # Remove another part continue { $domain =~ s/^[^.]*\.*// } return \@found; } sub prepare { my ($self, $tx) = @_; return unless keys %{$self->{jar}}; my $req = $tx->req; $req->cookies(@{$self->find($req->url)}); } sub _compare { my ($cookie, $path, $name, $domain) = @_; return $cookie->path ne $path || $cookie->name ne $name || $cookie->domain ne $domain; } sub _path { $_[0] eq '/' || $_[0] eq $_[1] || index($_[1], "$_[0]/") == 0 } 1; =encoding utf8 =head1 NAME Mojo::UserAgent::CookieJar - Cookie jar for HTTP user agents =head1 SYNOPSIS use Mojo::UserAgent::CookieJar; # Add response cookies my $jar = Mojo::UserAgent::CookieJar->new; $jar->add( Mojo::Cookie::Response->new( name => 'foo', value => 'bar', domain => 'localhost', path => '/test' ) ); # Find request cookies for my $cookie (@{$jar->find(Mojo::URL->new('http://localhost/test'))}) { say $cookie->name; say $cookie->value; } =head1 DESCRIPTION L is a minimalistic and relaxed cookie jar used by L, based on L. =head1 ATTRIBUTES L implements the following attributes. =head2 ignore my $ignore = $jar->ignore; $jar = $jar->ignore(sub {...}); A callback used to decide if a cookie should be ignored by L. # Ignore all cookies $jar->ignore(sub { 1 }); # Ignore cookies for domains "com", "net" and "org" $jar->ignore(sub { my $cookie = shift; return undef unless my $domain = $cookie->domain; return $domain eq 'com' || $domain eq 'net' || $domain eq 'org'; }); =head2 max_cookie_size my $size = $jar->max_cookie_size; $jar = $jar->max_cookie_size(4096); Maximum cookie size in bytes, defaults to C<4096> (4KiB). =head1 METHODS L inherits all methods from L and implements the following new ones. =head2 add $jar = $jar->add(@cookies); Add multiple L objects to the jar. =head2 all my $cookies = $jar->all; Return all L objects that are currently stored in the jar. # Names of all cookies say $_->name for @{$jar->all}; =head2 collect $jar->collect(Mojo::Transaction::HTTP->new); Collect response cookies from transaction. =head2 empty $jar->empty; Empty the jar. =head2 find my $cookies = $jar->find(Mojo::URL->new); Find L objects in the jar for L object. # Names of all cookies found say $_->name for @{$jar->find(Mojo::URL->new('http://example.com/foo'))}; =head2 prepare $jar->prepare(Mojo::Transaction::HTTP->new); Prepare request cookies for transaction. =head1 SEE ALSO L, L, L. =cut