-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

=pod

Something that comes up over the course of an application's life is
bad data that you need to fix.  At work, we fix this up with some
clever SQL run against our production databases, but I honestly never
really feel safe doing that.  

For my personal stuff, I have the flexibility of being able to do
whatever I want for no good reason (and smaller datasets), so I tend
to write my datafix scripts in pure perl, with the help of my
application's DBIx::Class schema.

Recently, I decided to fixup some "people" entries in ircxory.  People
on IRC often use nicks other than their "real" nick.  For example,
C<jrockway> sometimes uses C<jrockway_> or C<jrockway__>.  It's clear
to a person that these are all the same people, but ircxory tracks
them as multiple people (and so says that "jrockway, jrockway_, and
jrockway__" hate PHP; it's true, but kind of redundant).  This kind of
messes up the data after a while, so I decided to write a quick script
to associate all lookalike nickname records with the same person.

This involves a few steps.  We need to examine every nickname record's
nickname, and see if it looks like an "alternate" nickname.  If this
conditional matches, we then see if ircxory has a Person record for
C<$1>.  If it does, we update the current nickname record to belong to
that matching Person.  If the Person that was previously associated
with the nickname no longer has any nicknames, we delete the record.

In SQL, this would all be a nightmare, but with DBIC, it's beautiful.
Here's the full script:

    lang:Perl
    use strict;
    use warnings;
    
    use App::Ircxory::Schema;
    
    my $schema = App::Ircxory::Schema->connect(@ARGV, { AutoCommit => 0 });
    my @nicks = $schema->resultset('Nicknames')->all;
    $schema->txn_do(
      sub {
          foreach my $nick (@nicks) {
              my $name = $nick->person->name;
              my $orig_person = $nick->person;
              if($name =~ /^(?:[^A-Za-z])?([A-Za-z]+)(?:[^A-Za-z])?$/ 
                 && $name ne $1)
                {
                    my $real = $1;
                    print "$name looks like $real\n";
                    
                    my $person = $schema->resultset('People')->
                      search({ name => $real })->first;
                    if($person){
                        print "    * Change $name -> ". $person->name. "\n";
                        $nick->update({ pid => $person->pid });
                        if($orig_person->nicknames->count < 1){
                            print "        * Delete person $name\n";
                            $orig_person->delete;
                        }
                    }
                }
          }
          print {*STDERR} "Type y to COMMIT or n to ROLLBACK\n";
          my $yes = <STDIN>;
          chomp $yes;
          if($yes ne 'y'){ die "ROLLBACK" }
          print {*STDERR} "COMMIT\n";
      });
    

The real code is almost a perfect translation of the English
description above.  I like that a lot, and as a result, I feel
confident that this datafix script didn't break my database.

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.6 (GNU/Linux)

iQCVAwUBRuojM9AZeFPdJeQvAQJ7FgQAkkOnZGuHcPzmxIgleWhDprTZXbclX75b
Mwwj3F0ybVi5EpGs7AmDhJzlMl+oqknDN20+e8mwM279Wg2uabR6SpSRw8mltVHm
KW8RL+ttVgDRLLhB3hXseZKQ5f10h64ehi8isHfUcKIsecOREhGqRFlHUbuZW5Pj
69FnGLroZYg=
=QLrh
-----END PGP SIGNATURE-----