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;