view release on metacpan or  search on metacpan

lib/Acme/Grep2D.pm  view on Meta::CPAN

For testing another module, I needed the ability to grep in 2 dimensions,
hence this module.

This module can grep forwards, backwards, up, down, and diagonally in a
given text string. Given the text:

  THIST  T S
  .H  H H  II
  ..I II SIHTH
  ...SS    T  T

We can find all occurances of THIS.

Full Perl regexp is allowed, with a few limitations. Unlike regular
grep, you get back (for each match) an array containing array
references with the following contents:

  [$length, $x, $y, $dx, $dy, ??]

Operational note: there is one more argument at the end of the
returned array reference (as indicated by ??). Don't mess with
this. It's reserved for future use.

=head1 METHODS

=cut

=head2 B<new>

  $g2d = Acme::Grep2D->new(text => ??);

Constructor. Specify text pattern to be grepped
(multiline, with newlines).

Example:

  my $text = <<'EOF';
  foobarf
  .o,,,o
  ,,o?f?fr
  <<,b ooa
  ##a#a ob
  @r@@@rbo
  ------ao
  ~~~~~~rf
  EOF

  $g2d = Acme::Grep2D->new(text => $text);
 
Now, our grep will have no problem finding all of the "foobar"
strings in the text (see B<Grep> or other more directional methods).

The author is interested in any novel use you might find for this
module (other than solving newspaper puzzles).

=cut

sub new {
    my ($class, %opts) = @_;
    my $self = \%opts;
    bless $self, $class;
    $.Class = $class;
    ./_required('text');
    ./_init();
    return $self;
}

# check for mandatory options
sub _required {
    my ($self, $name) = @_;
    die "$.Class - $name is required\n" unless defined $self->{$name};
}

# adjust dimensions to be rectangular, and figure out what's
# in there in all directions
sub _init {
    my ($self) = @_;
    my $text = $.text;
    my @text;
    
    # split on newlines, preserving them spatially
    while ((my $n = index($text, "\n")) >= 0) {
        my $chunk = substr($text, 0, $n);
        push(@text, $chunk);
        $text = substr($text, $n+1);
    }
    chomp foreach @text;

    my @len;
    push(@len, length($_)) foreach @text;
    my $maxlen = $len[0];
    my $nlines = @text;

    #determine max length of each string
    map {
        $maxlen = $len[$_] if $len[$_] > $maxlen;
    } 0..($nlines-1);

    # make all lines same length
    map {
        $text[$_] .= ' ' x ($maxlen-$len[$_]);
    } 0..($nlines-1);
    #print Dumper(\@text);

    my @diagLR;
    my @diagRL;
    my @vertical;
    my $x = 0;
    my $y = 0;
    my $max = $nlines;
    $max = $maxlen if $maxlen < $nlines;

    # find text along diagonal L->R
    for (my $char=0; $char < $maxlen; $char++) {
        my @d;
        $x = $char;
        my $y = 0;
        my @origin = ($x, $y);
        map {
            if ($y < $nlines && $x < $maxlen) {
                my $char = substr($text[$y], $x, 1);