tabdata/td-sort

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 td-sort - Sort tabular data by the columns given by name
   8
   9 =head1 USAGE
  10
  11 td-sort I<OPTIONS>
  12
  13 =head1 OPTIONS
  14
  15 All those which are accepted by sort(1),
  16 except you don't need to refer to columns by ordinal number,
  17 but by name.
  18
  19 =over 4
  20
  21 =item -k, --key=I<KEYDEF>
  22
  23 sort(1) defines I<KEYDEF> as C<F[.C][OPTS][,F[.C][OPTS]]>,
  24 where B<F> is the (1-based) field number.
  25 However with td-sort(1) you may refer to fields by name.
  26 But since B<F> is no longer consists only of digits,
  27 but is an arbitrary string,
  28 it's may be ambiguous where the name ends.
  29 So you may enclose them in round/square/curly/angle brackets.
  30 Choose the one which does not occur in the column name.
  31
  32 You don't need to even type B<-k>, because a lone I<COLUMN-NAME>
  33 is interpreted as "B<-k> I<F>" where I<F> is the corresponding field number.
  34
  35 =back
  36
  37 =head1 REFERENCES
  38
  39 td-sort(1) is analogous to SQL ORDER BY.
  40
  41 =cut
  42
  43 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  44 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  45 use Data::Dumper;
  46
  47
  48 sub replace_colnames_in_string
  49 {
  50         my $s = shift;
  51         $s =~ s/(\((?'name'[^)]+)\)|\[(?'name'[^]]+)\]|\{(?'name'[^}]+)\}|<(?'name'[^>]+)>|(?'name'[^.,]+))(?'rest'(\.\d+)?[^,]*)/replace_colname($+{'name'}).$+{'rest'}/eg;
  52         return $s;
  53 }
  54
  55 sub replace_colname
  56 {
  57         my $name = shift;
  58         my $colnum = $Header{$name};
  59         if(not defined $colnum)
  60         {
  61                 my $cols = join ", ", @Header;
  62                 die "$0: $name: no such column. known columns: $cols\n"
  63         }
  64         $colnum += 1;
  65         return $colnum;
  66 }
  67
  68
  69 $Header = sys_read_line();
  70 process_header($Header);
  71
  72
  73 @sort_args = ('--field-separator='.$FS,);
  74
  75
  76 while(@ARGV)
  77 {
  78         my $arg = shift @ARGV;
  79
  80         if($arg =~ /^(--key=)(.+)$/)
  81         {
  82                 $arg = $1.replace_colnames_in_string($2);
  83         }
  84         elsif($prev_arg ~~ ['-k', '--key'])
  85         {
  86                 $arg = replace_colnames_in_string($arg);
  87         }
  88         elsif($arg !~ /^-/)
  89         {
  90                 $arg = '--key=' . replace_colnames_in_string($arg);
  91         }
  92
  93         push @sort_args, $arg;
  94         $prev_arg = $arg;
  95 }
  96
  97 $|++;
  98 print $Header.$RS;
  99
 100 exec 'sort', @sort_args;
 101 ($errno, $errstr) = (int $!, $!);
 102 warn "sort: $errstr\n";
 103 exit 125+$errno;