This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
d18a5a5710c5d558178b323fd0288611ebb93ce9
[perl5.git] / lib / I18N / Collate.pm
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   ***
11
12   WARNING: starting from the Perl version 5.003_06
13   the I18N::Collate interface for comparing 8-bit scalar data
14   according to the current locale
15
16         HAS BEEN DEPRECATED
17
18   That is, please do not use it anymore for any new applications
19   and please migrate the old applications away from it because its
20   functionality was integrated into the Perl core language in the
21   release 5.003_06.
22
23   See the perllocale manual page for further information.
24
25   ***
26
27 =head1 SYNOPSIS
28
29     use I18N::Collate;
30     setlocale(LC_COLLATE, 'locale-of-your-choice'); 
31     $s1 = new I18N::Collate "scalar_data_1";
32     $s2 = new I18N::Collate "scalar_data_2";
33
34 =head1 DESCRIPTION
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