#!/usr/bin/perl -s
use strict;
use GenePropAxes;
use UserScriptParams;

###############################################################################
#
sub setup_params {
    my($key, $default, $require, $explain, $example);

    my($param) = UserScriptParams->new();

    #
    $param->set_description("Pattern search against gene-seq");

    #
    $key     = "SPEC";
    $default = "";
    $require = "T"; # "T"rue or else(='optional').
    $explain = "Species";
    $example = "spec1";
    $param->add_param($key, $default, $require, $explain, $example);

    #
    $key     = "PATTERN";
    $default = "";
    $require = "T"; # "T"rue or else(='optional').
    $explain = "patten";
    $example = "patten";
    $param->add_param($key, $default, $require, $explain, $example);

    return $param;
}

###############################################################################
#
sub print_header {
    print '#', join("\t", 'spec', 'name', 'from', 'to', 'dir', 'PAT'), "\n";

    return;
}

###############################################################################
#
sub pattern_search {
    my($spec) = shift;
    my($pat) = shift;

    my(@name_list) = GenePropAxes::get_gene_list($spec);
    foreach my$name (@name_list) {
        my($seq) = GenePropAxes::get_gene_info($spec, $name,
                                               $GenePropAxes::GI_NTSEQ);
        my($len) = length($seq);

        #
        my($dir) = 1;
        while ($seq =~ /($pat)/igo) {
            my($pos) = pos($seq);
            my($str) = $1;
            my($from1) = $pos - length($str) + 1;
            my($to1) = $pos;

            print join("\t", $spec, $name, $from1, $to1, $dir, $str), "\n";
        }

        #
        $dir = -1;
        $seq = reverse($seq);
        $seq =~ tr#CGATcgat#GCTAgcta#;
        while ($seq =~ /($pat)/igo) {
            my($pos) = pos($seq);
            my($str) = $1;
            my($from1) = $len - $pos + 1;
            my($to1) = $from1 + $len - 1;

            print join("\t", $spec, $name, $from1, $to1, $dir, $str), "\n";
        }
    }

	return;
}

###############################################################################
if ($0 eq __FILE__) {
    my($param_ref) = setup_params();

    if ($main::h) {
        $param_ref->print_usage();
        exit(0);
    }

    my($pat) = $main::PATTERN;
    if (!$pat) {
        $param_ref->print_usage();
        exit(0);
    }

    print_header();
    foreach my$spec ($main::SPEC, @ARGV) {
        pattern_search($spec, $pat);
    }
}

###############################################################################
1;#
###############################################################################
