Update After sleeping over it I've greatly simplified the algoritm, now I think it's elegant. You have to decide yourself if this algorithm is nicer than the rather elegant recursive solution.

sub demangle {
    my $r = shift;
    my %illegal;
    @illegal{%$r} = ();

    my @chains;

    LOOP:
    while (my($k,$v) = each %$r) {
        for my $c (@chains) {
            if ($c->[-1] eq $k) {   # append to end of chain
                push @$c, $v;
                next LOOP;
            };
            if ($c->[0] eq $v) {    # prepend to start of chain
                unshift @$c, $k;
                next LOOP;
            }
        }
        push @chains, [$k, $v];     # create new chain
    }

    # fix circular replacements
    for my $c (@chains) {
        if ($c->[0] eq $c->[-1]) {  # we have a circle
            my $new_key;
            do {
                $new_key = join '', map { ('a'..'z')[rand 26] } 1..8;
            } while exists $illegal{$new_key};
            $illegal{$new_key}++;

            unshift @$c, $new_key;
            push @$c, $new_key;
        }
    }

    my @order;

    while (@chains) {
        push @order, { map { $_->[-2] => pop @$_ } @chains };
        @chains = grep @$_ > 1, @chains;
    }

    return @order;
}
[download]

-- Hofmator

There is also Regexp::Subst::Parallel, which does the same thing you do (I guess).

perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ;    # The  
$d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider
($c = $d->accept())->get_request(); $c->send_response( new   #in the
HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' #  web
[download]

Yea, that'll work too

(although I think using a module for this is a bit overkill; especially since they're simple regex-free substitutions)

I'm not interested in regexps as I'm not working with strings. This is being used to update database fields, so unless you're doing some really fancy tie-ing, regexps aren't gonna fly :)

For reference, the heart of the code that uses this snippet looks like this:

my $db = DBI->connect( $DSN, 'user', 'sekret', {AutoCommit => 0})
    or die "Couldn't connect to database $DSN: ${\DBI->errstr}\n";
END { $db and $db->disconnect }

my $ss = $db->prepare( q{update t set department = ? where department 
+= ?});
die unless $ss;

my $ok = 1;
REPLACE: for my $r( @order ) {
    for my $key( keys %$r ) {
        print "$key -> $r->{$key}\n";
        if( !$ss->execute( $r->{$key}, $key )) {
            warn "cannot update $key to $r->{$key}\n${\$ss->errstr}\n"
+;
            $ok = 0;
            last REPLACE;
        }
    }
}

$ok ? $db->commit : $db->rollback;
[download]

NB: The above code is condensed from production code. I have excised things that have no relevance to the example, so it just may or may not compile :)


print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u'

•Update: ok, I missed the line "The above example represents the fields in database records to be updated to reflect the change." -- my apologies

Since you asked... I call this update chaining.

And it reminds me of the old story about demonstrating the "new" features of a word processor (I heard it about the old WordStar, severely dating myself...) The person shows her boss how you can change "all the 'a's to 'e's in a document." They then say "...and you can change them right back the same way. Uh. Oh." Of course, at this point, they discover that the Undo feature only backsteps one event. :)

--
$you = new YOU;
honk() if $you->love(perl)

Somewhat belated, but I had fun exploring different methods. Whether this is better in any way I doubt, but somebody might find it interesting.

#! perl -slw
use strict;
use Data::Dumper;

sub unwindDependancies{
    my ($hashref) = @_;
    my %copy = %{$hashref};
    my @keys = keys %$hashref;
    my @deps;

    for (@keys)  {
        next unless exists $copy{$_};
        push @deps, [ $_ ];
        while( exists $hashref->{$_}) {
            unshift( @{ $deps[-1] }, $_ = $hashref->{$_} );
            @{$deps[-1]} > @keys and die('Circular reference found inv
+olving:', "@{$deps[-1]}");
            delete $copy{$_};
        }
    }

    my %h;
    for (@deps) {
        my $r = \%h;
        $r = exists $r->{$_} ? $r->{$_} : ($r->{$_} = {}) for @$_;
    }
    #print Dumper \%h;

    my (@order, @stack);
    my $r=\%h;
    my $t=0;
    {
        while(my ($key, $val) = each %$r) {
            push @order, $key;
            push(@stack, $r), $r = $val, next if keys %$val;
        }
        $r = pop(@stack), redo if @stack;
    }
#    print "@order";
    return @order;
}

my %test = ( qw[A B  B C  D E  E F  F G  G C  J H  H F  I H  K H  N M 
+ O P  P Q  Q N  S U  T V]);
print join' ', unwindDependancies \%test;

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
/ );

print join' ', unwindDependancies \%replace;

__DATA__
C:\test>238721
V T C G F H I J K E D B A U S M N Q P O
ICC IN SEC COM MOC CO MH HIS EU MO MOB AE GRE CY GR INO ICM1 ICM2
[download]