package Language::MySort;

require Exporter;
@ISA = qw( Exporter );
@EXPORT = qw( lang sort );

%words = ();


sub lang_sort {
  my ($ignore, $same, $chars, $tr, $sorter) = ("", "");
  
  if (ref $_[-1]) {
    my $opt = pop;
     
    $ignore = $opt->{ignore} || ""; 
    $same = $opt->{translate} || "";
    
    $ignore = "\$s =~ tr/\Q$ignore\E//d;";
    
    if ($same) {
      my @f = map substr($_, 0, 1, ""), @$same;
      $same =
        " =~ tr/" .
        quotemeta(join "", @$same) .
        "/" .
        quotemeta(join "", map $f[$_] x length($same->[$_]), 0 .. $#$same) .
        "/";
    }
  }
  
  $chars = @_ == 1 ? shift : join "", @_;
  
  $tr = eval qq{
    sub {
      (my \$s = shift) $same;
      $ignore
      \$s =~ tr/\Q$chars\E/\000-\377/;
      \$s;
    }
  };

  $sorter = sub {
    my @used = map $tr->($_), @_;
    @{ $words{$chars} }{ @used } = @_;
    @{ $words{$chars} }{ sort @used };
  };
  
  return wantarray() ? ($sorter, $tr) : $sorter;
}


1;

##</code><code>##

use Language::MySort;

*french_sort = lang_sort(
  # *the character list*
  # only includes the characters remaining after
  # the identical-character map has been applied
  'a' .. 'z',

  {
    # *the identical-character map*
    # maps characters to the character
    # they should sort identically as
    # "AXYZ" means that X, Y, and Z are translated as A
    identical =>
      ["a\340", "c\347", "e\350\351\352\353", "o\364"],
  }
);
      
{ 
  local $, = " ";
  print french_sort(
    "\351tude",
    "\352tre",
    "tr\350s",
    "entrer",
    "\351t\351",
  );
}

##</code><code>##

use Language::MySort;

*weird_sort = lang_sort(
  # place vowels ahead of consonants
  qw( a e i b c d f g h j ),

  {
    # map uppercase characters to lowercase
    identical => [qw( aA bB cC dD eE fF gG hH iI jJ )],

    # ignore - and .
    ignore => "-.",
  }
);

##</code><code>##

use Language::MySort;

*weird_sort = lang_sort(
  # place vowels ahead of consonants
  qw( a e i ), 'a' .. 'j',

  {
    # map uppercase characters to lowercase
    identical => [qw( aA bB cC dD eE fF gG hH iI jJ )],

    # ignore - and .
    ignore => "-.",
  }
);

##</code><code>##

use Language::MySort;

*sorter = lang_sort(
  # nifty way to make (A, a, B, b, C, c, ... Z, z)
  (map +($_, lc), 'A' .. 'Z')
  { ignore => q{-} }
);