File Coverage

web/cgi-bin/yatt.lib/YATT/Util/DictOrder.pm

Criterion	Covered	Total	%
statement	21	22	95.4
branch	5	6	83.3
condition	3	6	50.0
subroutine	5	5	100.0
pod	2	2	100.0
total	36	41	87.8

package YATT::Util::DictOrder;
use strict;
use warnings FATAL => qw(all);
use base qw/Exporter/;

our @EXPORT_OK = qw(&dict_order &dict_sort);
our @EXPORT = @EXPORT_OK;

sub dict_order {
  my ($a, $b, $start) = @_;
  $start = 1 unless defined $start;
  my ($result, $i) = (0);
  for ($i = $start; $i <= $#$a and $i <= $#$b; $i++) {
    if ($a->[$i] =~ /^\d/ and $b->[$i] =~ /^\d/) {
      $result = $a->[$i] <=> $b->[$i];
    } else {
      $result = $a->[$i] cmp $b->[$i];
    }
    return $result unless $result == 0;
  }
  return $#$a <=> $#$b;
}

# a   => ['a', 'a']
# q1a => ['q1a', 'q', 1, 'a']
# q11b => ['q11b', 'q', 11, 'b']
sub dict_sort (@) {
  map {$_->[0]} sort {dict_order($a,$b)} map {[$_, split /(\d+)/]} @_;
}

1;

=head1 NAME

YATT::Util::DictOrder - Dictionary-style ordering and sorting.

=head1 SYNOPSIS

  use YATT::Util::DictOrder;
  print join ",", dict_sort qw(q3-1 q3 q10a q1);
  # prints "q1,q3,q3-1,q10a"

  print join ",",
     map {$$_[0]}
     sort {dict_order($a, $b, 1)}
     map {[$$_[0], split /(\d+)/, $$_[1]]}
    [qw(foo q3-1)],
    [qw(summer q3)],
    [qw(moe q10a)],
    [qw(romantic q1)];
  # prints "romantic,summer,foo,moe"

=head1 DESCRIPTION

=head2 C

=head2 C

=head1 AUTHOR

KOBAYASI, Hiroaki (C)

=head1 LICENSE

This library is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.

=cut