view release on metacpan or  search on metacpan

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

    my @text = split //, $text;
    return join '', reverse(@text);
}

=head2 B<Grep>

  $g2d->Grep($re);  

Find the regular expression ($re) no matter where it occurs in
text.

The difference from a regular grep is that "coordinate" information
is returned for matches. This is the length of the
found match, x and y coordinates, along with
directional movement information (dx, dy). 
It's easiest to use B<extract> to access matches.

=cut

sub Grep {
    my ($self, $re) = @_;
    my @matches;

    # find things "normally," like a regular grep
    push(@matches, ./grep_h($re));

    # find things in the L->R diagonal vector
    push(@matches, ./grep_lr($re));

    # find things in the R->L diagonal vector
    push(@matches, ./grep_rl($re));

    # find things in the vertical vector
    push(@matches, ./grep_v($re));

    return @matches;
}

sub _ref {
    my ($self, $ref) = @_;
    return \$ref if ref($ref) eq 'SCALAR';
    return \$ref->[0] if ref($ref) eq 'ARRAY';
}

=head2 B<grep_hf>

  @matches = $g2d->grep_hf($re);

Search text normally, left to right.

=cut

sub grep_hf {
    my ($self, $re) = @_;
    my @matches;
    my $n = 0;
    # find things "normally," like a regular grep
    foreach (@{$.text}) {
        my $text = $_;
        while ($text =~/($re)/g) {
            push(@matches, [length($1), _start(\$text,$1), $n, 1, 0, \$_])
        }
        $n++;
    };
    return @matches;
}

=head2 B<grep_hr>

  @matches = $g2d->grep_hf($re);

Search text normally, but right to left.

=cut

sub grep_hr {
    my ($self, $re) = @_;
    my @matches;
    my $n = 0;
    # find things "normally," like a regular grep
    foreach (@{$.text}) {
        my $text = $_;
        $text = ./_reverse($text);
        while ($text =~/($re)/g) {
            push(@matches, 
                [length($1), length($text)-(_start(\$text,$1)+1), 
                $n, -1, 0, \$_]) 
        }
        $n++;
    };
    return @matches;
}

=head2 B<grep_h>

  @matches = $g2d->grep_h($re);

Search text normally, in both directions.

=cut

sub grep_h {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_hf($re));
    push(@matches, ./grep_hr($re));
    return @matches;
}


=head2 B<grep_vf>

  @matches = grep_vf($re);

Search text vertically, down.

=cut

sub grep_vf {
    my ($self, $re) = @_;
    my @matches;
    # find things in the vertical vector
    foreach (@{$.vertical}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        push(@matches, [length($1), $x, _start(\$text, $1), 
            0, 1, \$_]) while ($text =~ /($re)/g);
    }
    return @matches;
}

=head2 B<grep_vr>

  @matches = grep_vr($re);

Search text vertically, up.

=cut

sub grep_vr {
    my ($self, $re) = @_;
    my @matches;
    # find things in the vertical vector
    foreach (@{$.vertical}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        $text = ./_reverse($text);
        push(@matches, [length($1),$x, length($text)-_start(\$text, $1)-1,
            0, -1, \$_]) while ($text =~ /($re)/g);
    }
    return @matches;
}

=head2 B<grep_v>

  @matches = $g2d->grep_v($re);

Search text vertically, both directions.

=cut

sub grep_v {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_vf($re));
    push(@matches, ./grep_vr($re));
    return @matches;
}

=head2 B<grep_rlf>

  @matches = $g2d->grep_rlf($re);

Search the R->L vector top to bottom.

=cut

sub grep_rlf {
    my ($self, $re) = @_;
    my @matches;
    # find things in the R->L diagonal vector
    foreach (@{$.diagRL}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        while ($text =~ /($re)/g) {
            my $off = _start(\$text, $1);
            my $length = length($1);
            push(@matches, [$length, $x-$off, $off+$y, -1, 1, \$_]);
        }
    }
    return @matches;
}

