Ginger::Cookies

gistfile1.pl

package Ginger::Cookies;
use strict;
use Carp;
use List::Util  qw(reduce);
use Data::Clone qw(clone);

require Exporter;

our $VERSION   = '0.01';
our @ISA       = qw(Exporter);
our @EXPORT    = qw(anyevent_style http_cookies_style set_cookies);
our @EXPORT_OK = ();


# qw/version value port path_spec secure _expires discard rest/
sub _array_to_hash {
    my $arry = shift;
    my $emp  = {};
    $emp->{value}    = $arry->[1];
    $emp->{secure}   = $arry->[4] if $arry->[4];
    $emp->{_expires} = $arry->[5] if $arry->[5];
    $emp = reduce{ $a->{lc $b} = $arry->[7]{$b}; $a }
             $emp, keys %{$arry->[7]}
               if ref $arry->[7] eq 'HASH';
    $emp;
}

sub _hash_to_array {
    my $hash = shift;
    my @emp = ();
    $emp[0] = 0;     # version this value only '0';
    $emp[1] = delete $hash->{value};
    $emp[2] = undef; # port
    $emp[3] = 1;     # path_spec
    $emp[4] = delete $hash->{secure};
    $emp[5] = (delete $hash->{_expires} - time());
    $emp[6] = 0;     # dispard
    $emp[7] = reduce{ $a->{$b} = $hash->{$b}; $a}
                {}, keys %{$hash}
                  if keys %{$hash};
    [ @emp ];
}

sub _search_cookies {
    my $hash     = shift || return;
    my $cb       = shift || return;
    my $ref_vals = shift || 'HASH';

    while (my($domain, $paths) = each %{$hash}) {
        next if ref $paths ne 'HASH';
        while (my($path, $keys) = each %{$paths}) {
            next if ref $keys ne 'HASH';
            while (my($key, $vals) = each %{$keys}) {
                next if ref $vals ne $ref_vals;
                $cb->($domain, $path, $key, $vals);
            }
        }
    }
}

sub set_cookies {
    my($cookie_jar, $hash) = @_;

    return unless exists $cookie_jar->{COOKIES};
    return if $hash->{version} ne '1';

    delete $hash->{version};

    _search_cookies($hash, sub {
        my($domain, $path, $key, $val) = @_;
        if ($cookie_jar->isa('HTTP::Cookies')) {
            my $args = _hash_to_array( $val );
            splice @$args, 1, 0, $key;
            splice @$args, 3, 0, $path;
            splice @$args, 4, 0, $domain;
            $cookie_jar->set_cookie($args);
        } else {
            $cookie_jar->{COOKIES}{$domain}{$path}{$key} = _hash_to_array( $val );
        }
    });
}

sub http_cookies_style {
    my $hash = clone shift;
    return if $hash->{version} ne '1';

    delete $hash->{version};

    _search_cookies($hash, sub {
        my($domain, $path, $key, $val) = @_;
        $hash->{$domain}{$path}{$key}  = _hash_to_array( $val );
    });

    $hash;
}

sub anyevent_style {
    my $cookie_jar = shift;
    my $hash       = clone((exists $cookie_jar->{COOKIES})
                   ? $cookie_jar->{COOKIES}
                   : $cookie_jar)
    ;

    _search_cookies($hash, sub {
        my($domain, $path, $key, $val) = @_;
        $hash->{$domain}{$path}{$key}  = _array_to_hash( $val );
    }, 'ARRAY');

    $hash->{version} = '1';
    $hash;
}


"Ginger::Cookies as AnyEvent::HTTP::Cookies::Util.";

__END__


=head1 NAME

Ginger::Cookies - Functions to convert the Cookies information

=head SYNOPSIS

    use AnyEvent;
    use AnyEvent::HTTP;
    use HTTP::Cookies::Safari;
    use Ginger::Cookies qw(set_cookies anyevent_style);
    use JSON;
    use YAML;
    
    my $account_page  = 'http://www.hogehoge.net';
    my $stacc         = "${account_page}/stacc/my/home/all/all";
    my $file          = "$ENV{HOME}/Library/Cookies/Cookies.plist";
    
    my $cookie_jar = HTTP::Cookies::Safari->new;
    
    $cookie_jar->load( $file );
    
    my $jar = Ginger::Cookies::anyevent_style $cookie_jar;
    
    my $cv = AE::cv;
    
    http_request GET => $stacc,
        cookie_jar => $jar, sub {
            my($content, $hdr) = @_;
            if ($hdr->{Status} ne '200') {
                warn "failed: $hdr->{Status} $hdr->{Reason} $hdr->{URL}";
                return $cv->send;
            }
            my $tt    = ($content =~ /hogehoge\.context\.token\s=\s\'([^']+)\'/)[0];
            my $login = ($content =~ /hogehoge\.user\.loggedIn\s=\s([^;]+);/)[0];
            if ($login) {
                http_request GET => "${stacc}.json?tt=${tt}",
                    cookie_jar => $jar, sub {
                    my($content, $hdr) = @_;
                    if ($hdr->{Status} ne '200') {
                        warn "failed: $hdr->{Status} $hdr->{Reason} $hdr->{URL}";
                        return $cv->send;
                    }
                    my $table = decode_json $content;
                    warn Dump $table;
    
                    $cv->send;
                };
            }
    };
    
    $cv->recv;
    
    set_cookies $cookie_jar => $jar;
    $cookie_jar->save( $file );


=head1 DESCRIPTION

This module provides functions to convert the cookies information.
You will be able to use the cookies information in AnyEvent::HTTP, that information is using in HTTP::Cookies and its subclass.
It is also possible vice versa.

=head2 METHODS

=over 4

=item $hash_ref = anyevent_style $cookie_jar

The first argument is a HTTP::Cookies object.
Return a hash reference that can use in AnyEvent::HTTP.

=itme $hash_ref_in_http_cookies_object = http_cookies_style $hash_href

The first argument is a hash reference that was used in AnyEvent::HTTP.
Return a hash reference to be used as a data store in HTTP::Cookies object.

=item set_cookies $cookie_jar => $hash_ref

Tha first argument is a HTTP::Cookies oject. the 2nd argument is a hash reference to used in AnyEvent::HTTP.
Set the hash reference to the HTTP::Cookies object.

=back

=head1 SEE ALSO

L<AnyEvent::HTTP>, L<HTTP::Cookies>

=head1 AUTHOR

ishiduca

=cut