problematice metashar regexp

[Anonymous Monk]

Dear Monks, I throw myself on the altar for help on this one

I have the following hash:

    my %key = (
    '1'=>'?', '2'=>'/', '3'=>'>', '4'=>'<', '5'=>':', '6'=>';',
       '7'=>'[', '8'=>']', '9'=>'{', '0'=>'}', '!'=>'p', '@'=>'o',
       '#'=>'i', '$'=>'d', '%'=>'j', '^'=>'h', '&'=>'g', '*'=>'k',
       '('=>'5', ')'=>'3', '-'=>'2', '+'=>'9', '='=>'%', '\\'=>'c',
       '|'=>'1', '~'=>'^'
);

And two functions,:

sub decode {
    my $char;
    my $meta;
    foreach $char (keys %key){
       $meta =quotemeta $key{$char};
       $$message->{body} =~ s/$meta/$char/gis;
    }
}

and

    my $char;
    my $meta;
    foreach $char (keys %key){
       $meta =quotemeta $char;
       $$message->{body} =~ s/$meta/$key{$char}/gis;
    }

But when it comes time to encode or decode a message like: this: ^5*9|1(1#|

becomes this: h:k{1?:?i1

ok, not problem, but going th reverse, this: h:k{1?:?i1

becomes this: \~5*9||5|#|

That's a problem ... can you help me understand why it's not doing the correct subs.

thanks, me

[Belgarion]

I would look at the docs on quotemeta. It can potentially (and likely will) return two characters for every one input. For example, " will return \". Your mapping functions do not appear to take that possibility into account.

[gjb]

One of the things that may go wrong is that you substitute in the result of a substitution. Consider the first character 'h', it's replaced by '^', but '^' can in turn be replaced by '~', depending on the order of the keys, something you don't control in a hash. Maybe this effect is intentional, but if not, it could be the source of your problem. If so, replace the global substitution by a while over the characters of the string.

Hope this helps, -gjb-

[Anonymous Monk]

This is most likely the problem.

I have to say, this was pretty darn intuitive of you, and I really appreciate the help.

Since I'm trying to stop benig such a hack (ugly code, procedural, use strict, etc.), is this the prettyiest way to while over a string?

#!/usr/bin/perl -w
use strict;

my $string="wheristhelove";
my @array=split(/\s*/, $string);
foreach (@array){
...

Again, thank you so much for your help!

[Stevie-O]

Also, if you're only doing character-by-character replacements, you may want to give tr/// a shot. You can do it all in one go:

# note that I used {} as the delimiter for tr///
$foo =~ tr{1234567890!@#$%^&*()-+=\\|~}
          {?/><:;[]{}poidjhgk5329%c1^};

This would also help prevent a potential problem: your hash maps '5' to ':' and '(' to '5'. If Perl happens to order your hash so keys finds the second of these first, Perl will change '('s in the string to '5's, then later on change those converted '5's to ':'s. tr/// does everything in one shot, so that sort of thing won't happen.

[Anonymous Monk]

This looks pretty darn good as well.

Trying to play with this, can something like this work?

my $str1="1234567890!@#$%^&*()-+=\|~";
my $str2="?/><:;[]{}poidjhgk5329%c1^";
$foo =~ tr{$str1}{$str2};

thanks you so much!

[bart]

Like gjb said: it's not a good idea to do one replacement at a time. Why not do them all at once? It'll probably be faster too, as it wouldn't require recompiling the regex again for every substitution — 26 per sub call. You do have the hash you'd need, already.

  my $pattern = join "|", map quotemeta, keys %key:

  sub decode {
      $$message->{body} =~ s/($pattern)/$key{$1}/og;
  }

The initialization must have run before you call the sub for the first time — but that's no different from the situation like you already had, for the hash.

Note that you can't have case insensitive searches this way, or the hash entry for the matched string may not exist — though that's easily fixed. But, it doesn't seem to be necessary anyway.

For the other way around, you'll need a reverse hash.

An alternative, which will be faster in most cases, is to use the module Regex::PreSuf. That's a module to construct a regex (as a string) out of a word list. At least the most recent version takes care of the quotemeta itself.

  use Regex::PreSuf;
  my $pattern = presuf(keys %key);

Nothing else needs to change. For your case, the pattern ends up looking like:

  [\^\~\@\!\#\$\%\&\(\)\*\+\-0123456789\\\=\|]

which is rather nice.