CatalystX::Usul::Plugin::Controller::Cookies - Cookie multiplexing methods

   package CatalystX::Usul;
   use parent qw(Catalyst::Component CatalystX::Usul::Base);

   package CatalystX::Usul::Controller;
   use parent qw(CatalystX::Usul
                 CatalystX::Usul::Cookies
                 CatalystX::Usul::ModelHelper
                 Catalyst::Controller);

   package YourApp::Controller::YourController;
   use parent qw(CatalystX::Usul::Controller);

# @(#)$Id: Cookies.pm 576 2009-06-09 23:23:46Z pjf $

package CatalystX::Usul::Plugin::Controller::Cookies;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.3.%d', q$Rev: 576 $ =~ /\d+/gmx );
use parent qw(CatalystX::Usul);

my $NUL = q();

sub delete_cookie {
   # Delete a key/value pair from the browser state cookie
   my ($self, $c, $args) = @_; my ($cookie, $key, $name, $val);

   return unless ($name = $args->{name} and $key = $args->{key});

   my $tokens = $NUL;

   if ($cookie = $c->req->cookie( $name )) {
      for my $token (split m{ ; }mx, $cookie) {
         $token =~ s{ \s+ }{}gmx;

         if ($token =~ m{ \A $name = }mx) {
            $val = (split m{ = }mx, $token)[1];
            $val =~ s{ % ([0-9A-Fa-f]{2}) }{chr( hex( $1 ) )}egmx;

            for (split m{ \+ }mx, $val) {
               unless (m{ \A $key ~ }mx) {
                  $tokens .= q(+) if ($tokens);
                  $tokens .= $_;
               }
            }

            $c->res->cookies->{ $name } = { value => $tokens };
            return;
         }
      }
   }

   return;
}

sub get_cookie {
   # Extract the requested item from the browser cookie
   my ($self, $c, $args) = @_; my ($cookie, $key, $name, $val);

   return $NUL unless ($name = $args->{name} and $key = $args->{key});

   if ($cookie = $c->req->cookie( $name )) {
      for my $token (split m{ ; }mx, $cookie) {
         $token =~ s{ \s+ }{}gmsx;

         if ($token =~ m{ \A $name = }msx) {
            $val = (split m{ = }mx, $token)[1];
            $val =~ s{ % ([0-9A-Fa-f]{2}) }{chr(hex($1))}egmsx;

            for (split m{ \+ }mx, $val) {
               return (split m{ ~ }mx, $_)[1] if (m{ \A $key ~ }msx);
            }

            return $NUL;
         }
      }
   }

   return $NUL;
}

sub load_stash_with_browser_state {
   # Extract key/value pairs from the browser state cookie
   my ($self, $c) = @_;
   my $cfg        = $c->config;
   my $s          = $c->stash;
   my $args       = { name => $s->{cname}, key => q(debug) };
   my $debug      = $self->get_cookie( $c, $args );

   $s->{debug  }  = $debug && $debug eq q(true) ? 1 : 0;
   $args->{key }  = q(footer);

   my $state      = $self->get_cookie( $c, $args );

   $s->{fstate }  = $state && $state eq q(true) ? 1 : 0;
   $args->{key }  = q(pwidth);

   my $pwidth     = $self->get_cookie( $c, $args );

   $s->{pwidth }  = $pwidth if ($pwidth);
   $args->{key }  = q(sidebar);
   $s->{sbstate}  = $self->get_cookie( $c, $args ) ? 1 : 0;
   $args->{key }  = q(skin);

   my $skin       = $self->get_cookie( $c, $args );

   $s->{skin   }  = $skin   if ($skin
                                && -d $self->catdir( $cfg->{skindir}, $skin ));
   $args->{key }  = q(width);

   my $width      = $self->get_cookie( $c, $args );

   $s->{width  }  = $width  if ($width);
   return;
}

sub set_cookie {
   # Set a key/value pair in the browser state cookie
   my ($self, $c, $args) = @_; my ($cookie, $key, $name, $val);

   return unless ($name = $args->{name} and $key = $args->{key});

   my $found = 0; my $tokens = $NUL; my $value = $args->{value}; $key .= q(~);

   if ($cookie = $c->req->cookie( $name )) {
      for my $token (split m{ ; }mx, $cookie) {
         $token =~ s{ \s+ }{}gmx;

         if ($token =~ m{ \A $name = }mx) {
            $val = (split m{ = }mx, $token)[1];
            $val =~ s{ % ([0-9A-Fa-f]{2}) }{chr(hex($1))}egmx;

            for (split m{ \+ }mx, $val) {
               $tokens .= q(+) if ($tokens);

               if (m{ \A $key }mx) { $tokens .= $key.$value; $found = 1 }
               else { $tokens .= $_ }
            }

            unless ($found) {
               $tokens .= q(+) if ($tokens);
               $tokens .= $key.$value
            }

            $c->res->cookies->{ $name } = { value => $tokens };
            return;
         }
      }
   }

   return;
}

1;

__END__

# Local Variables:
# mode: perl
# tab-width: 3
# End: