Cap3 documentation.

    &opt_default(qsub=>'off',input=>"file",output=>"STDOUT",outdir=>"cap3_clusters",filename=>'cap3.res',delete=>"on");
    my @param;
    my @tmp;
    
    foreach(@_){
        if(/[abcdefgmnopsuvx]\=\d/){
	    push(@param,$_);
        }
        else{
            push(@tmp,$_);
        }
    }
    
    @_=@tmp;

    my @args=opt_get(@_);
    
    my $qsub=&opt_val("qsub");
    my $input=&opt_val("input");
    my $output=&opt_val("output");
    my $outdir=&opt_val("outdir");
    my $filename=&opt_val("filename");
    my $delete=&opt_val("delete");
    my $data;
    my $seq;
    my %opt;
    my $param;
    my $num;
    my $output_file;
    $output_file = "> ".$output if($output ne "STDOUT");

    my @file;

    $data=shift @args;

    
    $opt{a}=&opt_val("a");
    $opt{b}=&opt_val("b");
    $opt{c}=&opt_val("c");
    $opt{d}=&opt_val("d");
    $opt{e}=&opt_val("e");
    $opt{f}=&opt_val("f");
    $opt{g}=&opt_val("g");
    $opt{m}=&opt_val("m");
    $opt{n}=&opt_val("n");
    $opt{o}=&opt_val("o");
    $opt{p}=&opt_val("p");
    $opt{s}=&opt_val("s");
    $opt{u}=&opt_val("u");
    $opt{v}=&opt_val("v");
    $opt{x}=&opt_val("x");

    foreach(sort keys(%opt)){
	next if($opt{$_} eq '');
	push(@param,$_.'=');
	push(@param,$opt{$_});
    }
    $param=join(' ',@param);


    if(-d $data){

	opendir(PADIR,$data);
	unlink(".","..");
	@file = readdir(PADIR);
	
	foreach(@file){
	    msg_send("cap3 $_\n ");
	    system("cap3 $data/$_ $param > $_.cap");
		    
	    if($delete eq "on"){
		unlink("$data/$_.cap.ace");
		unlink("$data/$_.cap.contigs.links");
		unlink("$data/$_.cap.contigs.qual");
		unlink("$data/$_.cap.contigs");
		unlink("$data/$_.cap.info");
		unlink("$data/$_.cap.singlets");
		
	    }
	   &msg_send('.');
	}

    }else{

	system("cap3 $data $param > $filename");

	if($delete eq "on"){
	    unlink("$data.cap.ace");
	    unlink("$data.cap.contigs.links");
	    unlink("$data.cap.contigs.qual");
	    unlink("$data.cap.contigs");
	    unlink("$data.cap.info");
	    unlink("$data.cap.singlets");
	}
    }
    
    return ("$data $param");
}    


sub _makegaplist{
  
  mkdir("gaplist",0755);
 
  my $final = 0;
  my $final2 = 0;
  
  &opt_default(g_length=>'1');
  my @args=opt_get(@_);
  my $file_or_dir_name = shift @args;
  my $file_or_dir;
  my $gaplength = &opt_val('g_length');
  
  if(-d $file_or_dir_name == 1){
    $file_or_dir = "dir";
  }else{
    $file_or_dir = "file";
  }
  
  while($final >= 0 && $file_or_dir eq "dir"){
    msg_send(".");
    if(&directory($final,$file_or_dir_name) eq "enddirectory"){
      last;
    }
    &writefile(&directory($final,$file_or_dir_name),$file_or_dir_name,$gaplength);
    $final ++;
  }

  while($final2 >= 0 && $file_or_dir eq "dir"){
    msg_send(".");
    if(&directory($final2,$file_or_dir_name) eq "enddirectory"){
      last;
    }
    &writefile3(&directory($final2,$file_or_dir_name),$file_or_dir_name,$gaplength);
    $final2 ++;
  }
  
  if($file_or_dir eq "file"){
    msg_send(".");
    &writefile2($file_or_dir_name,$gaplength);
  }
}



