1package sort; 2 3our $VERSION = '2.04'; 4 5# The hints for pp_sort are now stored in $^H{sort}; older versions 6# of perl used the global variable $sort::hints. -- rjh 2005-12-19 7 8$sort::stable_bit = 0x00000100; 9$sort::unstable_bit = 0x00000200; 10 11use strict; 12 13sub import { 14 shift; 15 if (@_ == 0) { 16 require Carp; 17 Carp::croak("sort pragma requires arguments"); 18 } 19 local $_; 20 $^H{sort} //= 0; 21 while ($_ = shift(@_)) { 22 if ($_ eq 'stable') { 23 $^H{sort} |= $sort::stable_bit; 24 $^H{sort} &= ~$sort::unstable_bit; 25 } elsif ($_ eq 'defaults') { 26 $^H{sort} = 0; 27 } else { 28 require Carp; 29 Carp::croak("sort: unknown subpragma '$_'"); 30 } 31 } 32} 33 34sub unimport { 35 shift; 36 if (@_ == 0) { 37 require Carp; 38 Carp::croak("sort pragma requires arguments"); 39 } 40 local $_; 41 no warnings 'uninitialized'; # bitops would warn 42 while ($_ = shift(@_)) { 43 if ($_ eq 'stable') { 44 $^H{sort} &= ~$sort::stable_bit; 45 $^H{sort} |= $sort::unstable_bit; 46 } else { 47 require Carp; 48 Carp::croak("sort: unknown subpragma '$_'"); 49 } 50 } 51} 52 53sub current { 54 my @sort; 55 if ($^H{sort}) { 56 push @sort, 'stable' if $^H{sort} & $sort::stable_bit; 57 } 58 join(' ', @sort); 59} 60 611; 62__END__ 63 64=head1 NAME 65 66sort - perl pragma to control sort() behaviour 67 68=head1 SYNOPSIS 69 70 use sort 'stable'; # guarantee stability 71 use sort 'defaults'; # revert to default behavior 72 no sort 'stable'; # stability not important 73 74 my $current; 75 BEGIN { 76 $current = sort::current(); # identify prevailing pragmata 77 } 78 79=head1 DESCRIPTION 80 81With the C<sort> pragma you can control the behaviour of the builtin 82C<sort()> function. 83 84A stable sort means that for records that compare equal, the original 85input ordering is preserved. 86Stability will matter only if elements that compare equal can be 87distinguished in some other way. That means that simple numerical 88and lexical sorts do not profit from stability, since equal elements 89are indistinguishable. However, with a comparison such as 90 91 { substr($a, 0, 3) cmp substr($b, 0, 3) } 92 93stability might matter because elements that compare equal on the 94first 3 characters may be distinguished based on subsequent characters. 95 96Whether sorting is stable by default is an accident of implementation 97that can change (and has changed) between Perl versions. 98If stability is important, be sure to 99say so with a 100 101 use sort 'stable'; 102 103The C<no sort> pragma doesn't 104I<forbid> what follows, it just leaves the choice open. Thus, after 105 106 no sort 'stable'; 107 108sorting may happen to be stable anyway. 109 110=head1 CAVEATS 111 112As of Perl 5.10, this pragma is lexically scoped and takes effect 113at compile time. In earlier versions its effect was global and took 114effect at run-time; the documentation suggested using C<eval()> to 115change the behaviour: 116 117 { eval 'no sort "stable"'; # stability not wanted 118 print sort::current . "\n"; 119 @a = sort @b; 120 eval 'use sort "defaults"'; # clean up, for others 121 } 122 { eval 'use sort qw(defaults stable)'; # force stability 123 print sort::current . "\n"; 124 @c = sort @d; 125 eval 'use sort "defaults"'; # clean up, for others 126 } 127 128Such code no longer has the desired effect, for two reasons. 129Firstly, the use of C<eval()> means that the sorting algorithm 130is not changed until runtime, by which time it's too late to 131have any effect. Secondly, C<sort::current> is also called at 132run-time, when in fact the compile-time value of C<sort::current> 133is the one that matters. 134 135So now this code would be written: 136 137 { no sort "stable"; # stability not wanted 138 my $current; 139 BEGIN { $current = sort::current; } 140 print "$current\n"; 141 @a = sort @b; 142 # Pragmas go out of scope at the end of the block 143 } 144 { use sort qw(defaults stable); # force stability 145 my $current; 146 BEGIN { $current = sort::current; } 147 print "$current\n"; 148 @c = sort @d; 149 } 150 151=cut 152 153