lib/I18N/Collate.pm

   1 package I18N::Collate;
   2
   3 use strict;
   4 our $VERSION = '1.01';
   5
   6 =head1 NAME
   7
   8 I18N::Collate - compare 8-bit scalar data according to the current locale
   9
  10 =head1 SYNOPSIS
  11
  12     use I18N::Collate;
  13     setlocale(LC_COLLATE, 'locale-of-your-choice');
  14     $s1 = I18N::Collate->new("scalar_data_1");
  15     $s2 = I18N::Collate->new("scalar_data_2");
  16
  17 =head1 DESCRIPTION
  18
  19   ***
  20
  21   WARNING: starting from the Perl version 5.003_06
  22   the I18N::Collate interface for comparing 8-bit scalar data
  23   according to the current locale
  24
  25         HAS BEEN DEPRECATED
  26
  27   That is, please do not use it anymore for any new applications
  28   and please migrate the old applications away from it because its
  29   functionality was integrated into the Perl core language in the
  30   release 5.003_06.
  31
  32   See the perllocale manual page for further information.
  33
  34   ***
  35
  36 This module provides you with objects that will collate
  37 according to your national character set, provided that the
  38 POSIX setlocale() function is supported on your system.
  39
  40 You can compare $s1 and $s2 above with
  41
  42     $s1 le $s2
  43
  44 to extract the data itself, you'll need a dereference: $$s1
  45
  46 This module uses POSIX::setlocale(). The basic collation conversion is
  47 done by strxfrm() which terminates at NUL characters being a decent C
  48 routine.  collate_xfrm() handles embedded NUL characters gracefully.
  49
  50 The available locales depend on your operating system; try whether
  51 C<locale -a> shows them or man pages for "locale" or "nlsinfo" or the
  52 direct approach C<ls /usr/lib/nls/loc> or C<ls /usr/lib/nls> or
  53 C<ls /usr/lib/locale>.  Not all the locales that your vendor supports
  54 are necessarily installed: please consult your operating system's
  55 documentation and possibly your local system administration.  The
  56 locale names are probably something like C<xx_XX.(ISO)?8859-N> or
  57 C<xx_XX.(ISO)?8859N>, for example C<fr_CH.ISO8859-1> is the Swiss (CH)
  58 variant of French (fr), ISO Latin (8859) 1 (-1) which is the Western
  59 European character set.
  60
  61 =cut
  62
  63 # I18N::Collate.pm
  64 #
  65 # Author:       Jarkko Hietaniemi <F<jhi@iki.fi>>
  66 #               Helsinki University of Technology, Finland
  67 #
  68 # Acks:         Guy Decoux <F<decoux@moulon.inra.fr>> understood
  69 #               overloading magic much deeper than I and told
  70 #               how to cut the size of this code by more than half.
  71 #               (my first version did overload all of lt gt eq le ge cmp)
  72 #
  73 # Purpose:      compare 8-bit scalar data according to the current locale
  74 #
  75 # Requirements: Perl5 POSIX::setlocale() and POSIX::strxfrm()
  76 #
  77 # Exports:      setlocale 1)
  78 #               collate_xfrm 2)
  79 #
  80 # Overloads:    cmp # 3)
  81 #
  82 # Usage:        use I18N::Collate;
  83 #               setlocale(LC_COLLATE, 'locale-of-your-choice'); # 4)
  84 #               $s1 = I18N::Collate->("scalar_data_1");
  85 #               $s2 = I18N::Collate->("scalar_data_2");
  86 #
  87 #               now you can compare $s1 and $s2: $s1 le $s2
  88 #               to extract the data itself, you need to deref: $$s1
  89 #
  90 # Notes:
  91 #               1) this uses POSIX::setlocale
  92 #               2) the basic collation conversion is done by strxfrm() which
  93 #                  terminates at NUL characters being a decent C routine.
  94 #                  collate_xfrm handles embedded NUL characters gracefully.
  95 #               3) due to cmp and overload magic, lt le eq ge gt work also
  96 #               4) the available locales depend on your operating system;
  97 #                  try whether "locale -a" shows them or man pages for
  98 #                  "locale" or "nlsinfo" work or the more direct
  99 #                  approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls".
 100 #                  Not all the locales that your vendor supports
 101 #                  are necessarily installed: please consult your
 102 #                  operating system's documentation.
 103 #                  The locale names are probably something like
 104 #                  'xx_XX.(ISO)?8859-N' or 'xx_XX.(ISO)?8859N',
 105 #                  for example 'fr_CH.ISO8859-1' is the Swiss (CH)
 106 #                  variant of French (fr), ISO Latin (8859) 1 (-1)
 107 #                  which is the Western European character set.
 108 #
 109 # Updated:      19961005
 110 #
 111 # ---
 112
 113 use POSIX qw(strxfrm LC_COLLATE);
 114 use warnings::register;
 115
 116 require Exporter;
 117
 118 our @ISA = qw(Exporter);
 119 our @EXPORT = qw(collate_xfrm setlocale LC_COLLATE);
 120 our @EXPORT_OK = qw();
 121
 122 use overload qw(
 123 fallback        1
 124 cmp             collate_cmp
 125 );
 126
 127 our($LOCALE, $C);
 128
 129 our $please_use_I18N_Collate_even_if_deprecated = 0;
 130 sub new {
 131   my $new = $_[1];
 132
 133   if (warnings::enabled() && $] >= 5.003_06) {
 134     unless ($please_use_I18N_Collate_even_if_deprecated) {
 135       warnings::warn <<___EOD___;
 136 ***
 137
 138   WARNING: starting from the Perl version 5.003_06
 139   the I18N::Collate interface for comparing 8-bit scalar data
 140   according to the current locale
 141
 142         HAS BEEN DEPRECATED
 143
 144   That is, please do not use it anymore for any new applications
 145   and please migrate the old applications away from it because its
 146   functionality was integrated into the Perl core language in the
 147   release 5.003_06.
 148
 149   See the perllocale manual page for further information.
 150
 151 ***
 152 ___EOD___
 153       $please_use_I18N_Collate_even_if_deprecated++;
 154     }
 155   }
 156
 157   bless \$new;
 158 }
 159
 160 sub setlocale {
 161  my ($category, $locale) = @_[0,1];
 162
 163  POSIX::setlocale($category, $locale) if (defined $category);
 164  # the current $LOCALE
 165  $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || '';
 166 }
 167
 168 sub C {
 169   my $s = ${$_[0]};
 170
 171   $C->{$LOCALE}->{$s} = collate_xfrm($s)
 172     unless (defined $C->{$LOCALE}->{$s}); # cache when met
 173
 174   $C->{$LOCALE}->{$s};
 175 }
 176
 177 sub collate_xfrm {
 178   my $s = $_[0];
 179   my $x = '';
 180
 181   for (split(/(\000+)/, $s)) {
 182     $x .= (/^\000/) ? $_ : strxfrm("$_\000");
 183   }
 184
 185   $x;
 186 }
 187
 188 sub collate_cmp {
 189   &C($_[0]) cmp &C($_[1]);
 190 }
 191
 192 # init $LOCALE
 193
 194 &I18N::Collate::setlocale();
 195
 196 1; # keep require happy