File Coverage

blib/lib/Dancer2/Plugin/PageHistory/PageSet.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	13	16	81.2
condition	11	15	73.3
subroutine	13	13	100.0
pod	5	5	100.0
total	92	100	92.0

package Dancer2::Plugin::PageHistory::PageSet;

=head1 NAME

Dancer2::Plugin::PageHistory::PageSet - collection of pages with accessors

=cut

use Carp qw(croak);
use Scalar::Util qw(blessed);
use Sub::Quote qw(quote_sub);
use Dancer2::Core::Types qw(ArrayRef HashRef InstanceOf Int Maybe Str);
use Moo;
use namespace::clean;

=head1 ATTRIBUTES

=head2 default_type

For all methods that expect an argument C then this C
will be the one used when C is not specified. Defaults to C.

=cut

has default_type => (
    is      => 'ro',
    isa     => Str,
    default => 'default',
);

=head2 fallback_page

In the event that L or L have no page to
return then L is returned instead.

By default this is set to undef.

You can set this page to something else by passing any of the following as
the value of this attribute:

=over

=item * a hash reference to be passed to Dancer2::Plugin::PageHistory::Page->new

=item * a Dancer2::Plugin::PageHistory::Page object

=back

=cut

has fallback_page => (
    is      => 'ro',
    isa     => Maybe [ InstanceOf ['Dancer2::Plugin::PageHistory::Page'] ],
    default => undef,
    coerce  => sub {
        $_[0] ? Dancer2::Plugin::PageHistory::Page->new( %{ $_[0] } ) : undef;
    },
);

=head2 max_items

The maximum number of each history C stored in L.

=cut

has max_items => (
    is      => 'ro',
    isa     => Int,
    default => 10,
);

=head2 pages

A hash reference of arrays of hash references.

Primary key is the history C such as C or C. For each
C an array reference of pages is stored with new pages added at
the start of the array reference.

=cut

has pages => (
    is  => 'rw',
    isa => HashRef [
        ArrayRef [ InstanceOf ['Dancer2::Plugin::PageHistory::Page'] ] ],
    coerce    => \&_coerce_pages,
    predicate => 1,
);

sub _coerce_pages {
    my %pages;
    while ( my ( $type, $list ) = each %{ $_[0] } ) {
        foreach my $page (@$list) {
            if ( !blessed($page) && ref($page) eq 'HASH' ) {
                push @{ $pages{$type} },
                  Dancer2::Plugin::PageHistory::Page->new(%$page);
            }
        }
    }
    return \%pages;
}

=head2 methods

An array reference of extra method names that should be added to the class.
For example if one of these method names is 'product' then the following
shortcut method will be added:

    sub product {
        return shift->pages->{"product"};
    }

=cut

has methods => (
    is      => 'ro',
    isa     => ArrayRef,
    default => sub { [] },
    trigger => 1,
);

sub _trigger_methods {
    my ( $self, $methods ) = @_;
    foreach my $method (@$methods) {
        unless ( $self->can($method) ) {
            quote_sub "Dancer2::Plugin::PageHistory::PageSet::$method",
              q{ return shift->pages->{$type} || []; },
              { '$type' => \$method };
        }
    }
}

=head1 METHODS

=head2 add( %args )

C<$args{type}> defaults to L.

In addition to C other arguments should be those passed to C in
L.

=cut

sub add {
    my ( $self, %args ) = @_;

    my $type = delete $args{type} || $self->default_type;

    my $page = Dancer2::Plugin::PageHistory::Page->new(%args);

    if (   !$self->pages->{$type}
        || !$self->pages->{$type}->[0]
        || $self->pages->{$type}->[0]->uri ne $page->uri )
    {

        # not same uri as newest items on this list so add it

        unshift( @{ $self->pages->{$type} }, $page );

        # trim to max_items if necessary
        pop @{ $self->pages->{$type} }
          if @{ $self->pages->{$type} } > $self->max_items;
    }
}

=head2 has_pages

Predicate on L.

=head2 page_index($index, $type)

Returns the page from L of type C<$type> at position C<$index>.
If C<$type> is not supplied then L will be used.
If page is not found then L is returned instead.

=cut

sub page_index {
    my ( $self, $index, $type ) = @_;

    croak "index arg must be supplied to page_index" unless defined $index;
    $type = $self->default_type unless $type;

    if ( $self->has_pages && defined $self->pages->{$type}->[$index] ) {
        return $self->pages->{$type}->[$index];
    }
    return $self->fallback_page;
}

=head2 latest_page($type)

A convenience method equivalent to:

    page_index(0, $type)

=cut

sub latest_page {
    return shift->page_index( 0, shift );
}

=head2 previous_page

A convenience method equivalent to:

    page_index(1, $type)

=cut

sub previous_page {
    return shift->page_index( 1, shift );
}

=head2 types

Return all of the page types currently stored in history.

In array context returns an array of type names (keys of L)
and in scalar context returns the same as an array reference.

=cut

sub types {
    my $self = shift;
    wantarray ? keys %{ $self->pages } : [ keys %{ $self->pages } ];
}

1;