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]

> (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
--
Perl isn't a toolbox, but a small machine shop where you
can special-order certain sorts of tools at low cost and
in short order. -- Larry Wall

[Michele Dondi]

On Tue, 04 Mar 2008 06:40:27 GMT, "John W. Krahn"
<som...@example.com> wrote:

>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,

[axtens]

On Mar 4, 11:44 pm, Michele Dondi <bik.m...@tiscalinet.it> wrote:
> On Tue, 04 Mar 2008 06:40:27 GMT, "John W. Krahn"
>

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.