tabdata/td-select

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 td-select - Show only the specified columns from the input tabular data stream.
   8
   9 =head1 USAGE
  10
  11 td-select [I<OPTIONS>] [--] [-]I<COLUMN> [[-]I<COLUMN> [...]]
  12
  13 =head1 OPTIONS
  14
  15 =over 4
  16
  17 =item -H, --no--header
  18
  19 do not show headers
  20
  21 =item -h, --header
  22
  23 show headers (default)
  24
  25 =item -i, --ignore-non-existing-columns
  26
  27 do not treat non-existing (missing or typo) column names as failure
  28
  29 =item -w, --warn-non-existing-columns
  30
  31 only show warning on non-existing (missing or typo) column names, but
  32 don't fail
  33
  34 =item --strict-columns
  35
  36 warn and fail on non-existing (missing or typo) column names given in
  37 parameters, even if it's prefixed with hyphen, ie. when the user want to
  38 remove the named column from the output.
  39
  40 =back
  41
  42 =head1 DESCRIPTION
  43
  44 I<COLUMN> is either a column name,
  45 or one of these special keywords:
  46
  47 =over 4
  48
  49 =item +ALL
  50
  51 all columns
  52
  53 =item +REST
  54
  55 the rest of columns not given yet in the parameter list
  56
  57 =back
  58
  59 I<COLUMN> is optionally prefixed with minus (C<->),
  60 in which case the given column will not be shown,
  61 ie. removed from the shown columns.
  62
  63 So if you want to show all columns except one or two:
  64
  65   td-select +ALL -PASSWD
  66
  67 If you want to put a given column (say "KEY") to the first place and left others intact:
  68
  69   td-select KEY +REST
  70
  71 =head1 EXAMPLE
  72
  73   ls -l | td-trans-ls | td-select -- NAME +REST -INODE -LINKS -MAJOR -MINOR
  74
  75 =head1 REFERENCES
  76
  77 "Select" in td-select comes from SQL.
  78 Similarly to SQL, td-select(1) is to choose some of the columns and return them in the given order.
  79
  80 =cut
  81
  82 $OptShowHeader = 1;
  83 $OptWarnBadColumnNames = 1;
  84 $OptFailBadColumnNames = 1;
  85 $OptFailBadNegativeColumnNames = 0;
  86 %OptionDefs = (
  87         'h|header' => sub { $OptShowHeader = 1; },
  88         'H|no-header' => sub { $OptShowHeader = 0; },
  89         'i|ignore-non-existing-columns' => sub { $OptFailBadColumnNames = 0; $OptWarnBadColumnNames = 0; },
  90         'w|warn-non-existing-columns' => sub { $OptFailBadColumnNames = 0; $OptWarnBadColumnNames = 1; },
  91         'strict-columns' => sub { $OptWarnBadColumnNames = 1; $OptFailBadColumnNames = 1; $OptFailBadNegativeColumnNames = 1; },
  92 );
  93
  94 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  95 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  96
  97 process_header(scalar <STDIN>);
  98
  99 @Columns = ();
 100
 101 while(@ARGV)
 102 {
 103         my $arg = shift @ARGV;
 104
 105         if($arg =~ /^--/)
 106         {
 107                 die "$0: unknown parameter: $arg\n";
 108         }
 109         elsif($arg =~ /^-(.+)$/)
 110         {
 111                 my $except_column = $1;
 112                 if(not exists $Header{$except_column})
 113                 {
 114                         my $cols = join ", ", @Header;
 115                         warn "$0: $except_column: no such column. known columns: $cols\n" if $OptWarnBadColumnNames;
 116                         exit 3 if $OptFailBadNegativeColumnNames;
 117                 }
 118                 @Columns = grep {$_ ne $except_column} @Columns;
 119         }
 120         elsif($arg eq '+ALL')
 121         {
 122                 push @Columns, @Header;
 123         }
 124         elsif($arg eq '+REST')
 125         {
 126                 push @Columns, grep {not $_ ~~ @Columns} @Header;
 127         }
 128         elsif($arg =~ /^(.+)$/)
 129         {
 130                 my $colname = $1;
 131                 if(not exists $Header{$colname})
 132                 {
 133                         my $cols = join ", ", @Header;
 134                         warn "$0: $colname: no such column. known columns: $cols\n" if $OptWarnBadColumnNames;
 135                         exit 3 if $OptFailBadColumnNames;
 136                 }
 137                 push @Columns, $colname;
 138         }
 139         else
 140         {
 141                 die "$0: unknown parameter: $arg\n";
 142         }
 143 }
 144
 145 # display selected headers
 146 if($OptShowHeader and @Columns)
 147 {
 148         @Output = ();
 149         for my $col (@Columns)
 150         {
 151                 push @Output, defined $Header{$col} ? $Header[$Header{$col}] : '';
 152         }
 153         print join($FS, @Output).$RS;
 154 }
 155
 156
 157 # display selected data fields
 158 while(not eof STDIN)
 159 {
 160         my @Input = read_record(\*STDIN);
 161
 162         @Output = ();
 163
 164         for my $col (@Columns)
 165         {
 166                 push @Output, defined $Header{$col} ? $Input[$Header{$col}] : '';
 167         }
 168
 169         print join($FS, @Output).$RS;
 170 }