Cookie

 view release on metacpan or  search on metacpan

lib/Cookie/Domain.pm  view on Meta::CPAN

=head1 NAME

Cookie::Domain - Domain Name Public Suffix Query Interface

=head1 SYNOPSIS

    use Cookie::Domain;
    my $dom = Cookie::Domain->new( min_suffix => 1, debug => 3 ) ||
        die( Cookie::Domain->error, "\n" );
    my $res = $dom->stat( 'www.example.or.uk' ) || die( $dom->error, "\n" );
    # Check for potential errors;
    die( $dom->error ) if( !defined( $res ) );
    # stat() returns an empty string if nothing was found and undef upon error
    print( "Nothing found\n" ), exit(0) if( !$res );
    print( $res->domain, "\n" ); # example.co.uk
    print( $res->name, "\n" ); # example
    print( $res->sub, "\n" ); # www
    print( $res->suffix, "\n" ); # co.uk

    # Load the public suffix. This is done automatically, so no need to do it
    $dom->load_public_suffix( '/some/path/on/the/filesystem/data.txt' ) || 
        die( $dom->error );
    # Then, save it as json data for next time

lib/Cookie/Domain.pm  view on Meta::CPAN

=head2 stat

This takes a domain name, such as C<www.example.org> and optionally an hash reference of options and returns:

=over 4

=item C<undef()>

If an error occurred.

    my $rv = $d->stat( 'www.example.org' );
    die( "Error: ", $d->error ) if( !defined( $rv ) );

=item empty string

If there is no data available such as when querying a non existing top level domain.

=item A C<Cookie::Domain::Result> object

An object with the following properties and methods, although not all are necessarily defined, depending on the results.

Accessed as an hash property and this return a regular string, but accessed as a method and they will return a L<Module::Generic::Scalar> object.

=over 8

=item I<name>

The label that immediately follows the suffix (i.e. on its lefthand side).

For example, in C<www.example.org>, the I<name> would be C<example>

    my $res = $dom->stat( 'www.example.org' ) || die( $dom->error );
    say $res->{name}; # example
    # or alternatively
    say $res->name; # example

=item I<sub>

The sub domain or sub domains that follows the domain on its lefthand side.

For example, in C<www.paris.example.fr>, C<www.paris> is the I<sub> and C<example> the I<name>

    my $res = $dom->stat( 'www.paris.example.fr' ) || die( $dom->error );
    say $res->{sub}; # www.paris
    # or alternatively
    say $res->sub; # www.paris

=item I<suffix>

The top level domain or I<suffix>. For example, in C<example.com.sg>, C<com.sg> is the suffix and C<example> the I<name>

    my $res = $dom->stat( 'example.com.sg' ) || die( $dom->error );
    say $res->{suffix}; # com.sg
    # or alternatively
    say $res->suffix; # com.sg

What constitute a suffix varies from zone to zone or country to country, hence the necessity of this public domain suffix data file.

=back

C<Cookie::Domain::Result> objects inherit from L<Module::Generic::Hash>, thus you can do:

    my $res = $dom->stat( 'www.example.org' ) || die( $dom->error );
    say $res->length, " properties set.";
    # which should say 3 since we alway return suffix, name and sub

The following additional method is also available as a convenience:

=over 8

=item I<domain>

This is a read only method which returns and empty L<Module::Generic::Scalar> object if the I<name> property is empty, or the properties I<name> and I<suffix> join by a dot '.' and returned as a new L<Module::Generic::Scalar> object.

    my $res = $dom->stat( 'www.example.com.sg' ) || die( $dom->error );
    say $res->domain; # example.com.sg
    say $res->domain->length; # 14

=back

=back

The options accepted are:

=over 4

lib/Cookie/Jar.pm  view on Meta::CPAN

    my $now = DateTime->now;
    $path = $self->_normalize_path( $path ) if( CORE::index( $path, '%' ) != -1 );
    my $root;
    if( $self->_is_ip( $host ) )
    {
        $root = $host;
    }
    else
    {
        my $dom = Cookie::Domain->new || return( $self->pass_error( Cookie::Domain->error ) );
        my $res = $dom->stat( $host );
        return( $self->pass_error( $dom->error ) ) if( !defined( $res ) );
        if( !CORE::length( $res ) || ( $res && !$res->domain->length ) )
        {
            return( $self->error( "No root domain found for host \"$host\"." ) );
        }
        $root = $res->domain;
    }
    # rfc6265, section 5.4
    # "Either:
    # The cookie's host-only-flag is true and the canonicalized request-host is identical to the cookie's domain.

lib/Cookie/Jar.pm  view on Meta::CPAN

    $path = '/' unless( CORE::length( $path ) );
    $port = $uri->port if( !defined( $port ) || !CORE::length( $port ) );
    my $root;
    if( $self->_is_ip( $host ) )
    {
        $root = $host;
    }
    else
    {
        my $dom = Cookie::Domain->new || return( $self->pass_error( Cookie::Domain->error ) );
        my $res = $dom->stat( $host );
        if( !defined( $res ) )
        {
            return( $self->pass_error( $dom->error ) );
        }
        # Possibly empty
        $root = $res ? $res->domain : '';
    }
    
    foreach my $o ( @$all )
    {

lib/Cookie/Jar.pm  view on Meta::CPAN

    if( defined( $opts->{host} ) && CORE::length( $opts->{host} ) )
    {
        $host = $opts->{host};
        if( $self->_is_ip( $host ) )
        {
            $root = $host;
        }
        else
        {
            my $dom = Cookie::Domain->new || return( $self->pass_error( Cookie::Domain->error ) );
            my $res = $dom->stat( $host );
            if( !defined( $res ) )
            {
                return( $self->pass_error( $dom->error ) );
            }
            # Possibly empty
            $root = $res ? $res->domain : '';
        }
    }

    my $o = Module::Generic::HeaderValue->new_from_header( "$str" ) ||

t/002_domain.t  view on Meta::CPAN

{
    if( !defined( $dom ) )
    {
        diag( "Failed to instantiate a Cookie::Domain object: ", Cookie::Domain->error ) if( $DEBUG );
        skip( "Failed to instantiate a Cookie::Domain object.", ( scalar( @tests ) * 5 ) );
    }
    
    no warnings 'uninitialized';
    foreach my $test ( @tests )
    {
        my $res = scalar( @$test ) > 2 ? $dom->stat( $test->[0], $test->[2] ) : $dom->stat( $test->[0] );
        my $expect = $test->[1];
        # is( ref( $res ), ref( $expect ), 'result type for ' . $test->[0] );
        if( ref( $expect ) )
        {
            isa_ok( $res, 'Cookie::Domain::Result', 'result type for ' . $test->[0] );
            my $all_ok = 1;
            foreach my $k ( qw( name sub suffix ) )
            {
                if( ( defined( $res->{ $k } ) && !exists( $expect->{ $k } ) ) ||
                    $expect->{ $k } ne $res->{ $k } )