view release on metacpan or  search on metacpan

scripts/polloc_vntrs.pl  view on Meta::CPAN

use Bio::Polloc::RuleIO 1.0501;
use Bio::Polloc::LocusIO;
use Bio::Polloc::Genome;
use Bio::SeqIO;
use List::Util qw(min max);

use Pod::Usage;

# ------------------------------------------------- METHODS
# Output methods
sub csv_header();
sub csv_line($$);
# Advance methods
sub _advance_proto($$); # file, msg
sub advance_detection($$$$); # loci, genomes, Ngenomes, rule
sub advance_group($$$); # locus1, locus2, Nloci
sub advance_extension($$); # group, Ngroups

# ------------------------------------------------- FILES
my $cnf = shift @ARGV;
our $out = shift @ARGV;
my $buildgroups = shift @ARGV;
$buildgroups = '' if $buildgroups =~ /off/i;
my $extendgroups = shift @ARGV;
$extendgroups = '' if $extendgroups =~ /off/i;
my $summarizegroups = shift @ARGV;
$summarizegroups = '' if $summarizegroups =~ /off/i;

scripts/polloc_vntrs.pl  view on Meta::CPAN

     print GCSV "\n";
  }
  close GCSV;
  close GLIST;
}

&_advance_proto("$csv.done","done");


# ------------------------------------------------- SUB-ROUTINES
sub advance_detection($$$$){
   my($loci, $gF, $gN, $rk) = @_;
   our $out;
   &_advance_proto("$out.nfeats", $loci);
   &_advance_proto("$out.nseqs", "$gF/$gN");
}

sub advance_group($$$){
   my($i,$j,$n) = @_;
   our $out;
   &_advance_proto("$out.ngroups", $i+1);
}

sub advance_extension($$){
   my($i, $n) = @_;
   our $out;
   &_advance_proto("$out.next", "$i/$n");
}

sub _advance_proto($$) {
   my($file, $msg) = @_;
   open ADV, ">", $file or die "I can not open the '$file' file: $!\n";
   print ADV $msg;
   close ADV;
}

sub csv_header() {
   return "ID\tGenome\tSeq\tFrom\tTo\tUnit length\tCopy number\tMismatch percent\tScore\t".
		"Left 500bp\tRight 500bp (rc)\tRepeats\tConsensus/Notes\n";
}
sub csv_line($$) {
   my $f = shift;
   my $n = shift;
   $n||= '';
   my $left = $f->seq->subseq(max(1, $f->from-500), $f->from);
   my $right = Bio::Seq->new(-seq=>$f->seq->subseq($f->to, min($f->seq->length, $f->to+500)));
   $right = $right->revcom->seq;
   my $seq;
   $seq = $f->repeats if $f->can('repeats');
   $seq = $f->seq->subseq($f->from, $f->to) unless defined $seq;
   if(defined $seq and $f->strand eq '-'){