view release on metacpan or  search on metacpan

lib/Apache2/WebApp/Plugin/Session/Memcached.pm  view on Meta::CPAN

    unless ($@) {
        my %values = %session;
        untie %session;
        return \%values;
    }

    return;
}

#----------------------------------------------------------------------------+
# delete(\%controller, $name)
#
# Takes the cookie unique identifier or session id as arguments.  Deletes
# an existing session.

sub delete {
    my ($self, $c, $name)
      = validate_pos(@_,
          { type => OBJECT  },
          { type => HASHREF },
          { type => SCALAR  }
      );

    $self->error('Malformed session identifier')
      unless ($name =~ /^[\w-]{1,32}$/);

    my $cookie = $c->plugin('Cookie')->get($name);

    my $id = $cookie ? $cookie : $name;

    my @servers   = $c->config->{memcached_servers};
    my $threshold = $c->config->{memcached_threshold} || 10_000;
    my $debug     = $c->config->{debug}               || 0;
    
    my %session;

    eval {
        tie %session, 'Apache::Session::Memcached', $id, {
            Servers           => \@servers,
            NoRehash          => 1,
            Debug             => $debug,
            CompressThreshold => $threshold,
          };
      };

    unless ($@) {
        tied(%session)->delete;

        $c->plugin('Cookie')->delete($c, $name);
    }

    return;
}

#----------------------------------------------------------------------------+
# update(\%controller, $name, \%data);
#
# Takes the cookie unique identifier or session id as arguments.  Updates
# existing session data.

sub update {
    my ($self, $c, $name, $data_ref)
      = validate_pos(@_,
          { type => OBJECT  },
          { type => HASHREF },
          { type => SCALAR  },
          { type => HASHREF }
      );

    $self->error('Malformed session identifier')
      unless ($name =~ /^[\w-]{1,32}$/);

    my $cookie = $c->plugin('Cookie')->get($name);

    my $id = $cookie ? $cookie : $name;

    my @servers   = $c->config->{memcached_servers};
    my $threshold = $c->config->{memcached_threshold} || 10_000;
    my $debug     = $c->config->{debug}               || 0;
    
    my %session;

    eval {
        tie %session, 'Apache::Session::Memcached', $id, {
            Servers           => \@servers,
            NoRehash          => 1,
            Readonly          => 0,
            Debug             => $debug,
            CompressThreshold => $threshold,
          };
      };

    foreach my $key (keys %$data_ref) {
        $session{$key} = $data_ref->{$key};     # merge hash key/values
    }

    untie %session;

    return;
}

#----------------------------------------------------------------------------+
# id(\%controller, $name)
#
# Return the cookie unique identifier for a given session.

sub id {
    my ($self, $c, $name)
      = validate_pos(@_,
          { type => OBJECT  },
          { type => HASHREF },
          { type => SCALAR  }
      );

    $self->error('Malformed session identifier')
      unless ($name =~ /^[\w-]{1,32}$/);

    return $c->plugin('Cookie')->get($name);
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~[  PRIVATE METHODS  ]~~~~~~~~~~~~~~~~~~~~~~~~~~~~~#