view release on metacpan or  search on metacpan

Bioinf.pl  view on Meta::CPAN

# Returns   : the actual days older, so NON-ZERO, otherwise, 0
# Argument  :
# Version   : 1.2
#----------------------------------------------------------------------------
sub if_file_older_than_x_days{
    my($how_old_days);
    my $days=1; # default
    if(@_ < 2){ print "\n# if_file_older_than_x_days needs 2 args\n"; exit; }
    my $file=${$_[0]} || $_[0];
    $days=${$_[1]} || $_[1];
    unless(-s $file){  print "\n# if_file_older_than_x_days: $file does NOT exist\n"; exit; }

    if(lstat($file)){ # to handle Symbolyc link
       print "\n# (i) if_file_older_than_x_days: running lstat\n";
       $how_old_days=(localtime(time- (lstat($file))[9]))[3]; ## should be lstat not stat
    }else{
       print "\n# (i) if_file_older_than_x_days: running stat\n";
       $how_old_days=(localtime(time- (stat($file))[9]))[3]; ## should be lstat not stat
    }
    if($how_old_days > $days and $how_old_days < 10000){
       print "\n# if_file_older_than_x_days: $file is older than $days\n";
       return(\$days);
    }else{
       print "\n# if_file_older_than_x_days: $file is NOT older than $days\n";
       return(0);
    }
}



#________________________________________________________________________
# Title     : array_chk
# Usage     : &array_chk(\@any_array_to_chk);
# Function  : checks if any inputting array is empty or with one element.
# Example   : This is used only with subs which accepts array inputs.
# Warning   :
# Keywords  : array_check
# Options   :
# Returns   : nothing, prints out messages to STDOUT
# Argument  : gets on ref. of array.
# Category  :
# Version   : 1.0
#--------------------------------------------------------------------
sub array_chk{  my(@input)=@{$_[0]};
	if (@input == 0){
	 &caller_info;
	 print "\n >>> $0 \n";
	 print "\n >>> Error: Input array to this subroutine was empty\n", chr(7);
	 print "\n To continue prog. type \'y\', or \'n\' to quit (with enter).\n ---->";
	 $key = ${&yes_or_no};
	 if($key ne 'y'){  print "\n !! Aborting the operation !! \n"; exit(0); }}
	elsif ($#input == 0){
	 print "\n >>> Warn: Input array to this subroutine was only one, O.K ?\n";
	 print "\n >>> It means your input was not an array at all, probable	error\n";
	 &caller_info;
	 #________________________________________________________
	 # Title    : caller_info
	 # Function : tells you calleing programs and sub's information with file, subname, main, etc
	 # Usage    : &caller_info; (just embed anywhere you want to check.
	 #----------------------------------------------------------------------
	 sub caller_info{	    # caller(1), the num. tells you which info you choose
		my($i)=1;
		while(($pack, $file, $line, $subname, $args) = caller($i++)){
		  my($level) = $i-1;
		  print "\n", chr(169)," This sub info was made by \&caller_info subroutine";
		  print "\n ", chr(164)," Package  from => $pack ";
		  print "\n ", chr(164)," Exe. file was => $file ";
		  print "\n ", chr(164)," Line was  at? => $line (in $file)";
		  print "\n ", chr(164)," Name of  sub? => $subname";
		  print "\n ", chr(164)," How many arg? => $args";
		  print "\n ", chr(164)," Level of sub? => $level (1 is for where \&caller_info is )\n\n";
		}
	 }
	 #________________________________________________________
	 #________________________________________________________
	 # Title    : yes_or_no
	 # returns  : ref. of a Scalar for 'y' or 'n'
	 # Usage    : $yes_or_no = ${&yes_or_no};
	 #---------------------------------------------------------
	 sub yes_or_no{
		my($key)=getc;
		if (($key eq 'y') || ($key eq 'Y')){
		  return(\$key);
		}elsif(($key eq 'n') || ($key eq 'N')){
		  return(\$key);
		}else{
		  print chr(7), "\n Type only (y or n) ----> ";
		  &yes_or_no;
		}
	 }
	 #________________________________________________________
	}
}

#________________________________________________________________________
# Title     : hash_chk
# Usage     : &hash_chk(\%input_hash);
# Function  : checks hash input of any subroutine.
# Example   :
# Warning   :
# Keywords  : hash_check
# Options   :
# Returns   :
# Argument  :
# Category  :
# Version   : 1.0
#--------------------------------------------------------------------
sub hash_chk{ my(@input)=%{$_[0]};
	if ( @input == 0){
	  &caller_info;
	  print "\n >>> $0 \n", chr(7);
	  print "\n >>> Error: Input hash to this subroutine was empty\n";
	  print "\n To continue prog. type \'y\', or \'n\' to quit (with enter).\n ----> ";
	  $key = ${&yes_or_no};
	  if($key ne 'y'){
		 exit(0);
	  }
	}elsif ( @input == 1){
	  &caller_info;
	  print "\n >>> $0 \n", chr(7);
	  print "\n >>> Warn: Input hash to this subroutine was only one, O.K ?\n";
	  print "\n To continue prog. type \'y\', or \'n\' to quit (with enter).\n ----> ";
	  $key = &{&yes_or_no};