view release on metacpan or  search on metacpan

lib/Rubric/WebApp/Session.pm  view on Meta::CPAN

#pod This gets the cookie and returns the payload as a R::WA::Session::Object.
#pod
#pod =cut

sub get_cookie_payload {
  my ($self) = @_;

  return __empty unless my $cookie_value = $self->query->cookie($COOKIE_NAME);

  my $cipherer = $self->session_cipherer;

  my $data = eval {
    JSON->new->utf8->decode(
      $cipherer->decrypt(decode_base64($cookie_value))
    );
  };

  my $session = $data ? Rubric::WebApp::Session::Object->new($data) : __empty;
}

#pod =head2 set_cookie_payload
#pod
#pod This method writes the session data back out to a cookie entry.
#pod
#pod =cut

sub set_cookie_payload {
  my ($self) = @_;

  my $cookie_value = eval {
    my $json = JSON->new->utf8->encode($self->session->as_hash);

    encode_base64($self->session_cipherer->encrypt($json));
  };

  my $cookie = CGI::Cookie->new(
    -name     => $COOKIE_NAME,
    -expires  => '+30d',
    -value    => $cookie_value,
    -secure   => Rubric::Config->cookie_secure,
    -httponly => Rubric::Config->cookie_httponly,
  );

  $self->header_add(-cookie => [ $cookie ]);
}

#pod =head1 SESSION OBJECT METHODS
#pod
#pod =cut

package Rubric::WebApp::Session::Object 0.157;

#pod =head2 new
#pod
#pod This makes a new session object.  You don't need this.
#pod
#pod =cut

sub new {
  my ($class, $data) = @_;
  bless $data => $class;
}

#pod =head2 param
#pod
#pod   $obj->param('foo');        # get
#pod   $obj->param('foo', 'val'); # set
#pod
#pod =cut

sub param {
  my $self = shift;

  if (@_ == 1) {
    return $self->{$_[0]} if exists $self->{$_[0]};
    return;
  } 

  if (@_ == 2) {
    return $self->{$_[0]} = $_[1];
  } 

  die "invalid number of args to session->param";
}

#pod =head2 clear
#pod
#pod   $obj->clear('name');
#pod
#pod Clear the entry (delete it entirely) from the session.
#pod
#pod =cut

sub clear {
  my ($self, $param) = @_;
  delete $self->{$param};
}

#pod =head2 delete
#pod
#pod   $session->delete;
#pod
#pod Removes all data from the session.
#pod
#pod =cut

sub delete {
  my ($self) = @_;
  %$self = ();
}

#pod =head2 as_hash
#pod
#pod This returns a hashref containing the session data.
#pod
#pod =cut

sub as_hash {
  return { %{ $_[0] } };
}