#!/usr/bin/env perl
use 5.012;
use warnings;

use List::AllUtils qw(nsort_by reduce);

my $grid = join "\n", qw(
    ONEFISHTWOJELLYFISHS
    LYNTAOBDOPAEPNBUETYE
    PMIRHSAESTNESRRARTEU
    CALIFORNIAPLEASANTLL
    HHSREDPOPPIESXVHUWLB
    AAAZECROFEFILERDLOAE
    PMLMPHSIFDEPIRTSYOVM
    PDLEQMIEWBLACKCATDSI
    YEADENRESURGENCEPYNT
    FNCIDOLBABYOCTOPUSOR
    AHTCYLMAERDSRELLEFTE
    MODEERFOTTHGILFWDPLM
    IUBRNEDRAGEMOHELHKAM
    LSSCOUNTRYWALKDTVQWU
    YEDNOPNEZORFPUSFRUSS
);

my @words = qw(
    BABYOCTOPUS
    BLACKCAT
    CALIFORNIAPLEASANT
    CALLAS
    COUNTRYWALK
    EEL
    FELLERSDREAM
    FLIGHTTOFREEDOM
    FROZENPOND
    HAMDENHOUSE
    HAPPYFAMILY
    HOMEGARDEN
    LIFEFORCE
    ONEFISHTWOJELLYFISH
    PEAPODBOAT
    REDPOPPIES
    REEFDWELLERS
    RESURGENCE
    SEASHRIMP
    STRIPEDFISH
    SUMMERTIMEBLUES
    SURFSUP
    VASE
    WALTONSVALLEY
    WOODY
);

# Look for the largest words first.
@words = nsort_by { -length } @words;

my $width = index $grid, "\n";
my @dir = map { [$_, 0, $grid], [$_, 1, $grid] } (0, $width-1 .. $width+1);
for my $word (@words) {
    for my $dir (@dir) {
        my @char = split '', $dir->[1] ? reverse $word : $word;
        my $re = join ".{$dir->[0]}", map "($_)", @char;
        if (my $i = $dir->[2] =~ /$re/s ) {
            substr $dir->[2], $-[$i++], 1, ' ' for @char;
        }
    }
}

my $message = reduce { $a & $b } map { $_->[2] } @dir;
$message =~ tr/A-Z//cd;
say $message;