CGI::Apache2::Wrapper::Cookie - cookies via libapreq2

CGI-Apache2-Wrapper documentation Contained in the CGI-Apache2-Wrapper distribution.

Index

Code Index:

NAME

Top

CGI::Apache2::Wrapper::Cookie - cookies via libapreq2

SYNOPSIS

Top

 use CGI::Apache2::Wrapper::Cookie;

 sub handler {
    my $r = shift;
    # create a new Cookie and add it to the headers
    my $cookie = CGI::Apache2::Wrapper::Cookie->new($r,
                                                    -name=>'ID',
                                                    -value=>123456);
    $cookie->bake();
    # fetch existing cookies
    my %cookies = CGI::Apache2::Wrapper::Cookie->fetch($r);
    my $id = $cookies{'ID'}->value;
    return Apache2::Const::OK;
 }

DESCRIPTION

Top

This module provides a wrapper around Apache2::Cookie. Some methods are overridden in order to provide a CGI::Cookie-compatible interface.

Cookies are created with the new method:

 my $c = CGI::Apache2::Wrapper::Cookie->new($r,
                             -name    =>  'foo',
                             -value   =>  'bar',
                             -expires =>  '+3M',
                             -domain  =>  '.capricorn.com',
                             -path    =>  '/cgi-bin/database',
                             -secure  =>  1
                            );

with a mandatory first argument of the Apache2::RequestRec object $r. The remaining arguments are

* -name

This is the name of the cookie (required)

* -value

This is the value associated with the cookie (required)

* -expires

This accepts any of the relative or absolute date formats recognized by CGI.pm, for example "+3M" for three months in the future. See CGI.pm for details.

* -domain

This points to a domain name or to a fully qualified host name. If not specified, the cookie will be returned only to the Web server that created it.

* -path

This points to a partial URL on the current server. The cookie will be returned to all URLs beginning with the specified path. If not specified, it defaults to '/', which returns the cookie to all pages at your site.

* -secure

If set to a true value, this instructs the browser to return the cookie only when a cryptographic protocol is in use.

After creation, cookies can be sent to the browser in the appropriate header by $c->bake();.

Existing cookies can be fetched with %cookies = CGI::Apache2::Wrapper::Cookie->fetch($r);, which requires a mandatory argument of the Apache2::RequestRec object $r. In a scalar context, this returns a hash reference. The keys of the hash are the values of the name of the Cookie, while the values are the corresponding CGI::Apache2::Wrapper::Cookie object.

Methods

Top

Available methods are

* new
 my $c = CGI::Apache2::Wrapper::Cookie->new($r, %args);

This creates a new cookie. Mandatory arguments are the Apache2::RequestRec object $r, as well as the name and value specified in %args.

* name
 my $name = $c->name();

This gets the cookie name.

* value
 my $value = $c->value();

This gets the cookie value.

* domain
 my $domain = $c->domain();
 my $new_domain = $c->domain('.pie-shop.com');

This gets or sets the domain of the cookie.

* path
 my $path = $c->path();
 my $new_path = $c->path('/basket/');

This gets or sets the path of the cookie.

* secure
 my $secure = $c->secure();
 my $new_secure_setting = $c->secure(1);

This gets or sets the security setting of the cookie.

* expires
  $c->expires('+3M');

This sets the expires setting of the cookie. In the current behaviour of Apache2::Cookie, this requires a mandatory setting, and doesn't return anything.

* bake
 $c->bake();

This will send the cookie to the browser by adding the stringified version of the cookie to the Set-Cookie field of the HTTP header.

* fetch
 %cookies = CGI::Apache2::Wrapper::Cookie->fetch($r);

This fetches existing cookies, and requires a mandatory argument of the Apache2::RequestRec object $r. In a scalar context, this returns a hash reference. The keys of the hash are the values of the name of the Cookie, while the values are the corresponding CGI::Apache2::Wrapper::Cookie object.

SEE ALSO

Top

CGI, CGI::Cookie, Apache2::Cookie, and CGI::Apache2::Wrapper.

Development of this package takes place at http://cpan-search.svn.sourceforge.net/viewvc/cpan-search/CGI-Apache2-Wrapper/.

SUPPORT

Top

You can find documentation for this module with the perldoc command:

    perldoc CGI::Apache2::Wrapper::Cookie

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/CGI-Apache2-Wrapper

* CPAN::Forum: Discussion forum

http:///www.cpanforum.com/dist/CGI-Apache2-Wrapper

* CPAN Ratings

