package Alpha;
use warnings;
use strict;
use integer;
use FindBin;
use lib $FindBin::RealBin;
use Def;

# This module provides, among others, the text-comparision function
# Alpha::cmp_std_mn($$).  The Alpha::cmp_std_mn() compares strings as
# does Perl's `cmp' operator, but with a sort order appropriate to
# debram-standard maintainer names.  For example, it correctly sorts
#
#   Tm GCC
#   Tm XML/SGML
#   J. v Baal
#   TH Black
#   G. Catenazzi
#   M. Danish
#   DI Lehn
#   E. Schubert
#   Z. TEst
#   X. Test
#   C. TEsta
#   B. Testa
#   A. TExt
#   E. Zini
#   Tm QA
#
# Because Debian's QA Team keeps many unrelated orphaned packages,
# Alpha::cmp_std_mn() always sorts "Tm QA" last.  Other teams are sorted
# first.
#
# Heavyweight locale(7) support is not wanted here, nor is Unicode; a
# simple eight-bit character-by-character sort is preferred.  All
# non-Latin-1 Debian maintainers have Latin-1-ized their own names, so
# most of their names pose the debram little problem.  But the the
# debram's sort may not suit all Latin-1 maintainers.  Regrettably no
# perfect international sort is possible.
#
# See also the file `../maint.txt'.

our @chr = (
  ( map { chr } 0000 .. 0100 ),
  (
    map { chr( $_ ), chr( $_ + 0040 ) }
    0101        , 0300 .. 0306,       # a
    0102 .. 0103, 0307        ,       # bc
    0104        , 0320        ,       # d
    0105        , 0310 .. 0313,       # e
    0106 .. 0111, 0314 .. 0317,       # fghi
    0112 .. 0116, 0321        ,       # jklmn
    0117        , 0322 .. 0326, 0330, # o
    0120 .. 0123,                     # pqrs
  ),
  ( chr 0337 ),
  (
    map { chr( $_ ), chr( $_ + 0040 ) }
    0124 .. 0125, 0331 .. 0334,       # tu
    0126 .. 0131, 0335        ,       # vwxy
  ),
  ( chr 0377 ),
  (
    map { chr( $_ ), chr( $_ + 0040 ) }
    0132        , 0336        ,       # z
  ),
  ( map { chr } 0133 .. 0140, 0173 .. 0277, 0327, 0367 ),
);
our %cap = map { chr() => 1 } 0101 .. 0132, 0300 .. 0326, 0330 .. 0336;
our %ord = map { $chr[$_] => $_ } 0 .. $#chr;
$#chr == 0377 && keys( %ord ) == @chr
  && eval {
    defined $ord{ chr $_ } or return 0 for 0 .. $#chr;
    my %n = map { $_ => 1 } values %ord;
    $n{$_}                 or return 0 for 0 .. $#chr;
    return 1;
  }
  or die "$0: bad \@chr or \%ord\n";
$@ and die $@;

# The @Def::early and @Def::late lists include patterns which, when
# matched, cause the name to sort early or late.  The earliest pattern
# stands first in @Def::early, the latest pattern stands last in
# @Def::late.  If a name matches two or more patterns,
#
#   (a) @Def::late takes precedence over @Def::early;
#   (b) within @Def::early, earlier patterns take precendence;
#   (c) within @Def::late, later patterns take precedence.

sub cmpa ($$) {
  my( $a, $b ) = @_;
  return  0 unless defined( $a ) || defined( $b );
  return  1 unless defined( $a );
  return -1 unless defined( $b );
  my( $u, $v ) = ( length( $a ) - 1, length( $b ) - 1 );
  my $z        = $u <= $v ? $u : $v;
  my $cmp      = 0;
  for my $test_eqv ( '1', '' ) {
    for ( my $i = 0; $i <= $z; ++$i ) {
      my $c = substr( $a, $i, 1 );
      my $d = substr( $b, $i, 1 );
      $cmp  = $test_eqv && eqv( $c, $d ) ? 0 : $ord{$c} <=> $ord{$d};
      return $cmp if $cmp;
    }
    $cmp = $u <=> $v;
    return $cmp if $cmp;
  }
  return $cmp;
}

sub eqv ($$) {
  my( $a , $b  ) = @_;
  my( $uc, $lc );
  $cap{$_} ? $uc : $lc = $_ for $a , $b ;
  defined or return ''      for $uc, $lc;
  return $ord{$lc} == $ord{$uc} + 1;
}

sub init  (;$) {
  local $_ = @_ ? shift() : $_;
  /^(.{${Def::n_init}}) \S/o;
  return $1;
}

sub lastn (;$) {
  local $_ = @_ ? shift() : $_;
  /^.{${Def::n_init}} (.{1,${Def::n_last}})$/o;
  return $1;
}

sub alpha (;$) {
  local $_ = @_ ? shift() : $_;
  my $last = lastn;
  my $i = 0;
  ++$i < length $last or return undef
    until $cap{ substr $last, $i, 1 };
  return substr $last, $i;
}

sub cmp_std_mn ($$) {
  my( $a, $b ) = @_;
  return  0 unless defined( $a ) || defined( $b );
  return  1 unless defined( $a );
  return -1 unless defined( $b );
  for my $late  ( reverse @Def::pat_maint_late  ) {
    return  1 if $a =~ $late  && $b !~ $late ;
    return -1 if $b =~ $late  && $a !~ $late ;
  }
  for my $early (         @Def::pat_maint_early ) {
    return  1 if $b =~ $early && $a !~ $early;
    return -1 if $a =~ $early && $b !~ $early;
  }
  return
    cmpa( alpha( $a ), alpha( $b ) ) ||
    cmpa( lastn( $a ), lastn( $b ) ) ||
    cmpa( init ( $a ), init ( $b ) ) ||
    cmpa(        $a,          $b   );
}

1;

