more perl1 cgi

gav on 2003-07-05T15:11:14

The perl1 version of this perl5 code

sub UnEscape {
    my $str = shift;
    $str =~ s/%(\w\w)/sprintf("%c", hex($1))/eg;
    $str;
}

Is something like the following. Note how substr isn't quite as nice as you'd expect.

sub UnEscape {
    $str = $_[0];
    $pos = index($str, '%');
    while ($pos != -1) {
        $code = sprintf("%c", hex(substr($str, $pos + 1, 2)));
        $str = substr($str, 0, $pos).$code.substr($str, $pos + 3, length($str));
        $pos = index($str, '%');
    }
    $str;
}

---

Bug

bart on 2003-07-05T22:23:56

If you use

$pos = index($str, '%');

everywhere, if your result was a "%" character, you would end up doubly decoding it. You should be using the position of the next occurence of "%" substring, thus, continue from after the previous value of $pos, instead of starting again from the start of the string.

I have no idea if substr() in this ancient version of the language could actually handle that.

s///ge

Juerd on 2003-07-05T23:09:04

sub ue {
    $str = $_[0];
    while ($str =~ /%(\w\w)/) {
        $s = sprintf('%c', hex($1));
        $str =~ s/%\w\w/$s/;
    }
    $str;
}

Tested with:

print do ue("%41%20%42%20%43");
print "\n";

Works in perl 1.0_15 and perl 5.8.0 :)

Re:s///ge

Juerd on 2003-07-05T23:34:10

To deal with the problem that bart describes, you need to re-build the string entirely.

sub ue {
    $in = $_[0]; $out = '';
    while ($in =~ s/%(\w\w)|([^%]+)//) {
        $out .= ($1 ? sprintf('%c', hex($1)) : $2);
        $1 = $2 = '';
    }
    $out;
}

Tested with:

print do ue("%41%2541%20%42%20%43");
print "\n";

No longer works with recent Perls, because those don't allow clearing $n manually. In Perl 1, you had to, because otherwise, $1 would not be cleared if only the second group matched!

To make it work with Perl 5.8.0 again, we need to eval that part. Eval STRING, because Perl 1 had no eval BLOCK.

sub ue {
    $in = $_[0]; $out = '';
    while ($in =~ s/%(\w\w)|([^%]+)//) {
        $out .= ($1 ? sprintf('%c', hex($1)) : $2);
        eval "\$1 = \$2 = '';";
    }
    $out;
}