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 Do not fail when encounters a new field after the first record.
  16
  17 =item -w, --warn-non-existing-columns
  18
  19 =item -c, --column I<COLUMN>
  20
  21 Indicate that there will be a column by the name I<COLUMN>.
  22 This is useful if the first record does not have I<COLUMN>.
  23 This option is repeatable.
  24
  25 =item -r, --restcolumn I<NAME>
  26
  27 Name of the column where the rest of the input line will be put
  28 which is not part of key-value pairs.
  29 Default is B<_REST>.
  30
  31 =item -u, --unknown-to-rest
  32
  33 Put unknown (non-existing) fields in the "rest" column
  34 (see B<-r> option).
  35
  36 =back
  37
  38 =head1 SEE ALSO
  39
  40 td2mrkv(1), td2kvpairs(1)
  41
  42 =cut
  43
  44
  45 $OptWarnBadColumnNames = 1;
  46 $OptFailBadColumnNames = 1;
  47 @OptPredefColumns = ();
  48 $OptRestColumnName = "_REST";
  49 $OptUnknownToRest = 0;
  50 %OptionDefs = (
  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         'r|restcolumn=s' => \$OptRestColumnName,
  55         'u|unknown-to-rest' => \$OptUnknownToRest,
  56 );
  57
  58 use Data::Dumper;
  59 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  60 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  61
  62 @Headers = ();
  63 $RN = 0;
  64 $rest_column_idx = undef;
  65
  66 while(my $Line = <STDIN>)
  67 {
  68         chomp $Line;
  69         my @record = ();
  70         my $Rest = '';
  71
  72         while($Line =~ /(^|(?'spacebefore'\s*))((?'keyquote'[""''])(?'key'.+?)\g{keyquote}|(?'key'[^\s=]+))=((?'valuequote'[""''])(?'value'.*?)\g{valuequote}|(?'value'\S*))((?'spaceafter'\s*)|$)/)
  73         {
  74                 #warn Dumper [$`, \%+, $'];
  75                 $Rest .= $` . $+{'spacebefore'};
  76                 $Line = $';
  77                 my ($key, $value) = (kvpair_unescape($+{'key'}), kvpair_unescape($+{'value'}));
  78                 my $spaceafter = $+{'spaceafter'};
  79
  80                 if($RN == 0)
  81                 {
  82                         push @Headers, $key;
  83                 }
  84
  85                 my $cell_set = 0;
  86                 my $colinstances = 0;
  87                 for my $colidx (0 .. $#Headers)
  88                 {
  89                         if($Headers[$colidx] eq $key)
  90                         {
  91                                 $colinstances++;
  92                                 if(not defined $record[$colidx])
  93                                 {
  94                                         $record[$colidx] = $value;
  95                                         $cell_set = 1;
  96                                         last;
  97                                 }
  98                         }
  99                 }
 100
 101                 if(not $cell_set)
 102                 {
 103                         $colinstances++;
 104                         warn "$0: column (instance $colinstances) is not initialized: $key\n" if $OptWarnBadColumnNames;
 105                         if($OptUnknownToRest)
 106                         {
 107                                 $Rest .= kvpair_escape($key) . '=' . kvpair_escape($value) . $spaceafter;
 108                         }
 109                         else
 110                         {
 111                                 exit 3 if $OptFailBadColumnNames;
 112                         }
 113                 }
 114         }
 115
 116         if($RN == 0)
 117         {
 118                 push @Headers, @OptPredefColumns, $OptRestColumnName;
 119                 $rest_column_idx = $#Headers;
 120                 print join($FS, @Headers).$RS;
 121         }
 122
 123         $record[$rest_column_idx] = $Rest . $Line;
 124
 125         print join($FS, map {escape_tabdata($_)} @record) . $RS;
 126
 127         $RN++;
 128 }