File Coverage

lib/Web/ComposableRequest/Session.pm

Criterion	Covered	Total	%
statement	64	70	91.4
branch	15	20	75.0
condition	8	9	88.8
subroutine	13	14	92.8
pod	6	7	85.7
total	106	120	88.3

package Web::ComposableRequest::Session;

use namespace::autoclean;

use Web::ComposableRequest::Constants qw( COMMA 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;

# 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};

      $attr->{$k} = $v if defined $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}),
         name    => 'Session.build'
      });
   }

   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) = @_;

   for my $mid ($self->_mid, $req->query_params->('mid', { optional => TRUE })){
      next unless $mid;

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

      delete $self->messages->{$mid} if $self->_config->delete_on_collect;
      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 = shift @keys) {
      next if $key gt $mid;

      my $msg = $self->messages->{$key} or next;

      delete $self->messages->{$key} if $self->_config->delete_on_collect;
      push @messages, $req->loc(@{$msg});
   }

   return \@messages;
}

sub serialise {
   my $self   = shift;
   my $string = NUL;

   for my $attr (@{$self->_config->serialise_session_attr}) {
      $string .= COMMA . "${attr}:" . $self->$attr;
   }

   return $string;
}

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;
};

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

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

1;

__END__