Subject: | Change to clear method allows clearing based on regular expression |
I made a change to my local copy of CGI::Session to allow clearing of parameters that match a regular expression by passing a regular expression reference to $session->clear(). I think this is a useful feature because it allows easier isolation of parameters that relate to a specific task. For example, all of the applications on my staff intranet are entered through a login application. The login app authenticates users and then loads a series of permissions into a session which is shared by all of the applications. One of my applications allows the creation and modification of "events". It uses CGI::Session to store information about the event that is currently being edited. Using the new version of the clear method I can organize parameters with prefixes like _login_, _eventregistration_, _timecard_, etc. Then, within an application I can call
$session->clear(qr/_eventregistration_/) to clear just the event registration parameters.
I've pasted the new version of the clear sub below.
--TWH
# clear() - clears a list of parameters off the session's '_DATA' table sub clear { my $self = shift; $class = ref($self);
my @params = ();
# if there was at least one argument, we take it as a list # of params to delete if ( @_ ) { #@params = ref($_[0]) ? @{ $_[0] } : ($_[0]); #Old version without support for regexref if (ref($_[0]) eq 'ARRAY'){ @params = @{ $_[0] }; }elsif (ref($_[0]) eq 'Regexp'){ #Perform regular-expression matching foreach ($self->param()){ push(@params, $_) if /$_[0]/; #Include parameters that match the regular expression referenced by $_[0] } }else{ @params = ($_[0]); } } else { @params = $self->param(); }
my $n = 0;
for ( @params ) {
/^_SESSION_/ and next;
# If this particular parameter has an expiration ticker, # remove it.
if ( $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$_} ) { delete ( $self->{_DATA}->{_SESSION_EXPIRE_LIST}->{$_} ); } delete ($self->{_DATA}->{$_}) && ++$n; }
# Set the session '_STATUS' flag to MODIFIED $self->{_STATUS} = MODIFIED;
return $n;
}