#!/usr/bin/perl -w
use strict;
use POSIX;

# find palindromes in text file

my ($le, @lines, @F, $test, $pal, %pals, $start_char, $i, $word);

# cross line boundries but not paragraph boundries
# #'d out to match matching of comparison code
#$le = $/;
# $/ = "\n\n";
# @lines = <>;
# $/ = $le;

while (<>) {
    s/[[:punct:]]//g;

    (@F) = split;
    while (int @F) {
        # select array slices where last letter of last word in
        # slice equals first letter of first word
        $start_char = lc substr $F[0], 0, 1;
        foreach $i (1 .. $#F) {
            if( (lc substr $F[$i], -1) eq  $start_char) {

            # test for palindrome
            $test = lc join "", @F[0..$i];
                if($test eq reverse $test) {
                    $pal = join " ", @F[0..$i];
                    print "$. $pal\n";
                }
            }
        }

        # grab single word palindromes
        $word = shift @F;
        if(length $word > 2 && lc $word eq lc reverse $word) {
                print "$. $word\n";
        }
    }
}


##</code><code>##

#!/usr/bin/perl

# find all palindrome phrases on each line
#     only phrases of two or more alpha
#     a phrase starts and ends on a word boundary
#
# nested palindrome phrases will also be found
# (including single words)

use strict;
use warnings;
our $N;

my $re =
  qr/(                         # start $1
      \b                       # left word edge
      ([a-z].*[a-z])           # at least 2 alpha
      \b                       # right word edge
      (??{                     # start code
          local $N = lc $^N;   # save capture
          $N =~ tr!a-zA-Z!!dc; # remove non-alpha
                               # fail if not pal
          '(?!)' if (lc($N) ne reverse lc($N));
         })                    # end code
     )                         # end $1
    /ix;

while (<>)
{
  my $found;
  while ( /$re/g )
  {
    # print "line $.:\n" unless $found;
    pos = pos() - length($1);  # find nested pals
    # print "(", pos, ") \"$1\"\n";
    print "$. $1\n";
    $found = 1;                # \n between groups
    pos = pos() + 1;           # advance one
  }
  print "\n" if $found;
}

exit;

__DATA__
god dog
alpha beta gamma stop pots wonka wonka wonka
bookkeeper raisinhead
what is a bookkeeper pop repeekkoob tomorrow?
boob tube A man, a plan, a canal, Panama! kook peep aha
aba abba abbba aabbbaa abbba abba aba
nested testset detsen nested
i prefer pi ip referp