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