[NBLUG/talk] I hate perl. :-)

[Andru Luvisi]

On Mon, 29 May 2006, William Tracy wrote:
[snip]
> I *know* that there have to be a few Perl nuts here. ;-) Given the
> nature of Perl nuts, I expect that someone will want to one-up my
> program (who can write it as a one-liner?). So, here it is. Have at
> it.
[snip]

Here's a short version for fun.  I'm sure those better than me could make 
it shorter.

#!/usr/bin/env perl

$"='';$b=[split(//,$ARGV[0])];r($b,0);sub r{my($s,$n)=@_;$n==$#$s?print 
"@$s\n":map{r($s,$n+1);@$s[$n..$#$s]=@$s[$#$s,$n..$#$s-1];}(0)x(@$s-$n);}

With respect to your code, I'll offer some thoughts on style.  These are, 
of course, highly personal.  YMMV.

My point isn't that my style is best.  What I'll try to illustrate is how 
I have found a style that reduces the distance between the mental models 
that I use, and what's on the screen.  That's one of the things that 
TMTOWTDI is about.  You learn to do some things in a Perlish way, and Perl 
learns (with your help) how to do some things in a Youish way.

I notice that you already use the One True Brace Style.  I like this style 
because it fits more lines of code on the screen at once, and lets me see 
more of the program at once.

I like to "use strict".  It saves me from lots of typos.  "use warnings" 
has saved me from some bugs in the past too.

It's friendly for an error message to say what the problem is.  A common 
convention for command line utilities is to print out a "usage" line if no 
arguments are given.

I like to add an exit at the end of the main program so that it is obvious 
that "this is where the top level stuff ends and everything below here is 
subroutines."

You usually don't want function prototypes, and you don't need one in this 
case.  The line that declares addAnagrams shouldn't have the () after 
addAnagrams.

I prefer to receive arguments with:
   my($var1, $var2) = @_;

I like the fact that it gives the variable list in a way that looks 
similar to when the subroutine is called.  This way when I'm trying to 
remember things like "does it take the count or the name first?" I can see 
what the arguments are, in order, at a glance, rather than having to look 
through multiple lines and think "this is arg 2 which is the third arg and 
comes after..."

When writing recursive functions, I prefer to list the base case first. 
This mirrors the way that I reason about a recursive function, which is 
through induction.  I find it easier to read a function and think "It does 
the right thing for $n == 0.  Okay.  ...and if it does the right thing for 
$n-1, then it does the right thing for $n.  Cool."

To me, the bit that removes the letter is tricky.  When reading that 
section, I have to figure out what's happening, and then figure out that 
it's the correct thing to do.  I would find that easier to read if it were 
pulled out into a subroutine.  Then while reading addAnagrams I just need 
to convince myself that removing the character is the right thing to do, 
and while reading removeChar, I just need to convince myself that it is 
removing the character correctly.  And since it's got a name, I don't need 
to figure out what it's doing, only satisfy myself that it's doing it 
correctly, which is much easier.  The bit that grabs the letter and adds 
it to $sofar is perfectly obvious to me, so I don't feel a need to name 
that part.  Of course, if both bits are obvious to you, there's no need to 
name either one.

Well, there ya go.  I hope it helps.  Here's something like what I would 
write in production code:

#!/usr/bin/env perl

use warnings;
use strict;

if (@ARGV != 1) {
   print STDERR "Usage: $0 <word to find anagrams of>\n";
   exit(1);
}

my $original = $ARGV[0];

print("Anagrams of ", $original, ":\n");
addAnagrams("", $original);
exit(0);

sub addAnagrams {
   my($sofar, $left) = @_;

   if(length($left) == 0) {
     print $sofar, "\n";
   } else {
     for (my $counter = 0; $counter < length($left); ++$counter) {
       addAnagrams($sofar . substr($left, $counter, 1),
                   removeChar($left, $counter));
     }
   }
}

sub removeChar {
   my($s, $pos) = @_;

   return substr($s, 0, $pos) . substr($s, $pos+1);
}