File Coverage

blib/lib/CGI/Session/Flash.pm

Criterion	Covered	Total	%
statement	89	100	89.0
branch	26	38	68.4
condition	12	16	75.0
subroutine	19	21	90.4
pod	18	18	100.0
total	164	193	84.9

package CGI::Session::Flash;
use Carp;
use strict;

our $VERSION = '0.02';


# Create a new flash object.
#
# A session is required, all other parameters are optional and specify
# options for the flash.
sub new
{
    my $class   = shift;
    my $session = shift;
    my %options = (
        session_key => '_flash',
        @_,
    );

    # Make sure a session was provided.
    croak "No session provided."
        unless (defined $session && ref $session &&
                $session->isa('CGI::Session'));

    # Initialize data from the session.
    my $data = $session->param($options{session_key}) || { };
    my $keep = $session->param($options{session_key} . '_keep') || [ ];

    my $self = {
        _session      => $session,
        _data         => $data,
        _keep         => { map { $_ => 1 } @$keep },
        _cleanup_done => 0,
        _session_key  => $options{session_key},
    };

    bless $self, $class;
    return $self;
}

# When the object goes out of scope and flush it's contents so that they get
# saved back into the session.
sub DESTROY { shift->flush(); }


# Accessors
#------------------------------------------------------------------------------

# Returns boolean for whether cleanup has been performed.
sub cleanup_done { shift->{_cleanup_done} }

# Return the associated session object.
sub session { shift->{_session} }

# A list of the session keys.  This returns an array ref, the first is the
# flash data, the second is the keys to keep.
sub session_key { shift->{_session_key} }


# Getting and setting values
#------------------------------------------------------------------------------

# Set the data in the flash for the specified key.
sub set
{
    my $self = shift;
    my $key  = shift;
    my @vals = @_;

    croak "No flash key specified."    unless (defined $key);
    croak "No flash values specified." unless (@vals);

    # Set the values and mark the key as not used.
    $self->{_data}{$key} = \@vals;
    $self->keep($key);

    return 1;
}

# Retrieve the data from the flash for the specified key.
sub get
{
    my $self = shift;
    my $key  = shift;
    my $vals;

    croak "No flash key specified." unless (defined $key);

    # Get the values.
    $vals = $self->{_data}{$key} if ($self->has_key($key));

    return undef      if (!defined $vals);
    return $vals->[0] if (ref $vals eq "ARRAY" && @$vals == 1);
    return wantarray ? @$vals : $vals;
}

# Set data in the flash that will only last until the next time that cleanup
# is called.
sub now
{
    my $self = shift;
    my $key  = shift;
    my @vals = @_;

    croak "No flash key specified."    unless (defined $key);
    croak "No flash values specified." unless (@vals);

    $self->set($key => @vals);
    $self->discard($key);

    return 1;
}


# Keys and Contents
#------------------------------------------------------------------------------

# Get a hashref of the flash contents.  Used internally by the teardown hook
# for saving the flash to the session.
sub contents
{
    my $self = shift;

    return $self->{_data};
}

# Return a list of keys that are marked as kept.
sub keep_keys
{
    my $self = shift;
    my @keep = grep  { $self->{_keep}{$_} > 0 }
               keys %{ $self->{_keep} };

    return wantarray ? @keep : \@keep;
}

# Return a list of keys currently in the flash.
sub keys
{
    my $self = shift;
    my @keys = sort keys %{ $self->{_data} };

    return wantarray ? @keys : \@keys;
}

# Return true or false depending on if the flash contains the specified key.
sub has_key
{
    my $self = shift;
    my $key  = shift;

    croak "No flash key specified." unless (defined $key);

    return 1 if (exists $self->{_data}{$key});
    return 0;
}

# Returns true or false depending on if the flash is empty or not.
sub is_empty
{
    my $self = shift;

    return 0 if (scalar CORE::keys %{ $self->{_data} } > 0);
    return 1;
}

# Clear all flash data out and start fresh.
sub reset
{
    my $self = shift;

    $self->{_data}         = { };
    $self->{_keep}         = { };
    $self->{_cleanup_done} = 0;

    return 1;
}


# Keeping keys and cleanup
#------------------------------------------------------------------------------

# Mark the specified keys as being kept for one more iteration.
sub keep
{
    my $self = shift;
    my @keys = @_;

    # If no keys were specified, keep all.
    @keys = $self->keys unless (@_);

    foreach my $key (@keys)
    {
        $self->{_keep}{$key}++;
    }

    return 1;
}

# Mark the specified keys for deletion at the next time that cleanup is called.
sub discard
{
    my $self = shift;
    my @keys = @_;

    # If no keys were specified, keep all.
    @keys = $self->keys unless (@_);

    foreach my $key (@keys)
    {
        delete $self->{_keep}{$key};
    }

    return 1;
}

# Cleanup the flash.  All keys not marked as kept will be deleted, otherwise
# they are marked for discard next time this method is called.  This method
# is automatically called during flush().
#
# Cleanup process is tracked, and it will not be performed more than once unless
# you pass a true value to signify that you want to force the cleanup.
sub cleanup
{
    my $self = shift;
    my $force = shift;

    # Skip cleanup since it has already been performed.
    return 1 if ($self->cleanup_done && !$force);

    foreach my $key (CORE::keys %{ $self->{_data} })
    {
        if ($self->{_keep}{$key})
        {
            delete $self->{_keep}{$key};
        }
        else
        {
            delete $self->{_data}{$key};
        }
    }

    # Set flag
    $self->{_cleanup_done}++;

    return 1;
}

# Perform cleanup and save the contents of the flash back to the session.
sub flush
{
    my $self        = shift;
    my $session_key = $self->session_key;

    # Perform cleanup
    $self->cleanup();

    # Save the data back into the session
    $self->session->param($session_key => $self->contents);
    $self->session->param($session_key . '_keep' => scalar $self->keep_keys);

    return 1;
}


# Debugging
#------------------------------------------------------------------------------

# Return a Data::Dumper dump of the flash for debugging purposes.
sub dump
{
    my $self = shift;

    require Data::Dumper;
    return Data::Dumper->Dump([ $self->contents ], [ "flash" ]);
}

1;
__END__