tabdata/td-trans-fixcol

   1 #!/usr/bin/env perl
   2
   3
   4 =pod
   5
   6 =head1 NAME
   7
   8 td-trans-fixcol - Transform a table-looking text, aligned to fixed columns by spaces, into tabular data.
   9
  10 =head1 DESCRIPTION
  11
  12 First line is the header consisting of the column names.
  13 Each field's text must start in the same terminal column as the column name.
  14
  15 =head1 OPTIONS
  16
  17 =over 4
  18
  19 =item -m, --min-column-spacing I<NUM>
  20
  21 Minimum spacing between columns.
  22 Default is 2.
  23 This allows the input data to have column names with single spaces.
  24
  25 =back
  26
  27 =head1 EXAMPLE
  28
  29   arp -n | td-trans-fixcol
  30
  31 =cut
  32
  33
  34 $OptShowHeader = 1;
  35 $OptMinColumnSpacing = 2;
  36 %OptionDefs = (
  37         'h|header' => sub { $OptShowHeader = 1; },
  38         'H|no-header' => sub { $OptShowHeader = 0; },
  39         'm|min-column-spacing=i' => \$OptMinColumnSpacing,
  40 );
  41
  42 no if ($] >= 5.018), 'warnings' => 'experimental::smartmatch';
  43 do '/usr/lib/tool/perl5/tabdata/common.pl' or die "$@";
  44
  45
  46 @Column = ();
  47 $chars_eaten = 0;
  48
  49 $headline = <STDIN>;
  50 chomp $headline;
  51 $headline =~ s/\s*$//;
  52 while($headline =~ /^(.+?)([ ]{$OptMinColumnSpacing,}|$)/)
  53 {
  54         my ($colname, $spaces) = ($1, $2);
  55         my $width = length($colname.$spaces);
  56         push @Column, {
  57                 name => $colname,
  58                 start => $chars_eaten,
  59                 width => $width,
  60         };
  61         $chars_eaten += $width;
  62         $headline = $';
  63 }
  64
  65 # last column is undefinitely wide
  66 $Column[$#Column]->{width} = undef if scalar @Column;
  67
  68
  69 if($OptShowHeader and @Column)
  70 {
  71         print join($FS, map {$_->{name}} @Column).$RS;
  72 }
  73
  74 while(my $line = <STDIN>)
  75 {
  76         chomp $line;
  77         my @Fields = ();
  78
  79         for my $idx (0..$#Column)
  80         {
  81                 my $field = substr $line, $Column[$idx]->{start}, $Column[$idx]->{width} || length $line;
  82                 $field =~ s/\s*$//;
  83                 push @Fields, $field;
  84         }
  85
  86         print join($FS, @Fields).$RS;
  87 }