=head2 B<grep_rlr>

  @matches = $g2d->grep_rlr($re);

Search the R->L vector bottom to top.

=cut

sub grep_rlr {
    my ($self, $re) = @_;
    my @matches;
    # find things in the R->L diagonal vector
    foreach (@{$.diagRL}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        $text = ./_reverse($text);
        $x -= length($text);
        $y += length($text);
        $x++;
        $y--;
        while ($text =~ /($re)/g) {
            my $off = _start(\$text, $1);
            my $length = length($1);
            push(@matches, [$length, $x+$off, $y-$off, 1, -1, \$_]);
        }
    }
    return @matches;
}

=head2 B<grep_rl>

  @matches = $g2d->grep_rlf($re);

Search the R->L both directions.

=cut

sub grep_rl {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_rlf($re));
    push(@matches, ./grep_rlr($re));
    return @matches;
}

=head2 B<grep_lrf>

  @matches = $g2d->grep_lrf($re);

Search the L->R top to bottom.

=cut

sub grep_lrf {
    my ($self, $re) = @_;
    my @matches;
    # find things in the L->R diagonal vector
    foreach (@{$.diagLR}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        while ($text =~ /($re)/g) {
            my $off = _start(\$text,$1);
            push(@matches, 
                [length($1), $x+$off, $off+$y, 1, 1, \$_]) 
        }
    }
    return @matches;
}

=head2 B<grep_lrr>

  @matches = $g2d->grep_lrr($re);

Search the L->R bottom to top.

=cut

sub grep_lrr {
    my ($self, $re) = @_;
    my @matches;
    # find things in the L->R diagonal vector
    foreach (@{$.diagLR}) {
        my ($text, $coords) = @$_;
        my ($x, $y) = @$coords;
        $text = ./_reverse($text);
        while ($text =~ /($re)/g) {
            my $off = _start(\$text,$1);
            my $length = length($1);
            $x += length($text);
            $y += length($text);
            $x--;
            $y--;
            push(@matches, 
                [length($1), $x-$off, $y-$off, -1, -1, \$_]) 
        }
    }
    return @matches;
}

=head2 B<grep_lr>

  @matches = $g2d->grep_lr($re);

Search the L->R both directions.

=cut

sub grep_lr {
    my ($self, $re) = @_;
    my @matches;
    push(@matches, ./grep_lrf($re));
    push(@matches, ./grep_lrr($re));
    return @matches;
}

=head2 B<extract>

  $result = $g2d->extract($info);

Extract pattern match described by $info, which is a single return
from B<Grep>. E.g.

  my @matches = $g2d->Grep(qr(foo\w+));
  map {
      print "Matched ", $g2d->extract($_), "\n";
  } @matches;

=cut

sub extract {
    my ($self, $info) = @_;
    my ($length, $x, $y, $dx, $dy) = @$info;
    my @result;
    map {
        push(@result, substr($.text->[$y], $x, 1));
        $x += $dx;
        $y += $dy;
    } 1..$length;
    return join('', @result);
}

sub _start {
    my ($textRef, $one) = @_;
    return pos($$textRef) - length($one);
}

=head2 B<text>

  $textRef = $g2d->text();

Return an array reference to our internal text buffer. This
is for future use. Don't mess with the return, or bad things
may happen.

=cut

sub text {
    my ($self) = @_;
    return $.text;
}

=head1 AUTHOR

X Cramps, C<< <cramps.the at gmail.com> >>

=head1 BUGS

Please report any bugs or feature requests to 
C<bug-acme-grep2d at rt.cpan.org>, or through
the web interface at 
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Acme-Grep2D>.  
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Acme::Grep2D

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Acme-Grep2D>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Acme-Grep2D>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Acme-Grep2D>

=item * Search CPAN

L<http://search.cpan.org/dist/Acme-Grep2D/>

=back