[inseparable changes from match from perl-5.003_97 to perl-5.003_97a]
[perl.git] / lib / I18N / Collate.pm
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