#!/usr/bin/perl

use strict;
use warnings;
use Benchmark qw (:all);

my $txt = "ugly anotherugly " x 100;
# print $txt,$/;

sub pg {
    my %words = (
            ugly => 'ug**',
            anotherugly => 'anot*******',
            );
    my @words = split / /, $txt; # largely simplified, you have to count ,.:; etc
        for my $i (0 .. $#words) {
            $words[$i] = $words{$words[$i]} if (exists($words{$words[$i]}))
        }
#   print join(' ', @words),$/;
}

sub orig {
    my %words = (
            ugly => 'ug**',
            anotherugly => 'anot*******',
            );
    $txt =~ s/$_/$words{$_}/g foreach keys(%words);
#   print $txt,$/;
}

my $test = {'pg' => \&pg, 'Original' =>\&orig,};

my $result = timethese(-10,$test );
cmpthese($result);

##</code><code>##

Benchmark: running Original, pg for at least 10 CPU seconds...
  Original: 11 wallclock secs (10.86 usr +  0.00 sys = 10.86 CPU) @ 43770.26/s (n=475345)
        pg: 11 wallclock secs (10.68 usr +  0.00 sys = 10.68 CPU) @ 4328.46/s (n=46228)
            Rate       pg Original
pg        4328/s       --     -90%
Original 43770/s     911%       --