in reply to Ordering hash replacements to avoid clobbering things (update chaining)

•Update: I've retracted this post, it doesn't apply to the situation (I missed the part about it being db records that need to be updated) This stuff below is only useful if you need to do the substitutions in a string. 
use strict;
use warnings;

my %replace = qw(
    COM  SEC

    MOC  COM
    SEC  COM
    CO   MOC
);
my $searchpat = join '|', sort { length $b <=> length $a } keys %repla
+ce;
$searchpat = qr/$searchpat/; # optional, dunno if it speeds up things

my $example = "FOO CO COM BAR MOC SEC";
$example =~ s/($searchpat)/$replace{$1}/g;
print "$example\n";

[download]
Produces the output: 
FOO MOC SEC BAR COM COM

[download]
As you can see, it also handles circularity without problem; COM <-> SEC.

Note that I'm sorting the keys on length to make sure longer patterns match first (otherwise "COM" would become "SECM").

If the search-string needs to occur as a word by itself, use \b, like: 
my $example = "MOC.COMPUTER.COM.FOO / SEC.SECT / CO";
$example =~ s/\b($searchpat)\b/$replace{$1}/g;
print "$example\n";

[download]
which prints: 
COM.COMPUTER.SEC.FOO / COM.SECT / MOC

[download]

Note that in this case sorting on the length of the key is not necessary, so you can simply do my $searchpat = join '|', keys %replace;

Final note: this code assumes the keys don't contain any odd chars like regex metachars. Since your example shows all-uppercase abbreviations, so apparently this isn't a problem. If it is, then you'll need to look into using quotemeta.

 

Replies are listed 'Best First'.
Re:x2 Ordering hash replacements to avoid clobbering things
by grinder (Bishop) on Feb 26, 2003 at 16:17 UTC

    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'
[reply]
[d/l]
      •Update: ok, I missed the line "The above example represents the fields in database records to be updated to reflect the change." -- my apologies
[reply]

In Section Cool Uses for Perl