tabdata/mrkv2td

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 mrkv2td - Transform multi-record key-value (MRKV) stream to tabular data format.
   8
   9 =head1 DESCRIPTION
  10
  11 As tabular data format presents field names at the start of transmission,
  12 mrkv2td(1) infers them only from the first record,
  13 so no need to buffer the whole dataset to find all fields,
  14 and it's usual for all records to have all fields anyways.
  15
  16 =head1 OPTIONS
  17
  18 =over 4
  19
  20 =item -s, --separator I<REGEXP>
  21
  22 Regexp which separates field name from cell data in MRKV stream.
  23 Default is TAB (C<\t>).
  24
  25 =item -g, --multiline-glue I<STRING>
  26
  27 =back
  28
  29 =head1 SEE ALSO
  30
  31 td2mrkv(1)
  32
  33 =cut
  34
  35 $OptSeparatorRegexp = "\t";
  36 $OptMultilineGlue = "\n";
  37 %OptionDefs = (
  38         's|separator=s' => \$OptSeparatorRegexp,
  39         'g|multiline-glue=s' => \$OptMultilineGlue,
  40 );
  41
  42 use Data::Dumper;
  43 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  44 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  45
  46
  47 sub flush_record
  48 {
  49         my $colnum = shift;
  50         my $record = shift;
  51
  52         if(not $header_sent)
  53         {
  54                 print join($FS, map {escape_tabdata($_)} sort { $colnum->{$a} <=> $colnum->{$b} } keys %$colnum).$RS;
  55                 $header_sent = 1;
  56         }
  57
  58         print join($FS, map { escape_tabdata($record->{$_}) } sort { $colnum->{$a} <=> $colnum->{$b} } keys %$record).$RS;
  59 }
  60
  61 @Headers = ();
  62 %ColumnNumber = ();
  63 %record = ();
  64 $record_num = 0;
  65 $header_sent = 0;
  66
  67 while(my $line = <STDIN>)
  68 {
  69         chomp $line;
  70         if($line eq '')
  71         {
  72                 if(%record)
  73                 {
  74                         flush_record(\%ColumnNumber, \%record);
  75                         %record = ();
  76                         $record_num++;
  77                 }
  78         }
  79         else
  80         {
  81                 my ($field, $cell) = split /$OptSeparatorRegexp/, $line, 2;
  82                 if(exists $record{$field})
  83                 {
  84                         $record{$field} .= $OptMultilineGlue . $cell;
  85                 }
  86                 else
  87                 {
  88                         $record{$field} = $cell;
  89                 }
  90
  91                 if($record_num == 0)
  92                 {
  93                         push @Headers, $field;
  94                         $ColumnNumber{$field} = $#Headers;
  95                 }
  96         }
  97 }
  98
  99 if(%record)
 100 {
 101         flush_record(\%ColumnNumber, \%record);
 102 }