[Perl脚本] 作品3号

#!/usr/bin/perl -w
# Myst Shen, July 10, 2008
#

use strict;
use Term::ANSIColor;

my ($count, $maxlen, %options);

%options = (
    "-h" => \&help,
    "-a" => \&a,
    # "-b" => \&b,
    # "-c" => \&c,
    # "-d" => \&b,
    );

sub help {
    print "usage: sch [option] [string] file\n";
    print "options:\n";
    print "\t-a\tsearch vertically\n";
    print "\t-h\thelp\n";
}

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 a {
    my (@indices, @orderly_idx);
    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 (@indices, "$i,$idx");
            $pos += $idx +1;
        }
    }

    # prepare the letters to be colorized

    foreach my $i (@indices) {
        push (@orderly_idx, $i);
        my $i2 = $i;
        $i =~ s/(.*),(.*)/$1/;
        $i2 =~ s/(.*),(.*)/$2/;
        for (my $p=1; $p<length($ARGV[1]); $p++) {
            $i2 ++;
            push (@orderly_idx,"$i,$i2");
        }
    }

    # print

    seek DATA,0,0;
    my $line_num = 0;
    while (<DATA>) {
        my $matches_num = 0;
        my $ofs = 0;
        my @orderly_idx2 = @orderly_idx;
        foreach my $i (@orderly_idx2) {
            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);

# ./sch -a ABC data_file
1C1A32443A3
A89BA3333B2
B34C43A88C6
C37A87B7B73
012B98C6676
AF9CA0773DP