Two perl-specific postings on Codeaholic

[axtens]

G'day everyone

1. [Perl/PDK/PerlCtrl] Returning an array of arrays for VB6/VBScript
http://codeaholic.blogspot.com/2008/02/perlpdkperlctrl-returning-array-of.html
2. [Perl] How not to do it? http://codeaholic.blogspot.com/2008/03/perl-how-not-to-do-it.html

Kind regards,
Bruce.

 

[John W. Krahn]

G'day everyone

1. [Perl/PDK/PerlCtrl] Returning an array of arrays for VB6/VBScript
http://codeaholic.blogspot.com/2008/02/perlpdkperlctrl-returning-array-of.html
2. [Perl] How not to do it? http://codeaholic.blogspot.com/2008/03/perl-how-not-to-do-it.html

(I'm no guru when it comes to Perl, so if you see something that could
be expressed in a more efficient manner, please let me know.)

1. Remove all 's'
sub rule1 {
my $arg = shift;
$arg =~ s/s//g;
return $arg;
}

sub rule1 {
( my $arg = shift ) =~ tr/s//d;
return $arg;
}

2. Sort the characters of the word into alphabetic order
sub rule2 {
my $arg = shift;
my @arr = split( //, $arg );
@arr = sort @arr ;
$arg = join( '', @arr );
return $arg;
}

sub rule2 {
return join '', sort split //, shift;
}

3. Convert all vowels to 'e
sub rule3 {
my $arg = shift;
$arg =~ s/[a|e|i|o|u]/e/g;
return $arg;
}

Why are you converting the '|' character and the 'e' character to 'e'?

sub rule3 {
( my $arg = shift ) =~ tr/aiou/e/;
return $arg;
}

4. Replace the first letter with 'n'
sub rule4 {
my $arg = shift;
$arg =~ s/^./n/;
return $arg;
}

The . character class matches a lot more than just letters, or did you
really mean "replace any first character except newline with 'n'".

sub rule4 {
( my $arg = shift ) =~ s/\A[[:alpha:]]/n/;
return $arg;
}

5. Drop the last letter
sub rule5 {
$arg = shift;
$arg =~ s/.$//;
return $arg;
}

The . character class matches a lot more than just letters.

sub rule5 {
( my $arg = shift ) =~ s/[[:alpha:]]\z//;
return $arg;
}

6. Replace letter pairs with 'ow'
sub rule6 {
$arg = shift;
@arr = split( //, "abcdefghijklmnopqrstuvwxyz" );
for $letter ( @arr ) {
$arg =~ s/$letter$letter/"ow"/eg;
}
return $arg;
}

sub rule6 {
( my $arg = shift ) =~ s/([[:lower:]])\1/ow/g;
return $arg;
}

Each rule is evaluated against the passed in value in $arg, and stored
in $res. $reason is cleared and each test applied to $res.

$res = eval( "rule$j(\"$arg\")" );

Ouch! Use a dispatch table instead of string eval().

my %rule = (
1 => sub {
( my $arg = shift ) =~ tr/s//d;
return $arg;
},
2 => sub {
return join '', sort split //, shift;
},
3 => sub {
( my $arg = shift ) =~ tr/aiou/e/;
return $arg;
},
# more rules here
);

# and later on, use rules
$res = $rule{ $j }( $arg );




John

 

[Michele Dondi]

Ouch! Use a dispatch table instead of string eval().

my %rule = (
1 => sub {
( my $arg = shift ) =~ tr/s//d;
return $arg;
},
2 => sub {
return join '', sort split //, shift;
},

Since the keys are numbers, an array may be appropriate.


Michele

 

[axtens]

Ouch! Use a dispatch table instead of string eval().

my %rule = (
1 => sub {
( my $arg = shift ) =~ tr/s//d;
return $arg;
},
2 => sub {
return join '', sort split //, shift;
},

Since the keys are numbers, an array may be appropriate.

Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,

Wow, this is great stuff. Thanks, both of you! Shall cook up another
posting during the week and put your names in lights (unless you'd
prefer otherwise, in which case email me off-list).

Kind regards,
Bruce.