http://cpanratings.perl.org/d/CGI-Apache2-Wrapper

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=CGI-Apache2-Wrapper

* Search CPAN

http://search.cpan.org/dist/CGI-Apache2-Wrapper

http://cpan.uwinnipeg.ca/dist/CGI-Apache2-Wrapper

ENVIRONMENT VARIABLES

Top

If the USE_CGI_PM environment variable is set, the new method will return a CGI::Cookie object, while fetch will return the corresponding cookies using CGI::Cookie.

COPYRIGHT

Top

This software is copyright 2007 by Randy Kobes <r.kobes@uwinnipeg.ca>. Use and redistribution are under the same terms as Perl itself; see http://www.perl.com/pub/a/language/misc/Artistic.html.

CGI-Apache2-Wrapper documentation Contained in the CGI-Apache2-Wrapper distribution. 
package CGI::Apache2::Wrapper::Cookie;
use strict;
use warnings;

our $VERSION = '0.215';
our $MOD_PERL;
use overload '""' => sub { shift->as_string() }, fallback => 1;

sub new {
  my ($class, $r, %args) = @_;
  unless (defined $r and ref($r) and ref($r) eq 'Apache2::RequestRec') {
    die qq{Must pass in an Apache2::RequestRec object \$r};
  }
  if ($ENV{USE_CGI_PM}) {
    require CGI::Cookie;
    return CGI::Cookie->new($r);
  }
  if (exists $ENV{MOD_PERL}) {
    if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
      require Apache2::RequestRec;
      require Apache2::Request;
      require Apache2::Cookie;
      $MOD_PERL = 2;
    }
    else {
      die qq{mod_perl 2 required};
    }
  }
  else {
    die qq{Must be running under mod_perl};
  }
  unless ($args{path} || $args{'-path'}) {
    $args{path} = '/';
  }
  my $cookie = Apache2::Cookie->new($r, %args);
  die qq{Creation of Apache2::Cookie failed}
    unless ($cookie and ref($cookie) eq 'Apache2::Cookie');
  my $self = {};
  bless $self, ref $class || $class;

  $self->r($r) unless $self->r;
  $self->{cookie} = $cookie;
  return $self;
}

sub r {
  my $self = shift;
  my $r = $self->{'.r'};
  $self->{'.r'} = shift if @_;
  return $r;
}

sub fetch {
  my ($class, $r) = @_;
  unless (defined $r and ref($r) and ref($r) eq 'Apache2::RequestRec') {
    die qq{Must pass in an Apache2::RequestRec object \$r};
  }
  if ($ENV{USE_CGI_PM}) {
    require CGI::Cookie;
    return CGI::Cookie->fetch($r);
  }
  if (exists $ENV{MOD_PERL}) {
    if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
      require Apache2::RequestRec;
      require Apache2::Request;
      require Apache2::Cookie;
      $MOD_PERL = 2;
    }
    else {
      die qq{mod_perl 2 required};
    }
  }
  else {
    die qq{Must be running under mod_perl};
  }
  my %cookies = Apache2::Cookie->fetch($r);
  return wantarray ? %cookies : \%cookies;
}

sub cookie {
  my $self = shift;
  return $self->{cookie};
}

sub name {
  my $self = shift;
  die qq{Apache2::Cookie doesn't support setting "name"} if @_;
  return $self->cookie->name;
}

sub value {
  my $self = shift;
  die qq{Apache2::Cookie doesn't support setting "value"} if @_;
  return $self->cookie->value;
}

sub path {
  my ($self, $x) = @_;
  if (defined $x) {
    $self->cookie->path($x);
    return $x;
  }
  else {
    return $self->cookie->path;
  }
}

sub domain {
  my ($self, $x) = @_;
  if (defined $x) {
    $self->cookie->domain($x);
    return $x;
  }
  else {
    return $self->cookie->domain;
  }
}

sub secure {
  my ($self, $x) = @_;
  if (defined $x) {
    $self->cookie->secure($x);
    return $x;
  }
  else {
    return $self->cookie->secure;
  }
}

sub expires {
  my ($self, $x) = @_;
  die qq{Apache2::Cookie currently demands an argument to "expires"}
    unless (defined $x);
  $self->cookie->expires($x);
}

sub httponly {
  die qq{Apache2::Cookie currently doesn't support "httponly"};
}

sub as_string {
  return shift->cookie->as_string;
}

sub bake {
  my $self = shift;
  return $self->cookie->bake($self->r);
}

1;

__END__