File Coverage

blib/lib/HTTP/Cookies/Safari.pm

Criterion	Covered	Total	%
statement	72	73	98.6
branch	7	14	50.0
condition	7	18	38.8
subroutine	12	12	100.0
pod	2	2	100.0
total	100	119	84.0

package HTTP::Cookies::Safari;
use strict;

use warnings;
no warnings;

=head1 NAME

HTTP::Cookies::Safari - Cookie storage and management for Safari

=head1 SYNOPSIS

	use HTTP::Cookies::Safari;

	my $cookie_jar = HTTP::Cookies::Safari->new;
	$cookie_jar->load( '/Users/Buster/Library/Cookies/Cookies.plist' );

	# otherwise same as HTTP::Cookies

=head1 DESCRIPTION

This package overrides the C and C methods of
C so it can work with Safari cookie files.

Note: If the source Safari cookie file specifies and expiry date past
the unix 32-bit epoch, this file changes the expiry date to 0xFFFFFFFF
in unix seconds. That should be enough for anyone, at least to the
next release.

See L.

=head1 SOURCE AVAILABILITY

This module is in Github:

	http://github.com/briandfoy/HTTP-Cookies-Safari

=head1 AUTHOR

brian d foy, C<<  >>

=head1 CREDITS

Jon Orwant pointed out the problem with dates too far in the future

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2003-2011 brian d foy.  All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

#
#
#		Domain
#		usatoday.com
#		Expires
#		2020-02-19T14:28:00Z
#		Name
#		v1st
#		Path
#		/
#		Value
#		3E1B9B935912A908
#

use base qw( HTTP::Cookies );
use vars qw( $VERSION );

use constant TRUE  => 'TRUE';
use constant FALSE => 'FALSE';

$VERSION = '1.15';

use Date::Calc;
use Mac::PropertyList;

sub load
	{
    my( $self, $file ) = @_;

    $file ||= $self->{'file'} || return;

    local $_;
    local $/ = "\n";  # make sure we got standard record separator

    open my( $fh ), $file or return;

    my $data = do { local $/; <$fh> };

    my $plist = Mac::PropertyList::parse_plist( $data );

 	my $cookies = $plist->value;

 	foreach my $hash ( @$cookies )
    	{
    	my $cookie = $hash->value;

    	my @bits  = map { $cookie->{$_}->value }
    		qw( Domain Path Name Value Expires );
    		#     0     1    2     3      4

		my $expires = $bits[4];

		my( $y, $m, $d, $h, $mn, $s ) = $expires =~
			m/(\d\d\d\d)-(\d\d)-(\d\d)T(\d\d):(\d\d):(\d\d)Z/g;

		$expires = eval {
			&Date::Calc::Mktime( $y, $m, $d, $h, $mn, $s ) } || 0xFFFFFFFF;

		# XXX: Convert Expires date to unix epoch

		#print STDERR "@bits\n";

		my $secure = FALSE;

		$self->set_cookie(undef, @bits[2,3,1,0], undef,
			0, 0, $expires - time, 0);
    	}

    close $fh;

    1;
	}

sub save
	{
    my( $self, $file ) = @_;

    $file ||= $self->{'file'} || return;

	my $plist = Mac::PropertyList::array->new( [] );
	print STDERR "plist is $plist\n";


    $self->scan(
    	do {

    	my $array = $plist->value;
		my $n = 1;

    	sub {
			my( $version, $key, $val, $path, $domain, $port,
				$path_spec, $secure, $expires, $discard, $rest ) = @_;

			return if $discard && not $self->{ignore_discard};

			return if defined $expires && time > $expires;

			$expires = do {
				unless( $expires ) { 0 }
				else
					{
					my @times = localtime( $expires );
					$times[5] += 1900;
					$times[4] += 1;

					sprintf "%4d-%02d-%02dT%02d:%02d:%02dZ",
						@times[5,4,3,2,1,0];
					}
				};

			$secure = $secure ? TRUE : FALSE;

			my $bool = $domain =~ /^\./ ? TRUE : FALSE;

			my $hash = {
				Value   => Mac::PropertyList::string->new( $val     ),
				Path    => Mac::PropertyList::string->new( $path    ),
				Domain  => Mac::PropertyList::string->new( $domain  ),
				Name    => Mac::PropertyList::string->new( $key     ),
				Expires => Mac::PropertyList::date  ->new( $expires ),
				};

			push @$array, Mac::PropertyList::dict->new( $hash );
    		}
		} );

	open my $fh, "> $file" or die "Could not write file [$file]! $!\n";
    print $fh ( Mac::PropertyList::plist_as_string( $plist ) );
    close $fh;
	}

1;