8310010a5e091ffa0c867a3cb05f2b178ff5385f
[Text-CSV_XS.git] / examples / csv-check
1 #!/pro/bin/perl
2
3 # csv-check: Check validity of CSV file and report
4 #          (m)'13 [10 Jul 2013] Copyright H.M.Brand 2007-2014
5
6 # This code requires the defined-or feature and PerlIO
7
8 use strict;
9 use warnings;
10
11 use Data::Peek;
12 use Encode qw( decode );
13
14 our $VERSION = "1.6";   # 2013-07-10
15
16 sub usage
17 {
18     my $err = shift and select STDERR;
19     print <<EOU;
20 usage: csv-check [-s <sep>] [-q <quot>] [-e <esc>] [-u] [--pp] [file.csv]
21        -s <sep>   use <sep>   as seperator char. Auto-detect, default = ','
22                   The string "tab" is allowed.
23        -e <esc>   use <sep>   as seperator char. Auto-detect, default = ','
24                   The string "undef" is allowed.
25        -q <quot>  use <quot>  as quotation char. Default = '"'
26                   The string "undef" will disable quotation.
27        -u         check if all fields are valid unicode
28
29        --pp       use Text::CSV_PP instead (cross-check)
30 EOU
31     exit $err;
32     } # usage
33
34 use Getopt::Long qw(:config bundling nopermute passthrough);
35 my $sep;        # Set after reading first line in a flurry attempt to auto-detect
36 my $quo = '"';
37 my $esc = '"';
38 my $opt_u = 0;
39 my $opt_p = 0;
40 GetOptions (
41     "help|?"    => sub { usage (0); },
42
43     "c|s=s"     => \$sep,
44     "q=s"       => \$quo,
45     "e=s"       => \$esc,
46     "u"         => \$opt_u,
47
48     "pp!"       => \$opt_p,
49     ) or usage (1);
50
51 my  $csvmod = "Text::CSV_XS";
52 if ($opt_p) {
53     require Text::CSV_PP;
54     $csvmod = "Text::CSV_PP";
55     }
56 else {
57     require Text::CSV_XS;
58     }
59 $csvmod->import ();
60
61 my $fn = defined $ARGV[0] ? $ARGV[0] : "-";
62 my $data = do { local $/; <> } or die "No data to analyze\n";
63
64 my ($bin, $rows, $eol, %cols) = (0, 0, undef);
65 unless ($sep) { # No sep char passed, try to auto-detect;
66     $sep = $data =~ m/["\d],["\d,]/ ? ","  :
67            $data =~ m/["\d];["\d;]/ ? ";"  :
68            $data =~ m/["\d]\t["\d]/ ? "\t" :
69            # If neither, then for unquoted strings
70            $data =~ m/\w,[\w,]/     ? ","  :
71            $data =~ m/\w;[\w;]/     ? ";"  :
72            $data =~ m/\w\t[\w]/     ? "\t" : ",";
73     $data =~ m/([\r\n]+)\Z/ and $eol = DDisplay "$1";
74     }
75
76 my $csv = $csvmod->new ({
77     sep_char       => $sep eq "tab"   ? "\t"  : $sep,
78     quote_char     => $quo eq "undef" ? undef : $quo,
79     escape_char    => $esc eq "undef" ? undef : $esc,
80     binary         => 1,
81     keep_meta_info => 1,
82     auto_diag      => 1,
83     });
84
85 sub done
86 {
87     (my $file = defined $ARGV ? $ARGV : "") =~ s{(\S)$}{$1 };
88     (my $prog = $0) =~ s{.*/}{};
89     print "Checked $file with $prog $VERSION using $csvmod @{[$csvmod->VERSION]}\n";
90     my @diag = $csv->error_diag;
91     if ($diag[0] == 2012 && $csv->eof) {
92         my @coll = sort { $a <=> $b } keys %cols;
93         local $" = ", ";
94         my $cols = @coll == 1 ? $coll[0] : "(@coll)";
95         defined $eol or $eol = $csv->eol || "--unknown--";
96         print "OK: rows: $rows, columns: $cols\n";
97         print "    sep = <$sep>, quo = <$quo>, bin = <$bin>, eol = <$eol>\n";
98         if (@coll > 1) {
99             print "WARN: multiple column lengths:\n";
100             printf " %6d line%s with %4d field%s\n",
101                 $cols{$_}, $cols{$_} == 1 ? " " : "s",
102                 $_,        $_        == 1 ? ""  : "s"
103                     for @coll;
104             }
105         exit 0;
106         }
107
108     if ($diag[2]) {
109         print "$ARGV record $diag[3] at line $./$diag[2] - $diag[0] - $diag[1]\n";
110         my $ep  = $diag[2] - 1; # diag[2] is 1-based
111         my $err = $csv->error_input . "         ";
112         substr $err, $ep + 1, 0, "*";
113         substr $err, $ep,     0, "*";
114         ($err = substr $err, $ep - 5, 12) =~ s/ +$//;
115         print "    |$err|\n";
116         }
117     else {
118         print "$ARGV line $. - $diag[1]\n";
119         }
120     exit $diag[0];
121     } # done
122
123 sub stats
124 {
125     my $r = shift;
126     $cols{scalar @$r}++;
127     grep { $_ & 0x0002 } $csv->meta_info and $bin = 1;
128     if ($opt_u) {
129         my @r = @$r;
130         foreach my $x (0 .. $#r) {
131             utf8::is_utf8 ($r[$x]) and next;
132
133             local $SIG{__WARN__} = sub {
134                 (my $msg = shift) =~ s{ at /\S+Encode.pm.*}{};
135                 printf STDERR "Field %3d:%3d - '%s'\t- %s",
136                     $rows, $x, DPeek ($r[$x]), $msg;
137                 };
138             my $oct = decode ("utf-8", $r[$x], Encode::FB_WARN);
139             }
140         }
141     } # stats
142
143 open my $fh, "<", \$data or die "$fn: $!\n";
144 while (my $row = $csv->getline ($fh)) {
145     $rows++;
146     stats $row;
147     }
148 done;