File Coverage

lib/Web/ComposableRequest/Session.pm

Criterion	Covered	Total	%
statement	59	59	100.0
branch	11	14	78.5
condition	13	15	86.6
subroutine	12	12	100.0
pod	6	6	100.0
total	101	106	95.2

package Web::ComposableRequest::Session;

use namespace::autoclean;

use Web::ComposableRequest::Constants qw( EXCEPTION_CLASS FALSE NUL TRUE );
use Web::ComposableRequest::Util      qw( bson64id is_arrayref throw );
use Unexpected::Types                 qw( ArrayRef Bool HashRef
                                          NonEmptySimpleStr NonZeroPositiveInt
                                          Object SimpleStr Undef );
use Moo;

# Public attributes
has 'authenticated' => is => 'rw',  isa => Bool, default => FALSE;

has 'messages'      => is => 'ro',  isa => HashRef[ArrayRef],
   builder          => sub { {} };

has 'updated'       => is => 'ro',  isa => NonZeroPositiveInt, required => TRUE;

has 'username'      => is => 'rw',  isa => SimpleStr, default => NUL;

# Private attributes
has '_config'       => is => 'ro',  isa => Object, init_arg => 'config',
   required         => TRUE;

has '_mid'          => is => 'rwp', isa => NonEmptySimpleStr | Undef;

has '_request'      => is => 'ro',  isa => Object, init_arg => 'request',
   required         => TRUE, weak_ref => TRUE;

has '_session'      => is => 'ro',  isa => HashRef, init_arg => 'session',
   required         => TRUE;

# Private functions
my $_session_attr = sub {
   my $conf = shift; my @public = qw( authenticated messages updated username );

   return keys %{ $conf->session_attr }, @public;
};

# Construction
around 'BUILDARGS' => sub {
   my ($orig, $self, @args) = @_; my $attr = $orig->( $self, @args );

   for my $k ($_session_attr->( $attr->{config} )) {
       my $v = $attr->{session}->{ $k }; defined $v and $attr->{ $k } = $v;
   }

   $attr->{updated} //= time;

   return $attr;
};

sub BUILD {
   my $self = shift; my $conf = $self->_config;

   my $max_time = $conf->max_sess_time;

   if ($self->authenticated and $max_time
       and time > $self->updated + $max_time) {
      my $req = $self->_request;
      my $msg = $conf->expire_session->( $self, $req );

      $self->authenticated( FALSE );
      $self->_set__mid( $self->add_status_message( $msg ) );
      $req->_log->( { level => 'debug',
                      message => $req->loc_default( @{ $msg } ) } );
   }

   return;
}

# Public methods
sub add_status_message {
   my ($self, $msg) = @_;

   is_arrayref $msg or throw 'Parameter [_1] not an array reference', [ $msg ];

   $self->messages->{ my $mid = bson64id } = $msg;

   return $mid;
}

sub collect_message_id {
   my ($self, $req) = @_;

   return $self->_mid && exists $self->messages->{ $self->_mid }
        ? $self->_mid : $req->query_params->( 'mid', { optional => TRUE } );
}

sub collect_status_message {
   my ($self, $req) = @_; my ($mid, $msg);

   $mid = $self->_mid
      and $msg = delete $self->messages->{ $mid }
      and return $req->loc( @{ $msg } );

   $mid = $req->query_params->( 'mid', { optional => TRUE } )
      and $msg = delete $self->messages->{ $mid }
      and return $req->loc( @{ $msg } );

   return;
}

sub collect_status_messages {
   my ($self, $req) = @_; my @messages = ();

   my $mid = $req->query_params->( 'mid', { optional => TRUE } )
      or return \@messages;

   my @keys = reverse sort keys %{ $self->messages };

   while (my $key = $keys[ 0 ]) {
      $key gt $mid and next; my $msg = delete $self->messages->{ $key };

      push @messages, $req->loc( @{ $msg } ); shift @keys;
   }

   return \@messages;
}

sub trim_message_queue {
   my $self = shift; my @queue = sort keys %{ $self->messages };

   while (@queue > $self->_config->max_messages) {
      my $mid = shift @queue; delete $self->messages->{ $mid };
   }

   return;
}

sub update {
   my $self = shift;

   for my $k ($_session_attr->( $self->_config )) {
      $self->_session->{ $k } = $self->$k();
   }

   $self->_session->{updated} = time;
   return;
}

before 'update' => sub {
   my $self = shift; $self->trim_message_queue; return;
};

1;

__END__