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 =item -i, --ignore-non-existing-columns
  28
  29 =item -w, --warn-non-existing-columns
  30
  31 =item -c, --column I<NAME>
  32
  33 Repeatable option.
  34
  35 =back
  36
  37 =head1 SEE ALSO
  38
  39 td2mrkv(1)
  40
  41 =cut
  42
  43 $OptSeparatorRegexp = "\t";
  44 $OptMultilineGlue = "\n";
  45 $OptWarnBadColumnNames = 1;
  46 $OptFailBadColumnNames = 1;
  47 @OptPredefColumns = ();
  48 %OptionDefs = (
  49         's|separator=s' => \$OptSeparatorRegexp,
  50         'g|multiline-glue=s' => \$OptMultilineGlue,
  51         'i|ignore-non-existing-columns' => sub { $OptFailBadColumnNames = 0; $OptWarnBadColumnNames = 0; },
  52         'w|warn-non-existing-columns' => sub { $OptFailBadColumnNames = 0; $OptWarnBadColumnNames = 1; },
  53         'c|column=s@' => \@OptPredefColumns,
  54 );
  55
  56 use Data::Dumper;
  57 use List::MoreUtils qw/all any none/;
  58 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  59 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  60
  61
  62 sub flush_record
  63 {
  64         my $record = shift;
  65
  66         if(not $header_sent)
  67         {
  68                 print join($FS, map {escape_tabdata($_)} @Headers).$RS;
  69                 $header_sent = 1;
  70         }
  71
  72         print join($FS, map { escape_tabdata($record->{$_}) } @Headers).$RS;
  73 }
  74
  75 @Headers = ();
  76 %record = ();
  77 $record_num = 0;
  78 $header_sent = 0;
  79
  80 while(my $line = <STDIN>)
  81 {
  82         chomp $line;
  83         if($line eq '')
  84         {
  85                 if(not $header_sent)
  86                 {
  87                         for my $predef_column (@OptPredefColumns)
  88                         {
  89                                 if(not $predef_column ~~ @Headers)
  90                                 {
  91                                         push @Headers, $predef_column;
  92                                 }
  93                         }
  94                 }
  95
  96                 if(%record)
  97                 {
  98                         flush_record(\%record);
  99                         %record = ();
 100                         $record_num++;
 101                 }
 102         }
 103         else
 104         {
 105                 my ($field, $cell) = split /$OptSeparatorRegexp/, $line, 2;
 106                 if(exists $record{$field})
 107                 {
 108                         $record{$field} .= $OptMultilineGlue . $cell;
 109                 }
 110                 else
 111                 {
 112                         $record{$field} = $cell;
 113                 }
 114
 115                 if($record_num == 0)
 116                 {
 117                         push @Headers, $field;
 118                 }
 119                 else
 120                 {
 121                         if(not $field ~~ @Headers)
 122                         {
 123                                 unless($field ~~ @warned_fields)
 124                                 {
 125                                         warn "$0: column not defined: $field\n" if $OptWarnBadColumnNames;
 126                                         push @warned_fields, $field_name;
 127                                 }
 128                                 die if $OptFailBadColumnNames;
 129                         }
 130                 }
 131         }
 132 }
 133
 134 if(%record)
 135 {
 136         flush_record(\%record);
 137         %record = ();
 138         $record_num++;
 139 }