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