Ordering hash replacements to avoid clobbering things (update chaining)

[grinder]

Suppose you have a hash of replacements to perform.

my %replace = ( qw/
    COM  SEC
    MOB  HIS
    MOC  COM
    ICM1 INO
    ICM2 INO
    EU   HIS
    CY   GRE
    AE   MOB
    IN   ICC
    GR   GRE
    MH   MOC
    CO   MOC
    MO   HIS
/ );

That is, if you see 'COM', you must replace it with 'SEC'. For a real world example, my company restructures itself internally every once in a while, and while the people remain the same, the departments change name, merge and split. The above example represents the fields in database records to be updated to reflect the change.

Looking carefully, one sees that the transfer COM -> SEC has to be applied before MOC -> COM. If performed in the wrong order, MOC will be transformed to COM and thence to SEC, which would be a Bad Thing.

We have to look for the case where a hash value x (the replacement) matches a hash key y (what is to be replaced). If so, the tranformation of hash key y needs to be performed first, to clear the way for the hash key (whatever it is) to transform itself to x in a subsequent pass.

Thus, we want an array of references to tranform hashes. If we get the order right, we are guaranteed of not clobbering anything in our transforms.

Another problem to worry about is in the case of COM -> SEC and SEC -> COM. In this case we have a loop. The only way to solve this problem is to weaken the loop by introducing an intermediate step: COM -> ZZZ, SEC -> COM, ZZZ -> SEC (where ZZZ is a random string guaranteed not to exist among the set of transforms). I didn't run into this problem (I should be thankful for small mercies) but I added the code to at least detect the problem. Solving it is left as an exercise to the reader.

I'm interested in feedback. Is there a better way? Simpler? Non-recursive? A better way of dealing with the @order array? (I don't like passing it as a parameter, I think it would be more elegant to say my @order = demangle( \%replace). And demangle is a silly name, but I can't think of a good action/verb that describes what I'm doing. Hell, even a better title for this snipper would help (something that will help people search for it -- thanks extremely).

#! /usr/bin/perl -w

use strict;

my %replace = ( qw/
    COM  SEC
    MOB  HIS
    MOC  COM
    ICM1 INO
    ICM2 INO
    EU   HIS
    CY   GRE
    AE   MOB
    IN   ICC
    GR   GRE
    MH   MOC
    CO   MOC
    MO   HIS
/);

my @order;
demangle( \%replace, \@order );

sub demangle {
    my $r     = shift;
    my $order = shift;

    my %invert;
    @invert{ values %$r } = keys %$r;

    my( %okay, %collide );

    for my $key( sort keys %$r ) {
        if( exists $invert{$key} ) {
            $collide{$key} = $r->{$key};
        }
        else {
            $okay{$key} = $r->{$key};
        }
    }
    unshift @$order, \%okay;

    if( %collide ) {
        my @loop_keys = sort keys %collide;
        my @loop_vals = sort values %collide;
        my $is_loop = 1;
        for( my $n = 0; $n < scalar @loop_keys; ++$n ) {
            if( $loop_keys[$n] ne $loop_vals[$n] ) {
                $is_loop = 0;
                last;
            }
        }
        if( $is_loop ) {
            warn "\t$_\t$collide{$_}\n" for sort keys %collide;
            die "loop in transforms detected, bailing out\n";
        }
        demangle( \%collide, $order );
    }
}

my $pass = 0;
for my $r( @order ) {
    ++$pass;
    print "Pass $pass\n";
    for my $key( keys %$r ) {
        print "\t$key -> $r->{$key}\n";
    }
}
__END__
# produces:
Pass 1
        COM -> SEC
Pass 2
        MOB -> HIS
        MOC -> COM
Pass 3
        ICM1 -> INO
        ICM2 -> INO
        EU -> HIS
        CY -> GRE
        IN -> ICC
        GR -> GRE
        MH -> MOC
        CO -> MOC
        AE -> MOB
        MO -> HIS