Permutations with Perl

Permutations with Perl

#!/usr/bin/env perl

use strict;
use warnings;

my %permution = (
	"a" => [ "a", "A", "4"],
	"b" => "bB8",
	"c" => "cC",
	"d" => [ "d", "D"],
	"e" => "eE3",
	"f" => "fF",
	"g" => "gG9",
	"h" => "hH",
	"i" => "iI1",
	"j" => "jJ",
	"k" => [ "k", "K"],
	"l" => [ "l", "L", "7", "1"],
	"m" => [ "m", "M"],
	"n" => [ "n", "N"],
	"o" => [ "o", "O", "0"],
	"p" => "pP",
	"q" => "qQ",
	"r" => [ "r", "R"],
	"s" => "sS5",
	"t" => "tT71",
	"u" => "uU",
	"v" => [ "v", "V"],
	"w" => ["w", "W"],
	"x" => "xX",
	"y" => "yY",
	"z" => "zZ2",
);

# End config




while (my $word = <>) {
	chomp $word;
	my @string = split //, lc($word);
	permute(0, @string);
}

sub permute {
	my $num = shift;
	my @str = @_;
	my $len = @str;

	if ($num >= $len) {
		foreach my $char (@str) {
			print $char;
		}
		print "\n";
		return;
	}

	my $per = $permution{$str[$num]};

	if ($per) {
		my @letters = ();
		if (ref($per) eq 'ARRAY') {
			@letters = @$per;
		} else {
			@letters = split //, $per;
		}
		$per = "";

		foreach $per (@letters) {
			my $s = "";
			for (my $i = 0; $i < $len; ++$i) {
				if ($i eq 0) {
					if ($i eq $num) {
						$s = $per;
					} else {
						$s = $str[0];
					}
				} else {
					if ($i eq $num) {
						$s .= $per;
					} else {
						$s .= $str[$i];
					}
				}
			}
			my @st = split //, $s;
			permute(($num + 1), @st);
		}
	} else {
		permute(($num + 1), @str);
	}
}