File Coverage

blib/lib/Mojolicious/Plugin/TagHelpers/Pagination.pm

Criterion	Covered	Total	%
statement	101	104	97.1
branch	46	52	88.4
condition	42	52	80.7
subroutine	9	9	100.0
pod	2	3	66.6
total	200	220	90.9

package Mojolicious::Plugin::TagHelpers::Pagination;
use Mojo::Base 'Mojolicious::Plugin';
use Mojo::ByteStream 'b';
use Scalar::Util 'blessed';
use POSIX 'ceil';

our $VERSION = 0.09;

our @value_list =
  qw/prev
     next
     current_start
     current_end
     page_start
     page_end
     separator
     ellipsis
     placeholder/;

# Register plugin
sub register {
  my ($plugin, $mojo, $param) = @_;

  $param ||= {};

  # Load parameter from Config file
  if (my $config_param = $mojo->config('TagHelpers-Pagination')) {
    $param = { %$param, %$config_param };
  };

  foreach (@value_list) {
    $plugin->{$_} = $param->{$_} if defined $param->{$_};
  };

  # Set 'current_start' and 'current_end' symbols,
  # if 'current' template is available.
  # Same for 'page'.
  foreach (qw/page current/) {
    if (defined $param->{$_}) {
      @{$plugin}{"${_}_start", "${_}_end"} = split("{$_}", $param->{$_});
      $plugin->{"${_}_end"} ||= '';
    };
  };

  # Default current start and current end symbols
  for ($plugin) {
    $_->{current_start} //= '[';
    $_->{current_end}   //= ']';
    $_->{page_start}    //= '';
    $_->{page_end}      //= '';
    $_->{prev}          //= '<';
    $_->{next}          //= '>';
    $_->{separator}     //= ' ';
    $_->{ellipsis}      //= '...';
    $_->{placeholder}   //= 'page';
  };

  # Establish pagination helper
  $mojo->helper(
    pagination => sub {
      return b( $plugin->pagination( @_ ) );
    });
};


