tabdata/kvpairs2td

   1 #!/usr/bin/env perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 kvpairs2td - Transform lines of key-value pairs to tabular data stream
   8
   9 =head1 OPTIONS
  10
  11 =over 4
  12
  13 =item -i, --ignore-non-existing-columns
  14
  15 =item -w, --warn-non-existing-columns
  16
  17 =item -c, --column I<COLUMN>
  18
  19 Indicate that there will be a column by the name I<COLUMN>.
  20 This is useful if the first record does not have I<COLUMN>.
  21 This option is repeatable.
  22
  23 =item -r, --restcolumn I<NAME>
  24
  25 Name of the column where the rest of the input line will be put
  26 which is not part of key-value pairs.
  27 Default is B<_REST>.
  28
  29 =back
  30
  31 =head1 SEE ALSO
  32
  33 td2mrkv(1), td2kvpairs(1)
  34
  35 =cut
  36
  37
  38 sub collapse_whitespace
  39 {
  40         my $s = shift;
  41         $s =~ s/\s+/ /g;
  42         return $s;
  43 }
  44
  45 $OptWarnBadColumnNames = 1;
  46 $OptFailBadColumnNames = 1;
  47 @OptPredefColumns = ();
  48 $OptRestColumnName = "_REST";
  49 %OptionDefs = (
  50         'i|ignore-non-existing-columns' => sub { $OptFailBadColumnNames = 0; $OptWarnBadColumnNames = 0; },
  51         'w|warn-non-existing-columns' => sub { $OptFailBadColumnNames = 0; $OptWarnBadColumnNames = 1; },
  52         'c|column=s@' => \@OptPredefColumns,
  53         'r|restcolumn=s' => \$OptRestColumnName,
  54 );
  55
  56 use Data::Dumper;
  57 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  58 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  59
  60 @Headers = ();
  61 $RN = 0;
  62 $rest_column_idx = undef;
  63
  64 while(my $line = <STDIN>)
  65 {
  66         chomp $line;
  67         my @record = ();
  68
  69         while($line =~ s/(^|(?'spacebefore'\s*))((?'keyquote'[""''])(?'key'.+?)\g{keyquote}|(?'key'[^\s=]+))=((?'valuequote'[""''])(?'value'.*?)\g{valuequote}|(?'value'\S*))((?'spaceafter'\s*)|$)/collapse_whitespace($+{'spacebefore'}.$+{'spaceafter'})/e)
  70         {
  71                 #warn Dumper \%+;
  72                 my ($key, $value) = ($+{'key'}, $+{'value'});
  73
  74                 if($RN == 0)
  75                 {
  76                         push @Headers, $key;
  77                 }
  78
  79                 my $cell_set = 0;
  80                 my $colinstances = 0;
  81                 for my $colidx (0 .. $#Headers)
  82                 {
  83                         if($Headers[$colidx] eq $key)
  84                         {
  85                                 $colinstances++;
  86                                 if(not defined $record[$colidx])
  87                                 {
  88                                         $record[$colidx] = $value;
  89                                         $cell_set = 1;
  90                                         last;
  91                                 }
  92                         }
  93                 }
  94
  95                 if(not $cell_set)
  96                 {
  97                         $colinstances++;
  98                         warn "$0: column (instance $colinstances) is not initialized: $key\n" if $OptWarnBadColumnNames;
  99                         exit 3 if $OptFailBadColumnNames;
 100                 }
 101         }
 102
 103         if($RN == 0)
 104         {
 105                 push @Headers, @OptPredefColumns, $OptRestColumnName;
 106                 $rest_column_idx = $#Headers;
 107                 print join($FS, @Headers).$RS;
 108         }
 109
 110         $record[$rest_column_idx] = $line;
 111
 112         print join($FS, @record).$RS;
 113
 114         $RN++;
 115 }