1 | package Sort::Key::Natural;
|
---|
2 |
|
---|
3 | our $VERSION = '0.04';
|
---|
4 |
|
---|
5 | use strict;
|
---|
6 | use warnings;
|
---|
7 |
|
---|
8 | require Exporter;
|
---|
9 |
|
---|
10 | our @ISA = qw( Exporter );
|
---|
11 | our @EXPORT_OK = qw( natkeysort
|
---|
12 | natkeysort_inplace
|
---|
13 | rnatkeysort
|
---|
14 | rnatkeysort_inplace
|
---|
15 | mkkey_natural
|
---|
16 | natsort
|
---|
17 | rnatsort
|
---|
18 | natsort_inplace
|
---|
19 | rnatsort_inplace
|
---|
20 |
|
---|
21 | natwfkeysort
|
---|
22 | natwfkeysort_inplace
|
---|
23 | rnatwfkeysort
|
---|
24 | rnatwfkeysort_inplace
|
---|
25 | mkkey_natural_with_floats
|
---|
26 | natwfsort
|
---|
27 | rnatwfsort
|
---|
28 | natwfsort_inplace
|
---|
29 | rnatwfsort_inplace );
|
---|
30 |
|
---|
31 |
|
---|
32 | require locale;
|
---|
33 |
|
---|
34 | sub mkkey_natural {
|
---|
35 | my $nat = @_ ? shift : $_;
|
---|
36 | my @parts = do {
|
---|
37 | if ((caller 0)[8] & $locale::hint_bits) {
|
---|
38 | use locale;
|
---|
39 | $nat =~ /\d+|\p{IsAlpha}+/g;
|
---|
40 | }
|
---|
41 | else {
|
---|
42 | $nat =~ /\d+|\p{IsAlpha}+/g;
|
---|
43 | }
|
---|
44 | };
|
---|
45 | for (@parts) {
|
---|
46 | if (/^\d/) {
|
---|
47 | s/^0+//;
|
---|
48 | my $len = length;
|
---|
49 | my $nines = int ($len / 9);
|
---|
50 | my $rest = $len - 9 * $nines;
|
---|
51 | $_ = ('9' x $nines) . $rest . $_;
|
---|
52 | }
|
---|
53 | }
|
---|
54 | return join("\0", @parts);
|
---|
55 | }
|
---|
56 |
|
---|
57 | use Sort::Key::Register natural => \&mkkey_natural, 'string';
|
---|
58 | use Sort::Key::Register nat => \&mkkey_natural, 'string';
|
---|
59 |
|
---|
60 | use Sort::Key::Maker natkeysort => 'nat';
|
---|
61 | use Sort::Key::Maker rnatkeysort => '-nat';
|
---|
62 | use Sort::Key::Maker natsort => \&mkkey_natural, 'str';
|
---|
63 | use Sort::Key::Maker rnatsort => \&mkkey_natural, '-str';
|
---|
64 |
|
---|
65 | sub mkkey_natural_with_floats {
|
---|
66 | my $nat = @_ ? shift : $_;
|
---|
67 | my @parts = do {
|
---|
68 | if ((caller 0)[8] & $locale::hint_bits) {
|
---|
69 | use locale;
|
---|
70 | $nat =~ /[+\-]?\d+(?:\.\d*)?|\p{IsAlpha}+/g;
|
---|
71 | }
|
---|
72 | else {
|
---|
73 | $nat =~ /[+\-]?\d+(?:\.\d*)?|\p{IsAlpha}+/g;
|
---|
74 | }
|
---|
75 | };
|
---|
76 | for (@parts) {
|
---|
77 | if (my ($sign, $number, $dec) = /^([+-]?)(\d+)(?:\.(\d*))?$/) {
|
---|
78 | $number =~ s/^0+//;
|
---|
79 | $dec = '' unless defined $dec;
|
---|
80 | $dec =~ s/0+$//;
|
---|
81 | my $len = length $number;
|
---|
82 | my $nines = int ($len / 9);
|
---|
83 | my $rest = $len - 9 * $nines;
|
---|
84 | $_ = ('9' x $nines) . $rest . $number . $dec;
|
---|
85 | if ($sign eq '-' and $_ ne '0') {
|
---|
86 | tr/0123456789/9876543210/;
|
---|
87 | $_ = "-$_";
|
---|
88 | }
|
---|
89 | }
|
---|
90 | }
|
---|
91 | return join("\0", @parts);
|
---|
92 | }
|
---|
93 |
|
---|
94 | use Sort::Key::Register natural_with_floats => \&mkkey_natural_with_floats, 'string';
|
---|
95 | use Sort::Key::Register natwf => \&mkkey_natural_with_floats, 'string';
|
---|
96 |
|
---|
97 | use Sort::Key::Maker natwfkeysort => 'natwf';
|
---|
98 | use Sort::Key::Maker rnatwfkeysort => '-natwf';
|
---|
99 | use Sort::Key::Maker natwfsort => \&mkkey_natural_with_floats, 'str';
|
---|
100 | use Sort::Key::Maker rnatwfsort => \&mkkey_natural_with_floats, '-str';
|
---|
101 |
|
---|
102 |
|
---|
103 | 1;
|
---|
104 |
|
---|
105 | =head1 NAME
|
---|
106 |
|
---|
107 | Sort::Key::Natural - fast natural sorting
|
---|
108 |
|
---|
109 | =head1 SYNOPSIS
|
---|
110 |
|
---|
111 | use Sort::Key::Natural qw(natsort);
|
---|
112 |
|
---|
113 | my @data = qw(foo1 foo23 foo6 bar12 bar1
|
---|
114 | foo bar2 bar-45 foomatic b-a-r-45);
|
---|
115 |
|
---|
116 | my @sorted = natsort @data;
|
---|
117 |
|
---|
118 | print "@sorted\n";
|
---|
119 | # prints:
|
---|
120 | # b-a-r-45 bar1 bar2 bar12 bar-45 foo foo1 foo6 foo23 foomatic
|
---|
121 |
|
---|
122 | use Sort::Key::Natural qw(natkeysort);
|
---|
123 |
|
---|
124 | my @objects = (...);
|
---|
125 | my @sorted = natkeysort { $_->get_id } @objects;
|
---|
126 |
|
---|
127 |
|
---|
128 | =head1 DESCRIPTION
|
---|
129 |
|
---|
130 | This module extends the L<Sort::Key> family of modules to support
|
---|
131 | natural sorting.
|
---|
132 |
|
---|
133 | Under natural sorting, strings are splitted at word and number
|
---|
134 | boundaries, and the resulting substrings
|
---|
135 | are compared as follows:
|
---|
136 |
|
---|
137 | =over 4
|
---|
138 |
|
---|
139 | =item *
|
---|
140 |
|
---|
141 | numeric substrings are compared numerically
|
---|
142 |
|
---|
143 | =item *
|
---|
144 |
|
---|
145 | alphabetic substrings are compared lexically
|
---|
146 |
|
---|
147 | =item *
|
---|
148 |
|
---|
149 | numeric substrings come always before alphabetic substrings
|
---|
150 |
|
---|
151 | =back
|
---|
152 |
|
---|
153 | Spaces, symbols and non-printable characters are only considered for
|
---|
154 | splitting the string into its parts but not for sorting. For instance
|
---|
155 | C<foo-bar-42> is broken in three substrings C<foo>, C<bar> and C<42>
|
---|
156 | and after that the dashes are ignored.
|
---|
157 |
|
---|
158 | Note, that the sorting is case sensitive. To do a case insensitive
|
---|
159 | sort you have to convert the keys explicitly:
|
---|
160 |
|
---|
161 | my @sorted = natkeysort { lc $_ } @data
|
---|
162 |
|
---|
163 | Also, once this module is loaded, the new type C<natural> (or C<nat>) will
|
---|
164 | be available from L<Sort::Key::Maker>. For instance:
|
---|
165 |
|
---|
166 | use Sort::Key::Natural;
|
---|
167 | use Sort::Key::Maker i_rnat_keysort => qw(integer -natural);
|
---|
168 |
|
---|
169 | creates a multikey sorter C<i_rnat_keysort> accepting two keys, the
|
---|
170 | first to be compared as an integer and the second in natural
|
---|
171 | descending order.
|
---|
172 |
|
---|
173 | There is also an alternative set of natural sorting functions that
|
---|
174 | recognize floating point numbers. They use the key type C<natwf>
|
---|
175 | (abreviation of C<natural_with_floats>).
|
---|
176 |
|
---|
177 | =head2 FUNCTIONS
|
---|
178 |
|
---|
179 | the functions that can be imported from this module are:
|
---|
180 |
|
---|
181 | =over 4
|
---|
182 |
|
---|
183 | =item natsort @data
|
---|
184 |
|
---|
185 | returns the elements of C<@data> sorted in natural order.
|
---|
186 |
|
---|
187 | =item rnatsort @data
|
---|
188 |
|
---|
189 | returns the elements of C<@data> sorted in natural descending order.
|
---|
190 |
|
---|
191 | =item natkeysort { CALC_KEY($_) } @data
|
---|
192 |
|
---|
193 | returns the elements on C<@array> naturally sorted by the keys
|
---|
194 | resulting from applying them C<CALC_KEY>.
|
---|
195 |
|
---|
196 | =item rnatkeysort { CALC_KEY($_) } @data
|
---|
197 |
|
---|
198 | is similar to C<natkeysort> but sorts the elements in descending
|
---|
199 | order.
|
---|
200 |
|
---|
201 | =item natsort_inplace @data
|
---|
202 |
|
---|
203 | =item rnatsort_inplace @data
|
---|
204 |
|
---|
205 | =item natkeysort_inplace { CALC_KEY($_) } @data
|
---|
206 |
|
---|
207 | =item rnatkeysort_inplace { CALC_KEY($_) } @data
|
---|
208 |
|
---|
209 | these functions are similar respectively to C<natsort>, C<rnatsort>,
|
---|
210 | C<natsortkey> and C<rnatsortkey>, but they sort the array C<@data> in
|
---|
211 | place.
|
---|
212 |
|
---|
213 | =item $key = mkkey_natural $string
|
---|
214 |
|
---|
215 | given C<$string>, returns a key that can be compared lexicographically
|
---|
216 | to another key obtained in the same manner, results in the same order
|
---|
217 | as comparing the former strings as in the natural order.
|
---|
218 |
|
---|
219 | If the argument C<$key> is not provided it defaults to C<$_>.
|
---|
220 |
|
---|
221 | =item natwfsort @data
|
---|
222 |
|
---|
223 | =item rnatwfsort @data
|
---|
224 |
|
---|
225 | =item natkeywfsort { CALC_KEY($_) } @data
|
---|
226 |
|
---|
227 | =item rnatkeywfsort { CALC_KEY($_) } @data
|
---|
228 |
|
---|
229 | =item natwfsort_inplace @data
|
---|
230 |
|
---|
231 | =item rnatwfsort_inplace @data
|
---|
232 |
|
---|
233 | =item natkeywfsort_inplace { CALC_KEY($_) } @data
|
---|
234 |
|
---|
235 | =item rnatkeywfsort_inplace { CALC_KEY($_) } @data
|
---|
236 |
|
---|
237 | =item mkkey_natural_with_floats $key
|
---|
238 |
|
---|
239 | this ugly named set of functions perform in the same way as its
|
---|
240 | s/natwf/nat/ counterpart with the difference that they honor floating
|
---|
241 | point numbers embeded inside the strings.
|
---|
242 |
|
---|
243 | In this context a floating point number is a string matching the
|
---|
244 | regular expression C</[+\-]?\d+(\.\d*)?/>. Note that numbers with an
|
---|
245 | exponent part (i.e. C<1.12E-12>) are not recognized as such.
|
---|
246 |
|
---|
247 | Note also that numbers without an integer part (i.e. C<.2> or C<-.12>)
|
---|
248 | are not supported either.
|
---|
249 |
|
---|
250 | =back
|
---|
251 |
|
---|
252 | =head1 SEE ALSO
|
---|
253 |
|
---|
254 | L<Sort::Key>, L<Sort::Key::Maker>.
|
---|
255 |
|
---|
256 | Other module providing similar functionality is L<Sort::Naturally>.
|
---|
257 |
|
---|
258 | =head1 COPYRIGHT AND LICENSE
|
---|
259 |
|
---|
260 | Copyright (C) 2006, 2012 by Salvador FandiE<ntilde>o,
|
---|
261 | E<lt>[email protected]<gt>.
|
---|
262 |
|
---|
263 | This library is free software; you can redistribute it and/or modify
|
---|
264 | it under the same terms as Perl itself, either Perl version 5.8.4 or,
|
---|
265 | at your option, any later version of Perl 5 you may have available.
|
---|
266 |
|
---|
267 | =cut
|
---|