tabdata/td2mrkv

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 td2mrkv - Transform tabular data into multi-record key-value (MRKV) format.
   8
   9 =head1 OPTIONS
  10
  11 =over 4
  12
  13 =item -s, --separator I<STR>
  14
  15 String to separate field name from content.
  16 Default is TAB (C<\t>).
  17
  18 =item -K, --sort-keys
  19
  20 Note, sorting by keys does not support duplicated column names.
  21
  22 =item -V, --sort-values
  23
  24 =back
  25
  26 =head1 EXAMPLE
  27
  28 getent passwd | tr : "\t" | td-add-headers USER PW UID GID GECOS HOME SHELL | td-select +ALL -PW | td2mrkv
  29
  30 =head1 SEE ALSO
  31
  32 mrkv2td(1), td2html(1)
  33
  34 =cut
  35
  36 $OptSeparator = "\t";
  37 $OptSortKeys = 0;
  38 $OptSortValues = 0;
  39 $OptCaseInsensitiveSort = 0;
  40 %OptionDefs = (
  41         's|separator=s' => \$OptSeparator,
  42         'K|sort-keys!' => \$OptSortKeys,
  43         'V|sort-values!' => \$OptSortValues,
  44         'I|case-insensitive-sort!' => \$OptCaseInsensitiveSort,
  45 );
  46
  47 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  48 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  49
  50 sub sortkey
  51 {
  52         return $OptCaseInsensitiveSort ? lc($_[0]) : $_[0];
  53 }
  54
  55 process_header(scalar <STDIN>);
  56
  57 @OrderedHeaders = do { my $pos = 0; map {{name=>$_, orig_idx=>$pos++}} @Header };
  58
  59 if($OptSortKeys)
  60 {
  61         @OrderedHeaders = sort { sortkey($a->{name}) cmp sortkey($b->{name}) } @OrderedHeaders;
  62 }
  63
  64 while(not eof STDIN)
  65 {
  66         my @Field = read_record(\*STDIN);
  67
  68         my @columns = @OrderedHeaders;
  69
  70         if($OptSortValues)
  71         {
  72                 @columns = sort { sortkey($Field[$a->{orig_idx}]) cmp sortkey($Field[$b->{orig_idx}]) } @OrderedHeaders;
  73         }
  74
  75         for my $col (@columns)
  76         {
  77                 printf "%s%s%s%s", $col->{name}, $OptSeparator, $Field[$col->{orig_idx}], $RS;
  78         }
  79
  80         print $RS;
  81 }