more release testing
[Text-CSV_XS.git] / examples / csvdiff
1 #!/pro/bin/perl
2
3 use strict;
4 use warnings;
5
6 sub usage
7 {
8     my $err = shift and select STDERR;
9     print "usage: csvdiff [--no-color] [--html] file.csv file.csv\n",
10         "  provides colorized diff on sorted CSV files\n",
11         "  assuming first line is header and first field is the key\n";
12     exit $err;
13     } # usage
14
15 use Getopt::Long qw(:config bundling nopermute );
16 my $opt_c = 1;
17 my $opt_h = 0;
18 my $opt_o = "";
19 GetOptions (
20     "help|?"            => sub { usage (0); },
21
22     "c|color|colour!"   => \$opt_c,
23     "h|html"            => \$opt_h,
24
25     "o|output=s"        => \$opt_o,
26     ) or usage (1);
27
28 @ARGV == 2 or usage (1);
29
30 if ($opt_o) {
31     open STDOUT, ">", $opt_o or die "$opt_o: $!\n";
32     }
33
34 use HTML::Entities;
35 use Term::ANSIColor qw(:constants);
36 use Text::CSV_XS;
37 my $csv = Text::CSV_XS->new ({ binary => 1, auto_diag => 0 });
38
39 if ($opt_h) {
40     binmode STDOUT, ":encoding(utf-8)";
41     print <<EOH;
42 <?xml version="1.0" encoding="utf-8"?>
43 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
44 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
45 <head>
46   <title>CFI School updates</title>
47   <meta name="Generator"     content="perl $]" />
48   <meta name="Author"        content="@{[scalar getpwuid $<]}" />
49   <meta name="Description"   content="CSV diff @ARGV" />
50   <style type="text/css">
51     .rd { background:   #ffe0e0;        }
52     .gr { background:   #e0ffe0;        }
53     .hd { background:   #e0e0ff;        }
54     .b0 { background:   #e0e0e0;        }
55     .b1 { background:   #f0f0f0;        }
56     .r  { color:        red;            }
57     .g  { color:        green;          }
58     </style>
59   </head>
60 <body>
61
62 <h1>CSV diff @ARGV</h1>
63
64 <table>
65 EOH
66     $::{RED}    = sub { "\cA\rr";       };
67     $::{GREEN}  = sub { "\cA\rg";       };
68     $::{RESET}  = sub { "";             };
69     }
70 elsif (!$opt_c) {
71     $::{$_} = sub { "" } for qw( RED GREEN RESET );
72     }
73
74 my @f;
75 my $opt_n = 1;
76 foreach my $x (0, 1) {
77     open my $fh, "<", $ARGV[$x] or die "$ARGV[$x]: $!\n";
78     my $n = 0;
79     while (1) {
80         my $row = $csv->getline ($fh) or last;
81         @$row and push @{$f[$x]}, $row;
82         $n++ && $row->[0] =~ m/\D/ and $opt_n = 0;
83         }
84     }
85 my @n   = map { $#{$f[$_]} } 0, 1;
86 my @i   = (1, 1);
87 my $hdr = "# csvdiff   < $ARGV[0]    > $ARGV[1]\n";
88
89 $f[$_][1+$n[$_]][0] = $opt_n ? 2147483647 : "\xff\xff\xff\xff" for 0, 1;
90
91 my %cls;
92    %cls = (
93     "b" => 0,
94     "-" => sub { "rd" },
95     "+" => sub { "gr" },
96     "H" => sub { "hd" },
97     "<" => sub { $cls{b} ^= 1; "b$cls{b}" },
98     ">" => sub { "b$cls{b}" },
99     );
100
101 sub show
102 {
103     my ($pfx, $x) = @_;
104     my $row = $f[$x][$i[$x]++];
105
106     if ($opt_h) {
107         my $bg = $cls{$pfx}->();
108         print qq{  <tr class="$bg">},
109             (map{"<td".(s/^\cA\r([gr])//?qq{ class="$1"}:"").">$_</td>"}@$row),
110             "</tr>\n";
111         return;
112         }
113
114     print $hdr, $pfx, " ", $pfx eq "-" ? RED : $pfx eq "+" ? GREEN : "";
115     $csv->print (*STDOUT, $row);
116     print RESET, "\n";
117     $hdr = "";
118     } # show
119
120 # Skip first line of both are same: it probably is a header
121 my @h0 = @{$f[0][0]};
122 my @h1 = @{$f[1][0]};
123 if ("@h0" eq "@h1") {
124     if ($opt_h) {
125         $i[0]--;
126         show ("H", 0);
127         }
128     shift @{$f[0]};
129     shift @{$f[1]};
130     }
131
132 my $x = 0;
133 while ($i[0] <= $n[0] || $i[1] <= $n[1]) {
134     my @r0 = @{$f[0][$i[0]]};
135     my @r1 = @{$f[1][$i[1]]};
136
137     if ($opt_n) {
138         $r0[0] <  $r1[0] and show ("-", 0), next;
139         $r0[0] >  $r1[0] and show ("+", 1), next;
140         }
141     else {
142         $r0[0] lt $r1[0] and show ("-", 0), next;
143         $r0[0] gt $r1[0] and show ("+", 1), next;
144         }
145
146     "@r0" eq "@r1" and $i[0]++, $i[1]++, next;
147
148     foreach my $c (1 .. $#h0) {
149         my ($L, $R) = map { defined $_ ? $_ : "" } $r0[$c], $r1[$c];
150         $L eq $R and next;
151         $f[0][$i[0]][$c] = RED   . $L . RESET;
152         $f[1][$i[1]][$c] = GREEN . $R . RESET;
153         }
154
155     show ("<", 0);
156     show (">", 1);
157     }
158
159 $opt_h and print "  </table>\n</body>\n</html>\n";
160
161 close STDOUT;