|
#!/usr/bin/perl -w
# Program name : sch3.pl
# Written by Myst Shen
# version 2.2, Aug.10, 2008
#
use strict;
use Term::ANSIColor;
my ($count, $maxlen, %options, @all_ofs, @all_ofs1, @all_ofs2, @all_ofs3, @orderly_ofs, @same_line_ofs, $x, $x2);
%options = (
"-a" => sub {$x = 0; $x2 = 0},
"-b" => sub {$x = 1; $x2 = 0},
"-c" => sub {$x = -1; $x2 = 0},
"-d" => sub {$x2 = 1},
"-h" => \&help,
"-v" => \&version,
);
sub help {
print "usage: sch3.pl [option] [string] file\n";
print "options:\n";
print "\t-a\tsearch vertically\n";
print "\t-b\tsearch slantly from left to right\n";
print "\t-c\tsearch slantly from right to left\n";
print "\t-d\tsearch vertically and slantly\n";
print "\t-h\thelp\n";
print "\t-v\tversion\n";
exit 0;
}
sub version {
print "sch3.pl version 2.2\n";
exit 0;
}
getopts (\@ARGV, \%options );
sub getopts{
my ($arg, $op);
my ($ARG, $OP) = @_;
foreach $arg (@$ARG) {
if (exists $OP ->{$arg}) {
$op = $OP->{$arg};
&$op();
}
}
}
# get the maximum length of lines
sub max_len {
open(DATA, "$ARGV[2]") or die $!;
$maxlen = 0;
while (<DATA>){
s/\s+$//;
$maxlen = length if (length > $maxlen);
}
return $maxlen;
}
# count the lines
sub line_num {
seek DATA,0,0;
my $count1 = 0;
my $count2 = 0;
while (<DATA>) {
$count1 ++;
if (/^\s*$/) {
$count2 ++;
} else {
$count2 = 0;
}
}
$count = $count1 - $count2;
return $count;
}
# search the string
sub vertical {
my (@indices1);
max_len;
line_num;
for (my $i=0; $i<$maxlen; $i++) {
my $str1 = " ";
my $str2 = "";
seek DATA,0,0;
while (<DATA>) {
$_ .= " "x($maxlen - length($_)) if (length($_) < $maxlen);
$str1 = substr ($_,$i,1);
$str2 .= $str1;
}
my $pos = 0;
while ($pos < length($str2)){
my $idx = index($str2,$ARGV[1],$pos);
last if ($idx == -1);
push (@indices1, "$i,$idx");
$pos += $idx +1;
}
}
# prepare the letters to be colorized
foreach my $i (@indices1) {
push (@all_ofs1, $i);
my $i2 = $i;
$i =~ s/(.*),(.*)/$1/;
$i2 =~ s/(.*),(.*)/$2/;
for (my $p=1; $p<length($ARGV[1]); $p++) {
$i2 ++;
push (@all_ofs1,"$i,$i2");
}
}
my @all_ofs6 = @all_ofs1;
L: foreach my $i (@all_ofs6) {
shift @all_ofs1;
foreach my $j (@all_ofs1) {
next L if ($i eq $j)
}
push (@all_ofs1, $i);
}
return @all_ofs1;
}
sub slant {
my (@indices2, $y, $idx2, $idx3);
max_len;
line_num;
if ($x == -1) {
$y = -1;
}
elsif ($x == 1) {
$y = 0;
}
for (my $i=0; $i<$maxlen; $i++) {
my $str1 = " ";
my $str2 = "";
my $j = $i;
seek DATA,0,0;
while (<DATA>) {
$_ .= " "x($maxlen - length($_)) if (length($_) < $maxlen);
$str1 = substr ($_,$j*$x+$y,1);
$str2 .= $str1;
last if ($j == $maxlen -1);
$j ++;
}
my $pos = 0;
while ($pos < length($str2)){
my $idx = index ($str2, $ARGV[1], $pos);
if ($x == -1) {
$idx2 = $maxlen - $idx - $i;
}
elsif ($x == 1) {
$idx2 = $i + $idx;
}
last if ($idx == -1);
push (@indices2, "$idx2,$idx");
$pos += $idx +1;
}
}
for (my $i=1; $i<=$count-2; $i++) {
my $str1 = " ";
my $str2 = "";
my $j = 0;
my $num = 0;
seek DATA,0,0;
while (<DATA>) {
$_ .= " "x($maxlen - length($_)) if (length($_) < $maxlen);
$num ++;
next if ($num <= $i);
$str1 = substr ($_,$j*$x+$y,1);
$str2 .= $str1;
$j ++;
}
my $pos = 0;
while ($pos < length($str2)) {
my $idx = index ($str2, $ARGV[1], $pos);
if ($x == -1) {
$idx3 = $maxlen - $idx;
}
elsif ($x == 1) {
$idx3 = $idx;
}
my $idx2 = $i + $idx;
last if ($idx == -1);
push (@indices2, "$idx3,$idx2");
$pos += $idx +1;
}
}
# prepare the letters to be colorized
foreach my $i (@indices2) {
push (@all_ofs2, $i);
my $i2 = $i;
$i =~ s/(.*),(.*)/$1/;
$i2 =~ s/(.*),(.*)/$2/;
for (my $p=1; $p<length($ARGV[1]); $p++) {
if ($x == -1) {
$i --;
}
elsif ($x == 1) {
$i ++;
}
$i2 ++;
push (@all_ofs2,"$i,$i2");
}
}
my @all_ofs6 = @all_ofs2;
L: foreach my $i (@all_ofs6) {
shift @all_ofs2;
foreach my $j (@all_ofs2) {
next L if ($i eq $j)
}
push (@all_ofs2, $i);
}
return @all_ofs2;
}
# options
if ($x2 == 0) {
if ($x == 0) {
vertical;
} else {
slant;
}
} else {
vertical;
$x = 1;
slant;
my @all_ofs4 = @all_ofs2;
$x = -1;
slant;
L: for my $p (@all_ofs4) {
for my $q (@all_ofs2) {
next L if ($q eq $p);
}
push (my @all_ofs3, $p);
}
@all_ofs2 = (@all_ofs3, @all_ofs2);
}
# sort the offsets
sub by_order {
my @aa = split (/,/,$a);
my @bb = split (/,/,$b);
return ($aa[0] <=> $bb[0]);
}
L: for my $p (@all_ofs1) {
for my $q (@all_ofs2) {
next L if ($q eq $p);
}
push (@all_ofs3, $p);
}
@all_ofs = (@all_ofs3, @all_ofs2);
for (my $j=0; $j<$count; $j++) {
undef @same_line_ofs;
my @all_ofs4 = @all_ofs;
foreach my $i (@all_ofs4) {
my $i2 = $i;
$i =~ s/(.*),(.*)/$1/;
$i2 =~ s/(.*),(.*)/$2/;
push (@same_line_ofs, "$i,$i2") if ($i2 == $j);
}
my @ofs_sorted = sort by_order @same_line_ofs;
@orderly_ofs =(@orderly_ofs, @ofs_sorted);
}
# print
seek DATA,0,0;
my $line_num = 0;
while (<DATA>) {
my $matches_num = 0;
my $ofs = 0;
my @orderly_ofs2 = @orderly_ofs;
foreach my $i (@orderly_ofs2) {
my $i2 = $i;
$i =~ s/(.*),(.*)/$1/;
$i2 =~ s/(.*),(.*)/$2/;
if ($line_num == $i2) {
$matches_num ++;
print color 'reset';
print substr($_, $ofs, $i-$ofs);
print color 'red';
print substr($_, $i, 1);
$ofs = $i+1;
}
}
if ($matches_num != 0) {
print color 'reset';
print substr($_, $ofs);
} else {
print color 'reset';
print;
}
$line_num ++;
}
close(DATA);
|
