File Coverage

blib/lib/Articulate/Sortation/Slug.pm

Criterion	Covered	Total	%
statement	33	37	89.1
branch	16	22	72.7
condition	2	2	100.0
subroutine	6	6	100.0
pod	0	1	0.0
total	57	68	83.8

package Articulate::Sortation::Slug;
use strict;
use warnings;

use Moo;
with 'Articulate::Role::Sortation::AllYouNeedIsCmp';

sub _left { -1 }

sub _right { 1 }

sub cmp {
  my $self     = shift;
  my $left     = shift;
  my $right    = shift;
  my $re_break = qr/(?: # Breaks between groups of characters
  #  (?<=[a-z])|(?=[a-z]) # aa
    (?<=[a-z])(?![a-z]) # a0
  | (?
  | (?<=[0-9])(?![0-9]) # 0_
  | (?
  )/ix;
  my $la = [ grep { $_ ne '' } split( $re_break, $left ) ];
  my $ra = [ grep { $_ ne '' } split( $re_break, $right ) ];

  #warn Dump {left => {$left, $la}, right => {$right,$ra}};
  while ( scalar @$la && scalar @$ra ) {
    my $l = shift @$la;
    my $r = shift @$ra;
    if ( $l =~ /^[^a-z0-9]/i ) {
      if ( $r =~ /^[a-z0-9]/i ) {

        # left is dash and right is not - left wins
        return _left;
      }
      next; # otherwise both are dash - continue
    }
    elsif ( $r =~ /^[^a-z0-9]/i ) {

      # right is dash and left is not - right wins
      return _right;
    }
    elsif ( $l =~ /^[0-9]/ ) {
      if ( $r =~ /^[0-9]/ ) {

        # both are numbers
        my $res = ( $l <=> $r );
        return $res if $res;
      }
      else {
        # left is number, right is alpha -  left wins
        return _left;
      }
    }
    else {
      # both are alphabetic
      my $res = ( $l cmp $r );
      return $res if $res;
    }
  }
  return @$ra ? _left : 0 if ( !@$la );
  return _right if ( !@$ra );
  die 'shouldn\'t be here' if $left ne $right;
  return $left cmp $right;
}

1;