transpose_table

   1 #! /usr/bin/perl
   2 # transpose_table transposes tables, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2011 by Don Armstrong <don@donarmstrong.com>.
   6 # $Id: perl_script 1825 2011-01-02 01:53:43Z don $
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14
  15 =head1 NAME
  16
  17 transpose_table - Transposes a table
  18
  19 =head1 SYNOPSIS
  20
  21  [options]
  22
  23  Options:
  24   --tsv, -t tab separated value mode (Default)
  25   --ssv, -s space separated value mode
  26   --csv, -c comma separated value mode
  27   --bigfile,-b Big file; use disk
  28   --debug, -d debugging level (Default 0)
  29   --help, -h display this help
  30   --man, -m display manual
  31
  32 =head1 OPTIONS
  33
  34 =over
  35
  36 =item B<--debug, -d>
  37
  38 Debug verbosity. (Default 0)
  39
  40 =item B<--help, -h>
  41
  42 Display brief usage information.
  43
  44 =item B<--man, -m>
  45
  46 Display this manual.
  47
  48 =back
  49
  50 =head1 EXAMPLES
  51
  52
  53 =cut
  54
  55
  56 use vars qw($DEBUG);
  57
  58 use Fcntl qw(:seek);
  59
  60 use File::Temp qw(tempdir);
  61
  62 use MLDBM qw(DB_File Storable);
  63
  64 use Devel::Peek;
  65
  66 use List::Util qw(max);
  67
  68 my %options = (debug           => 0,
  69                help            => 0,
  70                man             => 0,
  71                bigfile         => 0,
  72                );
  73
  74 GetOptions(\%options,
  75            'tsv|t',
  76            'ssv|s',
  77            'csv|c',
  78            'bigfile',
  79            'debug|d+','help|h|?','man|m');
  80
  81 pod2usage() if $options{help};
  82 pod2usage({verbose=>2}) if $options{man};
  83
  84 $DEBUG = $options{debug};
  85
  86 my @USAGE_ERRORS;
  87 if (0 == grep {exists $options{$_}} qw(tsv ssv csv)) {
  88     $options{tsv} = 1
  89 }
  90 if (1 < grep {exists $options{$_}} qw(tsv ssv csv)) {
  91      push @USAGE_ERRORS,"You can only pass one of --tsv, --ssv, or --csv";
  92 }
  93
  94 if (not @ARGV) {
  95     # we'll use this as a special indicator to read stdin
  96     push @ARGV,undef;
  97 }
  98 if (@ARGV != 1) {
  99     push @USAGE_ERRORS,"Exactly one file must be specified";
 100 }
 101
 102 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 103
 104 my $sep_char = "\t";
 105 if ($options{csv}) {
 106     $sep_char = ',';
 107 }
 108 elsif ($options{ssv}) {
 109     $sep_char = ' ';
 110 }
 111
 112 my @row;
 113 for my $file (@ARGV) {
 114     my $in;
 115     if (not defined $file) {
 116         ...; # not supported yet; STDIN isn't seekable
 117         $in = \*STDIN;
 118         $file = "STDIN";
 119     }
 120     else {
 121         $in = IO::File->new($file,'r') or
 122             die "Unable to open $file for reading: $!";
 123     }
 124     my $out = \*STDOUT;
 125     my $first_time = 1;
 126     my $cur_row = 0;
 127     my $end;
 128     my $first_row_end;
 129     do {
 130         if (not defined $end) {
 131             $in->seek(0,SEEK_END);
 132             $end = $in->tell;
 133             $in->seek(0,SEEK_SET);
 134         }
 135
 136         # from the current position, advance to complete the next field
 137         my $next_field = advance_to_field($in,$sep_char);
 138
 139         # if we're at the end of the file, stop.
 140         if (not $first_time and
 141             $cur_row == 0) {
 142             print {$out} "\n";
 143         }
 144         elsif ($cur_row != 0) {
 145             print {$out} $sep_char;
 146         }
 147         # write it to the output file
 148         print {$out} $next_field;
 149         if ($in->eof) {
 150             # avoid writing out a newline if the file was totally empty to start with
 151             print {$out} "\n" if not $first_time;
 152             last;
 153         }
 154
 155         # if this is the first time through, store this position for
 156         # this row, then find the end of the row [field with a \n as a
 157         # terminator] and do the next loop; if we hit the end of the
 158         # file, we are no longer the first time through.
 159         $row[$cur_row] = $in->tell;
 160         if ($first_time) {
 161             print STDERR "\r$cur_row";
 162             $cur_row++;
 163             advance_to_field($in,"\n");
 164             $first_row_end = $in->tell if not defined $first_row_end;
 165             if ($in->eof()) {
 166                 $first_time = 0;
 167                 $in->seek($row[0],SEEK_SET);
 168                 $cur_row = 0;
 169             }
 170         }
 171         else {
 172             # otherwise, advance to the next row's position
 173             $cur_row = ($cur_row + 1) % @row;
 174             $in->seek($row[$cur_row],SEEK_SET);
 175         }
 176         if ($cur_row == 0) {
 177             print STDERR "\r".$in->tell."/$first_row_end";
 178         }
 179     } while (1);
 180     print STDERR "\n";
 181 }
 182
 183 sub advance_to_field {
 184     my ($fh,$sep) = @_;
 185
 186     my $escaped = 0;
 187     my $char;
 188     my $return;
 189     do {
 190         $char = $fh->getc();
 191         if ($char eq '"') {
 192             $escaped = $escaped ? 0 : 1;
 193         }
 194         if (not $escaped and ($char eq $sep or $char eq "\n")) {
 195             return $return;
 196         }
 197         $return .= $char;
 198     } while (1);
 199 }
 200
 201
 202 __END__