xref: /openbsd-src/gnu/usr.bin/perl/ext/B/t/f_sort (revision 5759b3d249badf144a6240f7eec4dcf9df003e6b)
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
27sub byage {
28    $age{$a} <=> $age{$b};  # presuming numeric
29}
30@sortedclass = sort byage @class;
31
32sub backwards { $b cmp $a }
33@harry  = qw(dog cat x Cain Abel);
34@george = qw(gone chased yz Punished Axed);
35print sort @harry;
36# prints AbelCaincatdogx
37print sort backwards @harry;
38# prints xdogcatCainAbel
39print 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] }
52sort { $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)
58package other;
59sub backwards ($$) { $_[1] cmp $_[0]; }     # $a and $b are not set here
60package main;
61@new = sort other::backwards @old;
62
63# repeat, condensed. $main::a and $b are unaffected
64sub other::backwards ($$) { $_[1] cmp $_[0]; }
65@new = sort other::backwards @old;
66
67# guarantee stability, regardless of algorithm
68use sort 'stable';
69@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
70
71# you should have a good reason to do this!
72@articles = sort {$FooPack::b <=> $FooPack::a} @files;
73
74# fancy
75@result = sort { $a <=> $b } grep { $_ == $_ } @input;
76
77# void return context sort
78sort { $a <=> $b } @input;
79
80# more void context, propagating ?
81sort { $a <=> $b } grep { $_ == $_ } @input;
82
83# scalar return context sort
84$s = sort { $a <=> $b } @input;
85
86$s = sort { $a <=> $b } grep { $_ == $_ } @input;
87
88