lib/sort.pm

   1 package sort;
   2
   3 our $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
  11 use strict;
  12
  13 sub 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
  34 sub 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
  53 sub current {
  54     my @sort;
  55     if ($^H{sort}) {
  56         push @sort, 'stable'    if $^H{sort} & $sort::stable_bit;
  57     }
  58     join(' ', @sort);
  59 }
  60
  61 1;
  62 __END__
  63
  64 =head1 NAME
  65
  66 sort - 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
  81 With the C<sort> pragma you can control the behaviour of the builtin
  82 C<sort()> function.
  83
  84 A stable sort means that for records that compare equal, the original
  85 input ordering is preserved.
  86 Stability will matter only if elements that compare equal can be
  87 distinguished in some other way.  That means that simple numerical
  88 and lexical sorts do not profit from stability, since equal elements
  89 are indistinguishable.  However, with a comparison such as
  90
  91    { substr($a, 0, 3) cmp substr($b, 0, 3) }
  92
  93 stability might matter because elements that compare equal on the
  94 first 3 characters may be distinguished based on subsequent characters.
  95
  96 Whether sorting is stable by default is an accident of implementation
  97 that can change (and has changed) between Perl versions.
  98 If stability is important, be sure to
  99 say so with a
 100
 101   use sort 'stable';
 102
 103 The C<no sort> pragma doesn't
 104 I<forbid> what follows, it just leaves the choice open.  Thus, after
 105
 106   no sort 'stable';
 107
 108 sorting may happen to be stable anyway.
 109
 110 =head1 CAVEATS
 111
 112 As of Perl 5.10, this pragma is lexically scoped and takes effect
 113 at compile time. In earlier versions its effect was global and took
 114 effect at run-time; the documentation suggested using C<eval()> to
 115 change 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
 128 Such code no longer has the desired effect, for two reasons.
 129 Firstly, the use of C<eval()> means that the sorting algorithm
 130 is not changed until runtime, by which time it's too late to
 131 have any effect. Secondly, C<sort::current> is also called at
 132 run-time, when in fact the compile-time value of C<sort::current>
 133 is the one that matters.
 134
 135 So 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