# Pagination helper
sub pagination {
  my $self = shift;
  my $c = shift;

  # $_[0] = current page
  # $_[1] = page count or -1
  # $_[2] = template or Mojo::URL

  return '' unless $_[1];

  # No valid count given
  local $_[1] = !$_[1] ? 1 : ceil($_[1]);
  local $_[0] = $_[0] // 1;

  # New parameter hash
  my %values =
    map { $_ => $self->{$_} } @value_list;

  # Overwrite plugin defaults
  if ($_[3] && ref $_[3] eq 'HASH') {
    my $overwrite = $_[3];
    foreach (@value_list) {
      $values{$_}  = $overwrite->{$_} if defined $overwrite->{$_};
    };

    foreach (qw/page current/) {
      if (defined $overwrite->{$_}) {
        @values{$_ . '_start', $_ . '_end'} = split("{$_}", $overwrite->{$_});
        $values{$_ . '_end'} ||= '';
      };
    };
  };

  # Establish string variables
  my ($p, $n, $cs, $ce, $ps, $pe, $s, $el, $ph) = @values{@value_list};
  # prev next current_start current_end
  # page_start page_end separator ellipsis placeholder

  # Template
  my $t = $_[2];
  if (blessed $t && blessed $t eq 'Mojo::URL') {
    $t = $t->to_string;
    $t =~ s/\%7[bB]$ph\%7[dD]/{$ph}/g;
  };

  my $sub = sublink_gen($c, $t, $ps, $pe, $ph) or return '';

  # Pagination string
  my $e;
  my $counter = 1;

  # More than seven pages
  if ($_[1] >= 7 ||

	# Or the number of pages is unknown
	($_[1] == -1 && $_[0] > 4)){

    # < [1] #2 #3
    # The current page is 1
    if ($_[0] == 1){
      $e .= $sub->(undef, [$p, 'prev']) . $s .
	    $sub->(undef, [$cs . 1  . $ce, 'self']) . $s .
	    $sub->('2') . $s .
	    $sub->('3') . $s;
    }

    # < #1 #2 #3
    # The current page is 0
    elsif ($_[0] == 0) {
      $e .= $sub->(undef, [$p, 'prev']) . $s;
      $e .= $sub->($_) . $s foreach (1 .. 3);
    }

    # #< #1
    # The current page is anywhere
    else {
      $e .= $sub->(($_[0] - 1), [$p, 'prev']) . $s .
            $sub->('1') . $s;
    };

    # [2] #3
    # The current page is 2
    if ($_[0] == 2) {
      $e .= $sub->(undef, [$cs . 2 . $ce, 'self']) . $s .
	    $sub->('3') . $s;
    }

    # ...
    # The current page is beyond 3
    elsif ($_[0] > 3) {
      $e .= $el . $s;
    };

    # #x-1 [x] #x+1
    # The current page is beyond 2 and there are at least 2 pages to go
    if (($_[0] >= 3) && ($_[0] <= ($_[1] - 2))) {
      $e .= $sub->($_[0] - 1) . $s .
	    $sub->(undef, [$cs .$_[0] . $ce, 'self']) . $s .
	    $sub->($_[0] + 1) . $s;
    };

    # ...
    # There are at least 2 pages following the current page
    if ($_[0] < ($_[1] - 2)){
      $e .= $el . $s;
    };

    # The current page is prefinal
    if ($_[0] == ($_[1] - 1)){
      $e .= $sub->($_[1] - 2) . $s .
	    $sub->(undef, [$cs . $_[0] . $ce, 'self']) . $s .
	      $sub->($_[1]) . $s .
	      $sub->($_[1], [$n, 'next']);
    }

    # The current page is final
    elsif ($_[0] == $_[1]) {
      $e .= $sub->($_[0] - 1) . $s .
            $sub->(undef, [$cs . $_[0] . $ce, 'self']) . $s .
	    $sub->(undef, [$n, 'next']);
    }

    # Number is unknown
    elsif ($_[1] == -1) {
      $e .= $sub->($_[0] - 1) . $s .
            $sub->(undef, [$cs . $_[0] . $ce, 'self']) . $s .
	    $el . $s .
	    $sub->($_[0] + 1, [$n, 'next']);
    }

    # Number is anywhere in between
    else {
      $e .= $sub->($_[1]) . $s .
	      $sub->(($_[0] + 1), [$n, 'next']);
    };
  }

  # Counter < 7
  else {

    # Previous
    if ($_[0] > 1){
      $e .= $sub->(($_[0] - 1), [$p, 'prev']) . $s;
    } else {
      $e .= $sub->(undef, [$p, 'prev']) . $s;
    };

    # All numbers in between
    while ($counter <= $_[1] || ($_[1] == -1 && $counter <= $_[0])){
      if ($_[0] != $counter) {
        $e .= $sub->($counter) . $s;
      }

      # Current
      else {
        $e .= $sub->(undef, [$cs . $counter . $ce, 'self']) . $s;
      };

      $counter++;
    };

    # Ellipsis in case the number is not known
    $e .= $el . $s if $_[1] == -1;

    # Next
    if ($_[0] != $_[1]){
      $e .= $sub->(($_[0] + 1), [$n, 'next']);
    }

    else {
      $e .= $sub->(undef, [$n, 'next']);
    };
  };

  # Pagination string
  $e;
};


# Sublink function generator
sub sublink_gen {
  my $c = shift;
  my ($url, $ps, $pe, $ph) = @_;

  my $s = 'sub{';
  # $_[0] = number
  # $_[1] = number_shown

  # Url is template
  if ($url && length($url) > 0) {
    $s .= 'my $url=' . _quote($url) . ';';
    $s .= 'if($_[0]){$url=~s/\{' . $ph . '\}/$_[0]/g}else{$url=undef};';
  }

  # No template given
  else {
    $s .= 'my $url = $_[0];';
  };

  $s .= q!my$n=$_[1]||! . _quote($ps) . '.$_[0].' . _quote($pe) . ';' .
        q{my $rel='';} .
	q{if(ref $n){$rel=' rel="'.$n->[1].'"';$n=$n->[0]};} .
        q!if($url){$url=~s/&/&/g;! .
        q{$url=~s/
	q{$url=~s/>/>/g;} .
        q{$url=~s/"/"/g;} .
        q!$url=~s/'/'/g;};!;

  # Create sublink
  $s .= q!return '' . $n . '';}!;

  my $x = eval $s;

  # Log evaluation error and return
  $c->app->log->warn($@) and return if $@;

  $x;
};


# Quote with a single quote
sub _quote {
  my $str = shift;
  $str =~ s/(['\\])/\\$1/g;
  return qq{'$str'};
};

1;


__END__