added a null_empty_lcolumns function too
[migration-tools.git] / text / csvcat
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Getopt::Long;
5
6 my $help;
7 my $headers = 1;
8 my $sourcecolumn = 1;
9 my $sourcetype = 'partial';
10 my $first_headers;
11 my $use_tab = 1;
12 my $use_comma = 0;
13
14 GetOptions(
15     'headers!' => \$headers,
16     'source!' => \$sourcecolumn,
17     'source-type=s' => \$sourcetype,
18     'use-tab' => \$use_tab,
19     'use-comma' => \$use_comma,
20     'help|?' => \$help
21 );
22 if ($use_comma) {
23     $use_tab = 0;
24 }
25 if ($help || @ARGV == 0 || ($sourcetype ne 'partial' && $sourcetype ne 'full')) {
26     print "$0 <--headers|--noheaders> <--source|--nosource> <--source-type=full|--source-type=partial> <--use-tab|--use-comma> [file1] [file2] <fileN...>\n";
27     exit 0;
28 }
29
30 sub munged_source {
31     my $fn = shift;
32     my $s = $fn;
33     if ($sourcetype eq 'partial') {
34         my @f = split(/\//, $fn);
35         $s = $f[0];
36     }
37     return "$s" . ($use_tab ? "\t" : ',');
38 }
39
40 sub cat_file {
41     my $fn = shift;
42     open FILE, "$fn";
43     if ($headers) {
44         if ($fn ne $ARGV[0]) {
45             my $check = <FILE>; # check and throw away headers for subsequent files
46             if ($check ne $first_headers) {
47                 print STDERR "Mismatched headers between $ARGV[0] and $fn\n";
48                 print STDERR "$first_headers\n$check\n";
49                 exit 1;
50             }
51         } else {
52             print "x_source" . ($use_tab ? "\t" : ',') if $sourcecolumn; # potential column header
53             $first_headers = <FILE>;
54             print $first_headers;
55         }
56     }
57     while (my $line = <FILE>) {
58         print munged_source($fn) if $sourcecolumn;
59         print $line;
60     }
61     close FILE;
62 }
63
64 my @files = @ARGV;
65 foreach my $file (@files) {
66     cat_file($file);
67 }
68
69
70
71