#############################################
######       open folder sub           ######
#############################################

sub directory{
  my(@file1,$k,$dust);
  my $file_or_dir_name_5 = $_[1];
  
  $k = $_[0];
  @file1 = ();
  opendir(DIR, "$file_or_dir_name_5") or die;
  
  
  @file1 = sort readdir(DIR);
  $dust = shift(@file1);
  $dust = shift(@file1);
  push(@file1,"enddirectory");
  
  closedir(DIR);
  return $file1[$k];
}



sub gapgap{
  my($number, $g_count,$gapcount2);
  my($count4,@sequence);
  my($count3, @judge3);
  my(@kai_seq,@kai_judge,$gap1,$d,$d2,$f,@result,$long,$gaps,$c,$id2,$id,@newresult,$sortresult,$oldsortresult,@newsort);

  $number = 0;
  $g_count = 0;
  $gapcount2 = $_[1];
  my $file_or_dir_name_2 = $_[2];
  
  $count4 = 0;
  @sequence = ();
  
  $count3 = 0;
  @judge3 = ();

  $gap1 = $_[0];
  $gaps = "-" x $_[3];
  $d = 0;
  $d2 = 0;

  open(FILE,"$file_or_dir_name_2/$gapcount2");
  
  while(<FILE>){
    $number ++;
    if($number > 4){
      
      
      if($_ =~ /\-/){
        $g_count ++;
        ##g_count
      }
      
      
      if($_ =~ /\-/){
        $sequence[$count4] = $_;
        $count4 ++;
        ##@sequence
      }
      
     
      if($_ =~ /\-/){
        $judge3[$count3] = 0;
      if($_ =~ / \-/){
        $judge3[$count3] = 1;
      }
        $count3 ++;
       
      }
    }  
  }
  close FILE;
  
  
  
  for($d = $g_count;$d > 0;$d --){
    $long = length($sequence[$d-1]);
    if(substr($sequence[$d-1],$long-2,1) eq "-" && $judge3[$d] == 1){
    $sequence[$d] =~ s/[^\-]//g;
      $sequence[$d-1] .= $sequence[$d]; 
      $sequence[$d] = '';
      
    }
  }
  
  for($d2 = 0;$d2 <= $g_count;$d2 ++){
    if($sequence[$d2] =~ /$gaps/){
      for($f = 0;$f < length($sequence[$d2]); $f++){
        $id2 = substr($sequence[$d2],$f,1);
        if($id2 eq "+"){
          push(@result,$id);
          $id = '';
          last;
        }
        $id .= $id2;
      }
    }
  }

  @newresult = sort @result;
  
  foreach $sortresult (@newresult){
    if($oldsortresult ne $sortresult){
      push(@newsort,$sortresult);
      $oldsortresult = $sortresult;
    }
  }
  
  push(@newsort,"//");
  return $newsort[$gap1];
}




#########################################################
######                 save id sub                 ######
#########################################################

sub saveid{
  my($savesequence,$sequence_frag,$loadid,$id2);
  $savesequence = '';
  $loadid = $_[0];
  $id2 = $_[1];
  my $file_or_dir_name_3 = $_[2];
  
  open(FILE,"$file_or_dir_name_3/$id2");
  
  while(<FILE>){
    if($_ =~ /^$loadid/){
      $sequence_frag = $_;
      $sequence_frag =~ s/$loadid//g;
      $sequence_frag =~ s/[^\-A-Z\-]//g;
      $savesequence = $savesequence.$sequence_frag;
    }
  }
  ##$savesequence = $loadid . "," . $savesequence;
  $savesequence = length($savesequence);
  return $savesequence;
  close FILE;
}




#######################################################
######               save all id sub             ######
#######################################################

