lib/I18N/Collate.pm

   1 package I18N::Collate;
   2
   3 # Collate.pm
   4 #
   5 # Author:       Jarkko Hietaniemi <Jarkko.Hietaniemi@hut.fi>
   6 #               Helsinki University of Technology, Finland
   7 #
   8 # Acks:         Guy Decoux <decoux@moulon.inra.fr> understood
   9 #               overloading magic much deeper than I and told
  10 #               how to cut the size of this code by more than half.
  11 #               (my first version did overload all of lt gt eq le ge cmp)
  12 #
  13 # Purpose:      compare 8-bit scalar data according to the current locale
  14 #
  15 # Requirements: Perl5 POSIX::setlocale() and POSIX::strxfrm()
  16 #
  17 # Exports:      setlocale 1)
  18 #               collate_xfrm 2)
  19 #
  20 # Overloads:    cmp # 3)
  21 #
  22 # Usage:        use Collate;
  23 #               setlocale(&LC_COLLATE, 'locale-of-your-choice'); # 4)
  24 #               $s1 = new Collate "scalar_data_1";
  25 #               $s2 = new Collate "scalar_data_2";
  26 #
  27 #               now you can compare $s1 and $s2: $s1 le $s2
  28 #               to extract the data itself, you need to deref: $$s1
  29 #
  30 # Notes:
  31 #               1) this uses POSIX::setlocale
  32 #               2) the basic collation conversion is done by strxfrm() which
  33 #                  terminates at NUL characters being a decent C routine.
  34 #                  collate_xfrm handles embedded NUL characters gracefully.
  35 #               3) due to cmp and overload magic, lt le eq ge gt work also
  36 #               4) the available locales depend on your operating system;
  37 #                  try whether "locale -a" shows them or the more direct
  38 #                  approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
  39 #                  The locale names are probably something like
  40 #                  'xx_XX.(ISO)?8859-N'.
  41 #
  42 # Updated:      19940913 1341 GMT
  43 #
  44 # ---
  45
  46 use POSIX qw(strxfrm LC_COLLATE);
  47
  48 require Exporter;
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
  52 @EXPORT_OK = qw();
  53
  54 %OVERLOAD = qw(
  55 fallback        1
  56 cmp             collate_cmp
  57 );
  58
  59 sub new { my $new = $_[1]; bless \$new }
  60
  61 sub setlocale {
  62  my ($category, $locale) = @_[0,1];
  63
  64  POSIX::setlocale($category, $locale) if (defined $category);
  65  # the current $LOCALE
  66  $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || '';
  67 }
  68
  69 sub C {
  70   my $s = ${$_[0]};
  71
  72   $C->{$LOCALE}->{$s} = collate_xfrm($s)
  73     unless (defined $C->{$LOCALE}->{$s}); # cache when met
  74
  75   $C->{$LOCALE}->{$s};
  76 }
  77
  78 sub collate_xfrm {
  79   my $s = $_[0];
  80   my $x = '';
  81
  82   for (split(/(\000+)/, $s)) {
  83     $x .= (/^\000/) ? $_ : strxfrm("$_\000");
  84   }
  85
  86   $x;
  87 }
  88
  89 sub collate_cmp {
  90   &C($_[0]) cmp &C($_[1]);
  91 }
  92
  93 # init $LOCALE
  94
  95 &I18N::Collate::setlocale();
  96
  97 1; # keep require happy