view release on metacpan or  search on metacpan

bin/transferCleaner.pl  view on Meta::CPAN

#!/usr/bin/env perl
# PODNAME: transferCleaner.pl
# ABSTRACT: transfer amino acid LSSs on corresponding nucleotide alignment
# CONTRIBUTOR: Denis BAURAIN <denis.baurain@uliege.be>

use Modern::Perl;
use Getopt::Euclid;

## no critic (RequireLocalizedPunctuationVars)
BEGIN{
    $ENV{Smart_Comments} = $ARGV{-v}
        ? join q{ }, map { '#' x (2 + $_) } 1..$ARGV{-v}
        : q{}
    ;
}
## use critic
use Smart::Comments -ENV;
use Bio::MUST::Core::Utils qw(change_suffix);
use aliased 'Bio::MUST::Apps::HmmCleaner';
use aliased 'Bio::MUST::Core::Ali';
use Path::Class;

### Lauching script...

### INFILE : $ARGV{'<infile>'}

my $ali = Ali->load($ARGV{'<infile>'});

my %log;
my $logfile = file($ARGV{'-log'});
my $fh = $logfile->openr;

my $corg;
my @spans;
while (my $line = <$fh>) {
    chomp $line;
    unless (substr($line,0,1) =~ m/\s/xms) {
        if (defined $corg && @spans > 0) {
            $log{$corg} = [@spans];
            @spans = ();
        }
        $corg = $line;
    } else {
        $line =~ s/\s+//xmsg;
        my ($s,$e) = split "-", $line;
        push @spans, [$s,$e];
    }
}
$log{$corg} = [@spans] if (@spans);

#### %log

for my $seqid (keys %log) {
    my $seq = $ali->get_seq_with_id($seqid);

    for my $span (@{$log{$seqid}}) {
        my $e_nt = (($$span[1]-1)*3)+2;
        my $s_nt = ($$span[0]-1)*3;
        my @indexes = $s_nt..$e_nt;

        for my $pos (@indexes) {
            $seq->edit_seq($pos,1,$ARGV{'-delchar'});
        }
    }
}