doc update for sep
[Text-CSV_XS.git] / examples / csv2xls
1 #!/pro/bin/perl
2
3 # csv2xls: Convert csv to xls
4 #          (m)'14 [20 May 2014] Copyright H.M.Brand 2007-2014
5
6 use strict;
7 use warnings;
8
9 our $VERSION = "1.73";
10
11 sub usage
12 {
13     my $err = shift and select STDERR;
14     print <<EOU;
15 usage: csv2xls [-s <sep>] [-q <quot>] [-w <width>] [-d <dtfmt>]
16                [-o <xls>] [file.csv]
17        -s <sep>   use <sep>   as seperator char, auto-detect, default = ','
18                   The string "tab" is allowed.
19        -e <esc>   use <esc>   as escape    char, auto-detect, default = '"'
20                   The string "undef" is allowed.
21        -q <quot>  use <quot>  as quotation char,              default = '"'
22                   The string "undef" will disable quotation.
23        -w <width> use <width> as default minimum column width default = 4
24        -o <xls>   write output to file named <xls>, defaults
25                   to input file name with .csv replaced with .xls
26                   if from standard input, defaults to csv2xls.xls
27        -F         allow formula's. Otherwise fields starting with
28                   an equal sign are forced to string
29        -f         force usage of <xls> if already exists (unlink before use)
30        -d <dtfmt> use <dtfmt> as date formats.   Default = 'dd-mm-yyyy'
31        -C <C:fmt> use <fmt> as currency formats for currency <C>, no default
32        -D cols    only convert dates in columns <cols>. Default is everywhere.
33        -u         CSV is UTF8
34        -v [<lvl>] verbosity (default = 1)
35 EOU
36     exit $err;
37     } # usage
38
39 use Getopt::Long qw(:config bundling nopermute passthrough);
40 my $sep;        # Set after reading first line in a flurry attempt to auto-detect
41 my $quo = '"';
42 my $esc = '"';
43 my $wdt = 4;    # Default minimal column width
44 my $xls;        # Excel out file name
45 my $frc = 0;    # Force use of file
46 my $utf = 0;    # Data is encoded in Unicode
47 my $frm = 0;    # Allow formula's
48 my $dtf = "dd-mm-yyyy"; # Date format
49 my $crf = "";   # Currency format, e.g.: $:### ### ##0.00
50 my $opt_v = 1;
51 my $dtc;
52
53 GetOptions (
54     "help|?"    => sub { usage (0); },
55
56     "c|s=s"     => \$sep,
57     "q=s"       => \$quo,
58     "e=s"       => \$esc,
59     "w=i"       => \$wdt,
60     "o|x=s"     => \$xls,
61     "d=s"       => \$dtf,
62     "D=s"       => \$dtc,
63     "C=s"       => \$crf,
64     "f"         => \$frc,
65     "F"         => \$frm,
66     "u"         => \$utf,
67     "v:1"       => \$opt_v,
68     ) or usage (1);
69
70 my $title = @ARGV && -f $ARGV[0] ? $ARGV[0] : "csv2xls";
71 ($xls ||= $title) =~ s/(?:\.csv)?$/.xls/i;
72
73 -s $xls && $frc and unlink $xls;
74 if (-s $xls) {
75     print STDERR "File '$xls' already exists. Overwrite? [y/N] > N\b";
76     scalar <STDIN> =~ m/^[yj](es|a)?$/i or exit;
77     }
78
79 # Don't split ourselves when modules do it _much_ better, and follow the standards
80 use Text::CSV_XS;
81 use Date::Calc qw( Delta_Days Days_in_Month );
82 use Spreadsheet::WriteExcel;
83 use Encode qw( from_to );
84
85 my $wbk = Spreadsheet::WriteExcel->new ($xls);
86 my $wks = $wbk->add_worksheet ();
87    $dtf =~ s/j/y/g;
88 my %fmt = (
89     date        => $wbk->add_format (
90         num_format      => $dtf,
91         align           => "center",
92         ),
93
94     rest        => $wbk->add_format (
95         align           => "left",
96         ),
97     );
98 $crf =~ s/^([^:]+):(.*)/$1/ and $fmt{currency} = $wbk->add_format (
99     num_format  => "$1 $2",
100     align       => "right",
101     );
102
103 my ($h, $w, @w) = (0, 1); # data height, -width, and default column widths
104 my $row;
105 my $firstline;
106 unless ($sep) { # No sep char passed, try to auto-detect;
107     while (<>) {
108         m/\S/ or next;  # Skip empty leading blank lines
109         $sep = # start auto-detect with quoted strings
110                m/["\d];["\d;]/  ? ";"  :
111                m/["\d],["\d,]/  ? ","  :
112                m/["\d]\t["\d,]/ ? "\t" :
113                # If neither, then for unquoted strings
114                m/\w;[\w;]/      ? ";"  :
115                m/\w,[\w,]/      ? ","  :
116                m/\w\t[\w,]/     ? "\t" :
117                                   ";"  ;
118             # Yeah I know it should be a ',' (hence Csv), but the majority
119             # of the csv files to be shown comes from fucking Micky$hit,
120             # that uses semiColon ';' instead.
121         $firstline = $_;
122         last;
123         }
124     }
125 my $csv = Text::CSV_XS-> new ({
126     sep_char       => $sep eq "tab"   ? "\t"  : $sep,
127     quote_char     => $quo eq "undef" ? undef : $quo,
128     escape_char    => $esc eq "undef" ? undef : $esc,
129     binary         => 1,
130     keep_meta_info => 1,
131     auto_diag      => 1,
132     });
133 if ($firstline) {
134     $csv->parse ($firstline) or die $csv->error_diag ();
135     $row = [ $csv->fields ];
136     }
137 if ($opt_v > 3) {
138     foreach my $k (qw( sep_char quote_char escape_char )) {
139         my $c = $csv->$k () || "undef";
140         $c =~ s/\t/\\t/g;
141         $c =~ s/\r/\\r/g;
142         $c =~ s/\n/\\n/g;
143         $c =~ s/\0/\\0/g;
144         $c =~ s/([\x00-\x1f\x7f-\xff])/sprintf"\\x{%02x}",ord$1/ge;
145         printf STDERR "%-11s = %s\n", $k, $c;
146         }
147     }
148
149 if (my $rows = $dtc) {
150     $rows =~ s/-$/-999/;                        # 3,6-
151     $rows =~ s/-/../g;
152     eval "\$dtc = { map { \$_ => 1 } $rows }";
153     }
154
155 while ($row && @$row or $row = $csv->getline (*ARGV)) {
156     my @row = @$row;
157     @row > $w and push @w, ($wdt) x (($w = @row) - @w);
158     foreach my $c (0 .. $#row) {
159         my $val = defined $row[$c] ? $row[$c] : "";
160         my $l = length $val;
161         $l > $w[$c] and $w[$c] = $l;
162
163         if ($utf and $csv->is_binary ($c)) {
164             from_to ($val, "utf-8", "ucs2");
165             $wks->write_unicode ($h, $c, $val);
166             next;
167             }
168
169         if ($csv->is_quoted ($c)) {
170             if ($utf) {
171                 from_to ($val, "utf-8", "ucs2");
172                 $wks->write_unicode ($h, $c, $val);
173                 }
174             else {
175                 $wks->write_string  ($h, $c, $val);
176                 }
177             next;
178             }
179
180         if (!$dtc or $dtc->{$c + 1}) {
181             my @d = (0, 0, 0);  # Y, M, D
182             $val =~ m/^(\d{4})(\d{2})(\d{2})$/   and @d = ($1, $2, $3);
183             $val =~ m/^(\d{2})-(\d{2})-(\d{4})$/ and @d = ($3, $2, $1);
184             if ( $d[2] >=    1 && $d[2] <=   31 &&
185                  $d[1] >=    1 && $d[1] <=   12 &&
186                  $d[0] >= 1900 && $d[0] <= 2199) {
187                 my $dm = Days_in_Month (@d[0,1]);
188                 $d[2] <   1 and $d[2] = 1;
189                 $d[2] > $dm and $d[2] = $dm;
190                 my $dt = 2 + Delta_Days (1900, 1, 1, @d);
191                 $wks->write ($h, $c, $dt, $fmt{date});
192                 next;
193                 }
194             }
195         if ($crf and $val =~ m/^\s*\Q$crf\E\s*([0-9.]+)$/) {
196             $wks->write ($h, $c, $1 + 0, $fmt{currency});
197             next;
198             }
199
200         if (!$frm && $val =~ m/^=/) {
201             $wks->write_string  ($h, $c, $val);
202             }
203         else {
204             $wks->write ($h, $c, $val);
205             }
206         }
207     ++$h % 100 or $opt_v && printf STDERR "%6d x %6d\r", $w, $h;
208     } continue { $row = undef }
209 $opt_v && printf STDERR "%6d x %6d\n", $w, $h;
210
211 $wks->set_column ($_, $_, $w[$_]) for 0 .. $#w;
212 $wbk->close ();