Acme-Grep2D

 view release on metacpan or  search on metacpan

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

        $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);
                push(@d, $char) if defined $char;
            }
            $x++;
            $y++;
        } 0..$nlines-1;
        unshift(@d, \@origin);
        push(@diagLR, \@d) if @d;
    }

    for (my $line=1; $line < $nlines; $line++) {
        my @d;
        $x = 0;
        my $y = $line;
        my @origin = ($x, $y);
        map {
            if ($y < $nlines && $x < $maxlen) {
                my $char = substr($text[$y], $x, 1);
                push(@d, $char) if defined $char;
            }
            $x++;
            $y++;
        } 0..$nlines-1;
        unshift(@d, \@origin);
        push(@diagLR, \@d) if @d;
    }

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

    for (my $line=1; $line < $nlines; $line++) {
        my @d;
        $x = $maxlen-1;
        my $y = $line;
        my @origin = ($x, $y);
        map {
            if ($y < $nlines && $x >= 0) {
                my $char = substr($text[$y], $x, 1);
                push(@d, $char) if defined $char;
            }
            $x--;
            $y++;
        } 0..$nlines-1;
        unshift(@d, \@origin);
        push(@diagRL, \@d) if @d;
    }

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

    # find text along vertical
    for (my $char=0; $char < $maxlen; $char++) {
        my @d;
        my @origin = ($char, $y);
        push(@d, substr($text[$_], $char, 1)) for 0..$nlines-1;
        unshift(@d, \@origin);
        push(@vertical, \@d);
    }

    # correct LR to make text greppable
    map {
        my ($coords, @text) = @$_;
        my $text = join('', @text);
        $_ = [$text, $coords];
    } @diagLR;

    # correct RL to make text greppable
    map {
        my ($coords, @text) = @$_;
        my $text = join('', @text);
        $_ = [$text, $coords];
    } @diagRL;

    # correct vertical to make text greppable
    map {
        my ($coords, @text) = @$_;
        my $text = join('', @text);
        $_ = [$text, $coords];
    } @vertical;
    $.diagLR   = \@diagLR;
    $.diagRL   = \@diagRL;
    $.vertical = \@vertical;
    $.maxlen = $maxlen;
    $.nlines = $nlines;
    $.text   = \@text;

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

}

=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);

t/01-hoz.t  view on Meta::CPAN

my $text = <<'EOF';

   foobaraboof
raboof
EOF

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

EOF

my $g2d = Acme::Grep2D->new(text => $text);
my @m = $g2d->Grep('foobar');
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);

t/03-lr.t  view on Meta::CPAN

EOF

my $g2d = Acme::Grep2D->new(text => $text);
my @m = $g2d->Grep('foobar');
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);

t/04-rl.t  view on Meta::CPAN

 oo   r
ff
EOF

my $g2d = Acme::Grep2D->new(text => $text);
my @m = $g2d->Grep('foobar');
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';
} @m;
ok($perfect == 4);

t/05-torture.t  view on Meta::CPAN

         p   b   n
          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);


@m = $g2d->Grep(qr(keep\w+));
#print STDERR scalar(@m), "\n";
ok(@m == 1);
ok($g2d->extract($m[0]) eq 'keeper');

@m = $g2d->Grep(qr(j\w+));
$perfect = 0;
map {
    $perfect++ if $g2d->extract($_) eq 'jin';
    $perfect++ if $g2d->extract($_) eq 'jokee';
} @m;
ok($perfect == 2);

@m = $g2d->Grep(qr(\d\.\d));
ok(@m == 2);
$perfect = 0;
map {
    $perfect++ if $g2d->extract($_) eq '1.2';
    $perfect++ if $g2d->extract($_) eq '2.1';
} @m;
ok($perfect == 2);

@m = $g2d->Grep(qr(happy));
ok(@m == 3);
#print STDERR Dumper(\@m);
$perfect = 0;
map {
    $perfect++ if $g2d->extract($_) eq 'happy';
} @m;
ok($perfect == 3);

@m = $g2d->Grep(qr(zebra));
ok(@m == 3);
$perfect = 0;
map {
    $perfect++ if $g2d->extract($_) eq 'zebra';
} @m;
ok($perfect == 3);