sub save_allid{
  my(@save_allsequence,$sequence_allfrag,$load_allid,$judge,$allid);
  $load_allid = $_[0];
  $allid = $_[1];
  $judge = 0;
  @save_allsequence = ();
  
  my $file_or_dir_name_4 = $_[2];
  
  open(FILE,"$file_or_dir_name_4/$allid");
 
  while(<FILE>){
    if($_ =~ /is in/){
      $sequence_allfrag = $_;
      $sequence_allfrag =~ s/\+/,/g;
      $sequence_allfrag =~ s/\- /,/g;
      $sequence_allfrag =~ s/[^\dA-Z,]//g;
      
      $sequence_allfrag =~ s/,$//g;
      push(@save_allsequence,$sequence_allfrag);
    }
  }
  foreach(@save_allsequence){
    if($_ =~ /$load_allid/){
      return $_;
      $judge = 1;
      last;
    }
  }
  if($judge == 0){
    return "kara";
  }
  close FILE;
}
  



###########################################
######          write file sub       ######
###########################################
sub writefile{
  my($f7,$bb,$uz,$new,$old,$joint,$dara,$which_file_dir,$frag,$g_length,$dirname,@frag2,@frag3,@frag4,@frag5,@frag6,@frag7);
  $new = $_[0];$dirname = $_[1];$g_length = $_[2];
  $old = $new;
  $dara = 0;

  my @temp = split(/\./,$old);
  my $dust = shift(@temp);
  @temp = ('gaplist',@temp,'gap');
  $old = join('.',@temp);
  
  open(FILE,"$dirname/$new");
  
  while(<FILE>){
    if($_ =~ /consensus/){
      last;
    }
    if($_ =~ /\+/){
      $frag = $_;
      $frag =~ s/[^\dA-Z\+]//g;
      if(substr($frag,-1,1) eq "+"){
        push(@frag2,$frag);
      }
    }
  }
  close FILE;
  
  $joint = join("",@frag2);
  @frag3 = split(/\+/,$joint);
  @frag4 = sort @frag3;
  
  foreach(@frag4){
    $_ =~ s/\+$//g;
    push(@frag5,$_);
  }
  
  foreach(@frag5){
    if($dara ne $_){
      push(@frag6,$_);
    }
    $dara = $_;
  }
 
  open(W_FILE, ">> gaplist/$old");
  
  for($uz = 0;$uz < 100;$uz ++){
    $bb = &gapgap($uz,$new,$dirname,$g_length);
    
    if($bb eq "//"){
      last;
    }
    
    $bb = &save_allid($bb,$new,$dirname);
    
    if($bb ne "kara"){
      my @list = split(/,/,$bb);
      my @newlist = sort {&saveid($b,$new,$dirname) <=> &saveid($a,$new,$dirname)} @list;
      push(@frag7,@newlist);
      $bb = join(',',@newlist);
      print W_FILE $bb;
      print W_FILE ",";
      print W_FILE "\n";
    }
  }
  close W_FILE;
}



sub writefile3{
  my($f7,$bb,$uz,$new,$old,$joint,$dara,$which_file_dir,$frag,$g_length,$dirname,@frag2,@frag3,@frag4,@frag5,@frag6,@frag7);
  $new = $_[0];$dirname = $_[1];$g_length = $_[2];
  $old = $new;
  $dara = 0;

  my @temp = split(/\./,$old);
  my $dust = shift(@temp);
  @temp = ('gaplist',@temp,'gap');
  $old = join('.',@temp);
  
  open(FILE,"$dirname/$new");
  
  while(<FILE>){
    if($_ =~ /consensus/){
      last;
    }
    if($_ =~ /\+/){
      $frag = $_;
      $frag =~ s/[^\dA-Z\+]//g;
      if(substr($frag,-1,1) eq "+"){
        push(@frag2,$frag);
      }
    }
  }
  close FILE;
  
  $joint = join("",@frag2);
  @frag3 = split(/\+/,$joint);
  @frag4 = sort @frag3;
  
  foreach(@frag4){
    $_ =~ s/\+$//g;
    push(@frag5,$_);
  }
  
  foreach(@frag5){
    if($dara ne $_){
      push(@frag6,$_);
    }
    $dara = $_;
  }
 
  open(W_FILE, ">> gaplist/$old");
  
  for($uz = 0;$uz < 100;$uz ++){
    $bb = &gapgap($uz,$new,$dirname,$g_length);
    
    if($bb eq "//"){
      last;
    }
    
    $bb = &save_allid($bb,$new,$dirname);
    
    if($bb ne "kara"){
      my @list = split(/,/,$bb);
      my @newlist = sort {&saveid($b,$new,$dirname) <=> &saveid($a,$new,$dirname)} @list;
      push(@frag7,@newlist);
      $bb = join(',',@newlist);
    }
  }
  $f7 = join(",",@frag7);
  foreach(@frag6){
    if($f7 !~ /$_/){
      print W_FILE $_;
      print W_FILE ",";
      print W_FILE "\n";
    }
  }
  close W_FILE;
}



