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;