examples/perl/Palindrome.pmPerl
package Palindrome;

sub new()
{
	return bless [[], []], shift;
}

sub copy()
{
	my $self=shift;
	my $copy=Palindrome->new;
	@{$copy->[$_]}=@{$self->[$_]} for 0, 1;
	return $copy;
}

sub totalWords()
{
	my $self=shift;
	return @{$self->[0]}+@{$self->[1]};
}

sub isPalindrome()
{
	my $self=shift;
	my $string=join '', @{$self->[0]}, @{$self->[1]};
	return $string eq reverse $string;
}

sub toString()
{
	my $self=shift;
	return join ' ', @{$self->[0]}, @{$self->[1]};
}

sub whatToDo()
{
	my $self=shift;
	my $left=join '', @{$self->[0]};
	my $right=join '', @{$self->[1]};
	if(length($left)<=length($right))
	{
		return (0, substr(scalar(reverse($right)), length($left)));
	}
	else
	{
		return (1, scalar(reverse(substr($left, length($right)))));
	}
}

sub add($$)
{
	my $self=shift;
	my $side=shift;
	my $word=shift;
	unless($side)
	{
		push @{$self->[0]}, $word;
	}
	else
	{
		unshift @{$self->[1]}, $word;
	}
}

return 1;

examples/perl/palindrome-array.plPerl
#!/usr/bin/perl

use warnings;

package Lexicon::Array;

use IO::File;

sub new(;$)
{
	my $class=shift;
	my $self=[];
	bless $self, $class;
	my $fileName=shift;
	if(defined $fileName)
	{
		my $file=IO::File->new($fileName, '<:utf8');
		my $word;
		while(defined($word=$file->getline))
		{
			chomp $word;
			$self->add($word);
		}
	}
	return $self;
}

sub add(@)
{
	my $self=shift;
	push @$self, @_;
}

sub suitableWords($$)
{
	my $self=shift;
	my $side=shift;
	my $string=shift;
	unless($side)
	{
		return grep { $_=~m/^$string/ or $string=~m/^$_/ } @$self;
	}
	else
	{
		return grep { $_=~m/$string$/ or $string=~m/$_$/ } @$self;
	}
}

##################################################

package Palindrome;

sub new()
{
	return bless [[], []], shift;
}

sub copy()
{
	my $self=shift;
	my $copy=Palindrome->new;
	@{$copy->[$_]}=@{$self->[$_]} for 0, 1;
	return $copy;
}

sub totalWords()
{
	my $self=shift;
	return @{$self->[0]}+@{$self->[1]};
}

sub isPalindrome()
{
	my $self=shift;
	my $string=join '', @{$self->[0]}, @{$self->[1]};
	return $string eq reverse $string;
}

sub toString()
{
	my $self=shift;
	return join ' ', @{$self->[0]}, @{$self->[1]};
}

sub quality()
{
	my $self=shift;
	my %words;
	$words{$_}++ for @{$self->[0]}, @{$self->[1]};
	return (length join '', keys %words)/$self->totalWords;
}

sub whatToDo()
{
	my $self=shift;
	my $left=join '', @{$self->[0]};
	my $right=join '', @{$self->[1]};
	if(length($left)<=length($right))
	{
		return (0, substr(scalar(reverse($right)), length($left)));
	}
	else
	{
		return (1, scalar(reverse(substr($left, length($right)))));
	}
}

sub add($$)
{
	my $self=shift;
	my $side=shift;
	my $word=shift;
	unless($side)
	{
		push @{$self->[0]}, $word;
	}
	else
	{
		unshift @{$self->[1]}, $word;
	}
}

##################################################

package main;

use utf8;
use open IO=>':utf8';
use open ':std';

{
	my $spin=0;
	sub spinner($)
	{
		my $s=shift;
		$spin++;
		$spin %= 4;
		print "\e[K", $s, substr('\\-/|', $spin, 1), "\r";
		flush STDOUT;
	}
}

my $n=shift;
my $wordsFileName=shift;
my $quality=shift;
my $words=Lexicon::Array->new($wordsFileName);

my @palindromes=(Palindrome->new);

my $counter=0;
while(@palindromes)
{
	my $palindrome=shift @palindromes;
	$counter++;
	#die $palindrome->totalWords;
	if($palindrome->totalWords==$n)
	{
		print "\e[31m", $palindrome->quality, "\t", $palindrome->toString, "\e[m\n"
			if $palindrome->isPalindrome and $palindrome->quality>=$quality;
		next;
	}
	my ($side, $s)=$palindrome->whatToDo;
	for my $w($words->suitableWords($side, $s))
	{
		my $p=$palindrome->copy;
		$p->add($side, $w);
		unshift @palindromes, $p;
	}
	#spinner(0+@palindromes);
	STDERR->print("\e[K", $counter, '/', 0+@palindromes, "\r");
}

Пока нет.