#!/usr/bin/perl -w
use strict;
# find palindromes in text file

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

# cross line boundries but not paragraph boundries
$le = $/;
$/ = "\n\n";
@lines = <>;
$/ = $le;

foreach (@lines) {
    # strip punct - no posix on my system
    s/[)(\?".,\/]//g;
    s/-/ /g;
    chomp;

    (@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];
                    $pals{$pal}++;
                }
            }
        }

        # grab single word palindromes
        $word = shift @F;
        if(length $word > 2 && lc $word eq lc reverse $word) {
            $pals{$word}++;
        }
    }
}

foreach $pal (sort keys %pals) {
    print "$pals{$pal}\t$pal\n";
}