view release on metacpan or  search on metacpan

lib/Gantry/Plugins/CookieCheck.pm  view on Meta::CPAN

#-----------------------------------------------------------
# set_test_cookie
#-----------------------------------------------------------
sub set_test_cookie {
    my ( $gobj ) = @_;
    my $uri = $gobj->fish_uri();
    my $loc = $gobj->fish_location();
    my $cc_exclude = $gobj->fish_config('cc_exclude');

    # Set a test cookie under the following circumstances.
    # The test cookie (acceptcookies) is not already set.
    # The current uri does not match cookiecheck.
    # There is no cookie check exclude path provided or
    # there is an exclusion and it doesn't match the current location.
    if (
        ( ! $gobj->get_cookies( 'acceptcookies' ) ) and
        ( $uri !~ /cookiecheck\/?$/o ) and
        (
            ( ! $cc_exclude ) or ( $cc_exclude and ( $uri !~ /$cc_exclude/ ) )
        )
    ) {
        my $req     =   $gobj->apache_request();
        my $secret  =   $gobj->fish_config( 'cc_secret' )
                        || $gobj->gantry_secret();
        my $crypt   =   Gantry::Utils::Crypt->new( { 'secret' => $secret } );
        my $qstring =   '';
        my $goto;
        my $cookie;
        
        $cookie = {
            name     => 'acceptcookies',
            value    => '1',
            path     => '/',
        };
        $cookie->{domain} = $gobj->fish_config('cc_domain')
            if $gobj->fish_config('cc_domain');

        # Set a test cookie and then redirect.
        $gobj->set_cookie($cookie);

        # Determine where to redirect the user for the cookie check.
        $uri    =~ s/^$loc//;
        $goto   = $uri || '/' ;

        # Add parameters.
        foreach my $param ( $req->param() ) {
            $qstring .= sprintf( '&%s=%s', $param, $req->param( $param ) );
        }

        if ( $qstring ) {
            # Change the first & to a ? and add query string to goto.
            $qstring =~ s/^&/?/o;
            $goto .= $qstring;
        }

        # Encrypt goto
        $goto = $gobj->url_encode( $crypt->encrypt( $goto ) );

        # Redirect the user.
        $gobj->relocate( $loc . "/cookiecheck?url=${goto}" );
    }
}

#-----------------------------------------------------------
# do_cookiecheck()
#-----------------------------------------------------------
sub do_cookiecheck {
    my $gobj    =   shift;
    my $params  =   $gobj->params();
    my $secret  =   $gobj->fish_config( 'cc_secret' )
                    || $gobj->gantry_secret();
    my $crypt   =   Gantry::Utils::Crypt->new( { 'secret' => $secret } );

    # Decrypt url parameter.
    $params->{url} = $crypt->decrypt( $params->{url} );

    # If acceptcookies is set then send the user to the original
    # url they requested.
    if( $gobj->get_cookies( 'acceptcookies' ) ) {
        $gobj->relocate( $gobj->location() . $params->{url} );
    }
    else {
        # Cookies aren't enabled. Display an error page.
        my $cc_title        =   $gobj->fish_config( 'cc_title' ) || 'Missing Cookies';
        my $cc_wrapper      =   $gobj->fish_config( 'cc_wrapper' ) ||
                                $gobj->fish_config( 'template_wrapper' ) || 'default.tt';
        my $cc_template     =   $gobj->fish_config( 'cc_template' ) || 'cc.tt';

        $gobj->template_wrapper( $cc_wrapper );
        $gobj->stash->view->title( $cc_title );
        $gobj->stash->view->template( $cc_template );
    }
}

1;

__END__


=head1 NAME

Gantry::Plugins::CookieCheck - Plugin to test that cookies are enabled.

=head1 SYNOPSIS

Plugin must be included in the Applications use statment.

    <Perl>
        use MyApp qw{
                -Engine=CGI
                -TemplateEngine=TT
                -PluginNamespace=your_module_name
                CookieCheck
        };
    </Perl>

Bigtop:

    config {
        engine MP20;
        template_engine TT;
        plugins CookieCheck;
        ...


There are various config options.

Apache Conf:

    <Location /controller>
        PerlSetVar cc_title Title
        PerlSetVar cc_wrapper default.tt
        PerlSetVar cc_template cc_template.tt
        PerlSetVar cc_secret zak7mubuS9SpUraTHucUXePhAdR4meFUhAmAChEjAPuGUBrakeVenuvu
    </Location>

Gantry Conf:

    cc_title Title
    cc_wrapper default.tt