view release on metacpan or  search on metacpan

Bioinf.pl  view on Meta::CPAN

# Warning   :
# Keywords  :
# Options   :
# Returns   :
# Argument  :
# Category  :
# Version   : 1.0
#--------------------------------------------------------------------
sub fasta_out_seq_no{
	my($dir, $out_seq_no, $seq_number);
	($dir, $out_seq_no, $seq_number, *array1, *array2)=@_;
	&hash_chk(\%array1);&hash_chk(\%array2);
	%array2    = &hash_substract(*array2, *array1);
	%array_1_2 = &hash_catenate (*array1, *array2);
	&hash_chk(\%array_1_2);
	my($output_file) = "$dir\_$out_seq_no.fas"; 	# " is essential.
	my(@keys1)= keys (%array1);
	my(@keys2)= keys (%array2);
	my(@keys_1_2) = keys (%array_1_2);
	unlink <"$output_file">;						# this is essential as I use &fasta_append
	if (($#keys1+1) > $out_seq_no){					# if out_seq_no is less than structural
	  for ($no = 0; $no < $out_seq_no; $no++){	# appending first seq. set.
		  my($name1) = $keys1[$no];				# array1 first
		  $dir  = &pwd_dir;
		  my($string1) = $array1{$name1};
		  &fasta_append($name1, $string1, $output_file);
	  }
	}else{
	  for ($no1 = 0; $no1  <= $#keys1; $no1++){	# appending first seq. set.
		  my($name1) = $keys1[$no1];				# array1 first
		  $dir  = &pwd_dir;
		  my($string1) = $array1{$name1};
		  &fasta_append($name1, $string1, $output_file);
	  }
	  for ($no2 = 0; $no2  < ($out_seq_no-$#keys1-1); $no2++){	# appending first seq. set.
		  my($name2) = $keys2[$no2];			# array1 first
		  $dir  = &pwd_dir;
		  my($string2) = $array2{$name2};
		  &fasta_append($name2, $string2, $output_file);
	  }
	}
}
#________________________________________________________________________
# Title     : ctime
# Usage     : $Date = &ctime(time);
# Function  : a simple Perl emulation for the well known ctime(3C) function.
# Example   : $Date = &ctime(time);
# Warning   :
# Keywords  :
# Options   :
# Returns   :
# Argument  :
# Category  :
# Version   : 1.0
#--------------------------------------------------------------------
sub ctime{
	 @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	 @MoY = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');

	 local($time) = @_;
	 local($[) = 0;
	 my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);

	 # Determine what time zone is in effect.
	 # Use GMT if TZ is defined as null, local time if TZ undefined.
	 # There's no portable way to find the system default timezone.

	 $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
	 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
		  ($TZ eq 'GMT') ? gmtime($time) : localtime($time);

	 # Hack to deal with 'PST8PDT' format of TZ
	 # Note that this can't deal with all the esoteric forms, but it
	 # does recognize the most common: [:]STDoff[DST[off][,rule]]

	 if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
		  $TZ = $isdst ? $4 : $1;
	 }
	 $TZ .= ' ' unless $TZ eq '';

	 $year += 1900;
	 sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
		$DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
}
#________________________________________________________________________
# Title     : get_time
# Usage     : $Date = &get_time(time);
# Function  : a simple Perl emulation for the well known ctime(3C) function.
# Example   : "Nov30 4:37 1995"
# Warning   :
# Keywords  :
# Options   :
# Returns   :
# Argument  :
# Category  :
# Version   : 1.0
#--------------------------------------------------------------------
sub get_time{
	 @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
	 @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
				'Jul','Aug','Sep','Oct','Nov','Dec');

	 my($time) = @_;
	 local($[) = 0;
	 local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst,$final_time);

	 # Determine what time zone is in effect.
	 # Use GMT if TZ is defined as null, local time if TZ undefined.
	 # There's no portable way to find the system default timezone.

	 $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
	 ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
		  ($TZ eq 'GMT') ? gmtime($time) : localtime($time);

	 # Hack to deal with 'PST8PDT' format of TZ
	 # Note that this can't deal with all the esoteric forms, but it
	 # does recognize the most common: [:]STDoff[DST[off][,rule]]

	 if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
		  $TZ = $isdst ? $4 : $1;
	 }
	 $TZ .= ' ' unless $TZ eq '';

	 $year += 1900;
	 ############### This is the original format ##################
	 #$final_time=sprintf("%s %s% 2d %2d:%02d:%02d %s %4d\n",
	 #            $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);

	 $final_time=sprintf("%s%2d% 2d:%02d %4d\n",
					  $MoY[$mon], $mday, $hour, $min, $year);
	 return(\$final_time);
}


#________________________________________________________________________
# Title     : get_date
# Usage     : @outformat = &get_date;  eg result >  (010595 1-May-1995)
# Function  : returns date: $date6d (6 digit format) and
#             $datec (dd-mmm-yyyy format), Tim's version is 'getdate' in th_lib.pl
# Example   : 30-Nov-1995
# Keywords  : get_present_date,
# Options   :
# Returns   : ref of an array for (1-May-1995 and 010595)
# Argument  :
# Category  :
# Version   : 1.1
#--------------------------------------------------------------------
sub get_date{
	 my($date_alphabet, $date6d);
	 my(@time) = localtime(time);
	 my($ty,$tm,$td) = ($time[5],$time[4],$time[3]);
	 my($year) = '19' . $ty;
	 my($mon) = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$tm];
	 my($day) = $td;
	 if($day < 10){
		  $day = ' ' . $day;
	 }
	 $date_alphabet = $day.'-'.$mon.'-'.$year;
	 $tm++;
	 if($tm < 10){
		  $tm = '0'.$tm;
	 }
	 if($td < 10){
		  $td = '0'.$td;