#!/usr/bin/perl -w # Program name : sch3.pl # Written by Myst Shen # Version 2.3, last modified on Sep. 5, 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.3\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 vertically #-------------------- ------------------- ------------------- -------------------
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; }
#-------------------- ------------- ----------------- ----------- -----------
# The slant part is divided into two sections.
#-------------------- ------------- ----------------- ----------- -----------
sub slant { my (@indices2, $y, $idx2, $idx3); max_len; line_num; if ($x == -1) { $y = -1; } elsif ($x == 1) { $y = 0; }
# first section where strings begin at the first line
for (my $i=0; $i<$maxlen; $i++) { my $str1 = " "; my $str2 = ""; my $j = $i; seek DATA,0,0; while (<DATA>) { s/\s+$//; $_ .= " "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
-1 ; } elsif ($x == 1) { $idx2 = $i + $idx; } last if ($idx == -1); push (@indices2, "$idx2,$idx"); $pos += $idx +1; } }
# second section where strings begin at the first or last column
for (my $i=1; $i<=$count-2; $i++) { my $str1 = " "; my $str2 = ""; my $j = 0; my $num = 0; seek DATA,0,0; while (<DATA>) { s/\s+$//;
$_ .= " "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 -1 ; } 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);
|