[Summary view] [Print] [Text view]

   1  package I18N::Collate;
   2  
   3  use strict;
   4  our $VERSION = '1.00';
   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 = new I18N::Collate "scalar_data_1";
  15      $s2 = new I18N::Collate "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 = new I18N::Collate "scalar_data_1";
  85  #        $s2 = new 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