Acme-Grep2D
view release on metacpan or search on metacpan
lib/Acme/Grep2D.pm view on Meta::CPAN
.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>
lib/Acme/Grep2D.pm view on Meta::CPAN
# 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;
lib/Acme/Grep2D.pm view on Meta::CPAN
}
=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;
lib/Acme/Grep2D.pm view on Meta::CPAN
=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);
lib/Acme/Grep2D.pm view on Meta::CPAN
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);
lib/Acme/Grep2D.pm view on Meta::CPAN
=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.
lib/Acme/Grep2D.pm view on Meta::CPAN
=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.
lib/Acme/Grep2D.pm view on Meta::CPAN
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.
lib/Acme/Grep2D.pm view on Meta::CPAN
=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.
lib/Acme/Grep2D.pm view on Meta::CPAN
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.
lib/Acme/Grep2D.pm view on Meta::CPAN
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.
lib/Acme/Grep2D.pm view on Meta::CPAN
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.
my $g2d = Acme::Grep2D->new(text => $text);
my @m = $g2d->Grep('foobar');
my $found = 0;
my $correct = 0;
map {
$correct++ if $_->[0] == 6;
} @m;
ok($correct == 3);
map {
my ($length, $x, $y, $dx, $dy) = @$_;
$found++ if $x==3 && $y==1;
$found++ if $x==13 && $y==1;
$found++ if $x==5 && $y==2;
} @m;
ok($found == 3);
t/02-vert.t view on Meta::CPAN
print STDERR $text;
#print STDERR Dumper(\@m);
my $found = 0;
my $correct = 0;
map {
$correct++ if $_->[0] == 6;
} @m;
ok($correct == 2);
map {
my ($length, $x, $y, $dx, $dy) = @$_;
$found++ if $x==0 && $y==1 && $dy==1;
$found++ if $x==2 && $y==7 && $dy==-1;
} @m;
ok($found == 2);
print STDERR $text;
#print STDERR Dumper(\@m);
my $found = 0;
my $correct = 0;
map {
$correct++ if $_->[0] == 6;
} @m;
ok($correct == 3);
map {
my ($length, $x, $y, $dx, $dy) = @$_;
$found++ if $x==2 && $y==0 && $dx==1 && $dy==1;
$found++ if $x==11 && $y==1 && $dx==1 && $dy==1;
$found++ if $x==14 && $y==8 && $dx==-1 && $dy==-1;
} @m;
ok($found == 3);
print STDERR $text;
#print STDERR Dumper(\@m);
my $found = 0;
my $correct = 0;
map {
$correct++ if $_->[0] == 6;
} @m;
ok($correct == 4);
map {
my ($length, $x, $y, $dx, $dy) = @$_;
$found++ if $x==11 && $y==1 && $dx==-1 && $dy==1;
$found++ if $x==1 && $y==7 && $dx==1 && $dy==-1;
$found++ if $x==0 && $y==7 && $dx==1 && $dy==-1;
$found++ if $x==5 && $y==5 && $dx==1 && $dy==-1;
} @m;
ok($found == 4);
my $perfect = 0;
map {
$perfect++ if $g2d->extract($_) eq 'foobar';
t/05-torture.t view on Meta::CPAN
p r n
a a
yppah b
EOF
my $g2d = Acme::Grep2D->new(text => $text);
my @m = $g2d->Grep(qr(f\w+));
print STDERR $text;
print STDERR Dumper(\@m);
map {
my ($length, $x, $y, $dx, $dy, $ref) = @$_;
print STDERR $$ref, "\n";
} @m;
my $found = 0;
map {
my ($length, $x, $y, $dx, $dy, $ref) = @$_;
$found++ if $length==8 && $x==0 && $y==0 && $dx==1 && $dy==0;
$found++ if $length==3 && $x==8 && $y==3 && $dx==-1 && $dy==1;
$found++ if $length==2 && $x==8 && $y==3 && $dx==1 && $dy==-1;
} @m;
ok($found == 3);
my $perfect = 0;
map {
$perfect++ if $g2d->extract($_) eq 'finderkb';
$perfect++ if $g2d->extract($_) eq 'fur';
$perfect++ if $g2d->extract($_) eq 'fx';
} @m;
ok($perfect == 3);
( run in 1.116 second using v1.01-cache-2.11-cpan-65fba6d93b7 )