ext/B/t/f_sort

   1 #!perl
   2 #examples poached from perldoc -f sort
   3
   4 # sort lexically
   5 @articles = sort @files;
   6
   7 # same thing, but with explicit sort routine
   8 @articles = sort {$a cmp $b} @files;
   9
  10 # now case-insensitively
  11 @articles = sort {uc($a) cmp uc($b)} @files;
  12
  13 # same thing in reversed order
  14 @articles = sort {$b cmp $a} @files;
  15
  16 # sort numerically ascending
  17 @articles = sort {$a <=> $b} @files;
  18
  19 # sort numerically descending
  20 @articles = sort {$b <=> $a} @files;
  21
  22 # this sorts the %age hash by value instead of key
  23 # using an in-line function
  24 @eldest = sort { $age{$b} <=> $age{$a} } keys %age;
  25
  26 # sort using explicit subroutine name
  27 sub byage {
  28     $age{$a} <=> $age{$b};  # presuming numeric
  29 }
  30 @sortedclass = sort byage @class;
  31
  32 sub backwards { $b cmp $a }
  33 @harry  = qw(dog cat x Cain Abel);
  34 @george = qw(gone chased yz Punished Axed);
  35 print sort @harry;
  36 # prints AbelCaincatdogx
  37 print sort backwards @harry;
  38 # prints xdogcatCainAbel
  39 print sort @george, 'to', @harry;
  40 # prints AbelAxedCainPunishedcatchaseddoggonetoxyz
  41
  42 # inefficiently sort by descending numeric compare using
  43 # the first integer after the first = sign, or the
  44 # whole record case-insensitively otherwise
  45 @new = @old[ sort {
  46     $nums[$b] <=> $nums[$a]
  47         || $caps[$a] cmp $caps[$b]
  48         } 0..$#old  ];
  49
  50 # same thing, but without any temps
  51 @new = map { $_->[0] }
  52 sort { $b->[1] <=> $a->[1]
  53            || $a->[2] cmp $b->[2]
  54            } map { [$_, /=(\d+)/, uc($_)] } @old;
  55
  56 # using a prototype allows you to use any comparison subroutine
  57 # as a sort subroutine (including other package's subroutines)
  58 package other;
  59 sub backwards ($$) { $_[1] cmp $_[0]; }     # $a and $b are not set here
  60 package main;
  61 @new = sort other::backwards @old;
  62
  63 # repeat, condensed. $main::a and $b are unaffected
  64 sub other::backwards ($$) { $_[1] cmp $_[0]; }
  65 @new = sort other::backwards @old;
  66
  67 # guarantee stability, regardless of algorithm
  68 use sort 'stable';
  69 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
  70
  71 # force use of mergesort (not portable outside Perl 5.8)
  72 use sort '_mergesort';
  73 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
  74
  75 # you should have a good reason to do this!
  76 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
  77
  78 # fancy
  79 @result = sort { $a <=> $b } grep { $_ == $_ } @input;
  80
  81 # void return context sort
  82 sort { $a <=> $b } @input;
  83
  84 # more void context, propagating ?
  85 sort { $a <=> $b } grep { $_ == $_ } @input;
  86
  87 # scalar return context sort
  88 $s = sort { $a <=> $b } @input;
  89
  90 $s = sort { $a <=> $b } grep { $_ == $_ } @input;
  91