sub writefile2{
  my($f7,$bb,$uz,$old,$joint,$dara,$which_file_dir,$frag,$g_lenght,$dirname,@frag2,@frag3,@frag4,@frag5,@frag6,@frag7);
  my $new = $_[0];
  my $g_length = $_[1];
  $old = $new;
  $dara = 0;

  my @filemake = split(/\//,$old);
  $old = pop(@filemake);
  my @temp = split(/\./,$old);
  my $dust = shift(@temp);
  @temp = ('gaplist',@temp,'gap');
  $old = join('.',@temp);
  
  open(FILE,"$new");
   
  while(<FILE>){
    if($_ =~ /consensus/){
      last;
    }
    if($_ =~ /\+/){
      $frag = $_;
      $frag =~ s/[^\dA-Z\+]//g;
      if(substr($frag,-1,1) eq "+"){
        push(@frag2,$frag);
      }
    }
  }
  close FILE;
  
  $joint = join("",@frag2);
  @frag3 = split(/\+/,$joint);
  @frag4 = sort @frag3;
  foreach(@frag4){
    $_ =~ s/\+$//g;
    push(@frag5,$_);
  }
  
  foreach(@frag5){
    if($dara ne $_){
      push(@frag6,$_);
    }
    $dara = $_;
  }
 
  open(W_FILE, ">> gaplist/$old");
  ##print W_FILE $new;
  ##print W_FILE "\n";
  
  for($uz = 0;$uz < 100;$uz ++){
    $bb = &gapgap2($uz,$new,$g_length);
    
    if($bb eq "//"){
      last;
    }
    
    $bb = &save_allid2($bb,$new);
    
    if($bb ne "kara"){
      my @list = split(/,/,$bb);
      my @newlist = sort {&saveid2($b,$new) <=> &saveid2($a,$new)} @list;
      push(@frag7,@newlist);
      $bb = join(',',@newlist);
      print W_FILE $bb;
      print W_FILE ",";
      print W_FILE "\n";
    }
  }
  print W_FILE "\n";
  $f7 = join(",",@frag7);
  foreach(@frag6){
    if($f7 !~ /$_/){
      print W_FILE $_;
      print W_FILE ",";
      print W_FILE "\n";
    }
  }
  close W_FILE;
}

sub gapgap2{
  my($number, $g_count,$gapcount2);
  my($count4,@sequence);
  my($count3, @judge3);
  my(@kai_seq,@kai_judge,$gap1,$d,$d2,$f,@result,$long,$gaps,$c,$id2,$id,@newresult,$sortresult,$oldsortresult,@newsort);
  
  $number = 0;
  $g_count = 0;
  $gapcount2 = $_[1];
  
  $count4 = 0;
  @sequence = ();
  
  $count3 = 0;
  @judge3 = ();
  
  $gap1 = $_[0];
  $gaps = "-" x $_[2];
  $d = 0;
  $d2 = 0;
  
  open(FILE,"$gapcount2");
  
  while(<FILE>){
    $number ++;
    if($number > 4){
      
      
      if($_ =~ /\-/){
        $g_count ++;
        ##g_count
      }
      
      
      if($_ =~ /\-/){
        $sequence[$count4] = $_;
        $count4 ++;
      
      }
      
     
      if($_ =~ /\-/){
        $judge3[$count3] = 0;
      if($_ =~ / \-/){
        $judge3[$count3] = 1;
      }
        $count3 ++;
     
      }
    }  
  }
  close FILE;
  
  
  
  for($d = $g_count;$d > 0;$d --){
    $long = length($sequence[$d-1]);
    if(substr($sequence[$d-1],$long-2,1) eq "-" && $judge3[$d] == 1){
    $sequence[$d] =~ s/[^\-]//g;
      $sequence[$d-1] .= $sequence[$d]; 
      $sequence[$d] = '';
      
    }
  }
  
  for($d2 = 0;$d2 <= $g_count;$d2 ++){
    if($sequence[$d2] =~ /$gaps/){
      for($f = 0;$f < length($sequence[$d2]); $f++){
        $id2 = substr($sequence[$d2],$f,1);
        if($id2 eq "+"){
          push(@result,$id);
          $id = '';
          last;
        }
        $id .= $id2;
      }
    }
  }

  @newresult = sort @result;
  
  foreach $sortresult(@newresult){
    if($oldsortresult ne $sortresult){
      push(@newsort,$sortresult);
      $oldsortresult = $sortresult;
    }
  }
  
  push(@newsort,"//");
  return $newsort[$gap1];
}


sub saveid2{
  my($savesequence,$sequence_frag,$loadid,$id2);
  $savesequence = '';
  $loadid = $_[0];
  $id2 = $_[1];

    open(FILE,"$id2");

  
  while(<FILE>){
    if($_ =~ /^$loadid/){
      $sequence_frag = $_;
      $sequence_frag =~ s/$loadid//g;
      $sequence_frag =~ s/[^\-A-Z\-]//g;
      $savesequence = $savesequence.$sequence_frag;
    }
  }
  ##$savesequence = $loadid . "," . $savesequence;
  $savesequence = length($savesequence);
  return $savesequence;
  close FILE;
}



sub save_allid2{
  my(@save_allsequence,$sequence_allfrag,$load_allid,$judge,$allid);
  $load_allid = $_[0];
  $allid = $_[1];
  $judge = 0;
  @save_allsequence = ();

  open(FILE,"$allid");


  while(<FILE>){
    if($_ =~ /is in/){
      $sequence_allfrag = $_;

      $sequence_allfrag =~ s/\+/,/g;
      $sequence_allfrag =~ s/\- /,/g;
      $sequence_allfrag =~ s/[^\dA-Z,]//g;

      ##$sequence_allfrag =~ s/[^\-\dA-Z\+]//g;
      ##$sequence_allfrag =~ s/\+/,/g;

      $sequence_allfrag =~ s/,$//g;
      push(@save_allsequence,$sequence_allfrag);
    }
  }
  foreach(@save_allsequence){
    if($_ =~ /$load_allid/){
      return $_;
      $judge = 1;
      last;
    }
  }
  if($judge == 0){
    return "kara";
  }
  close FILE;
}



sub DESTROY {
    my $self = shift;
}

1;


__END__
## Below is the stub of documentation for your module. You better edit it!
    
=head1 NAME

G::Tools::Cap3 - Perl extension for blah blah blah

=head1 SYNOPSIS

  use G::Tools::Cap3;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for G::Tools::Cap3 was created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

=head1 AUTHOR

A. U. Thor, a.u.thor@a.galaxy.far.far.away

=head1 SEE ALSO

perl(1).

=cut

}

new

description

top

sub new {

    my $pkg = shift;
    my $filename = shift;
    my $option = shift;
    my $this;

    return($this);

}

General documentation

No general documentation available.