File Coverage

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

Criterion	Covered	Total	%
statement	48	49	97.9
branch	14	18	77.7
condition	10	15	66.6
subroutine	12	12	100.0
pod	5	5	100.0
total	89	99	89.9

package Dancer::Plugin::PageHistory::PageSet;

=head1 NAME

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

=cut

use Moo;
use Scalar::Util qw(blessed);
use Sub::Quote qw(quote_sub);
use Types::Standard qw(ArrayRef HashRef InstanceOf Int Maybe Str);
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 Dancer::Plugin::PageHistory::Page->new

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

=back

=cut

has fallback_page => (
    is      => 'ro',
    isa     => Maybe [ InstanceOf ['Dancer::Plugin::PageHistory::Page'] ],
    default => undef,
    coerce =>
      sub { $_[0] ? Dancer::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 ['Dancer::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} },
                  Dancer::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 "Dancer::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;

    die "args to add must include a defined path" unless defined $args{path};

    my $page = Dancer::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 ) = @_;

    die "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;