mouth of madness

fix-psql-utf8.pl

#!/usr/bin/env perl

use strict;
use warnings;

use Encode qw(encode decode);

use 5.10.0;

use DBI;
use List::MoreUtils 'pairwise', 'each_array';
binmode STDOUT;

my $dbh = DBI->connect('dbi:Pg:dbname=template1', '', '', {AutoCommit => 0});

my ($table, $column_list);
my @current_columns;
while (<>) {
  if (/^COPY/) {
    ($table, $column_list) = /^COPY (\w+) \((.*?)\) FROM stdin/;
    @current_columns = map { $dbh->quote_identifier($_) } split /, /, $column_list;
  }

  my @bad_fields = split /\t/;
  
  my $line = $_;

  eval { decode("UTF-8", $line, Encode::FB_CROAK) };

  if ($@) {
    if (/[\x7F-\x9F]/) { 
      $_ = encode('UTF-8', decode("cp1252", $_));
    } else {
      $_ = encode('UTF-8', decode("iso-8859-1", $_));
    } 
    my @fixed_fields = split /\t/;

    my @indices;
    my $it = each_array(@bad_fields, @fixed_fields);
    while ( my ($a, $b) = $it->() ) {
      my $idx = $it->('index');
      my @aa = unpack('C*', $a);
      my @bb = unpack('C*', $b);
      push @indices, $idx unless \@aa ~~ \@bb;
    }

    # pairwise doesn't take slices
    my @idn = @current_columns[@indices];
    my @fld = map { $dbh->quote($_) } @fixed_fields[@indices];
    
    my @subclauses = pairwise { "$a = $b" } @idn, @fld;
    print "UPDATE $table SET " 
      . join(', ', @subclauses)
      . " WHERE $current_columns[0] = $fixed_fields[0];\n";
  }
}