ext/Encode/bin/ucmsort

   1 #!/usr/local/bin/perl
   2 #
   3 # $Id: ucmsort,v 2.2 2006/05/03 18:24:10 dankogai Exp $
   4 #
   5 use strict;
   6 my @lines;
   7 my ($head, $tail);
   8 while (<>){
   9     unless (m/^<U/o){
  10         unless(@lines){
  11         $head .= $_;
  12     }else{
  13         $tail .= $_;
  14     }
  15     next;
  16     }
  17     chomp;
  18     my @words = split;
  19     my $u = shift @words;
  20     $u =~ s/^<U//o; $u =~ s/>.*//o;
  21     push @lines,[ $u, @words ];
  22 }
  23
  24 print $head;
  25 for (sort {
  26     hex($a->[0]) <=> hex($b->[0]) # Unicode descending order
  27     or $a->[2] cmp $b->[2] # fallback descending order
  28     or $a->[1] cmp $b->[1] # Encoding descending order
  29     }
  30      @lines) {
  31     my $u = shift @$_;
  32     print join(" " => "<U$u>", @$_), "\n";
  33 }
  34 print $tail;
  35 __END__