view release on metacpan or  search on metacpan

Bioinf.pm  view on Meta::CPAN

		  elsif($lib[$j]=~/^ {0,2}sub +$each_sub\b *\{[\t ]*#* *(.*)/ ){
                      print "\n# (WARN) $0: $file[$i] does not have headbox(jong\' lib style)\n";
                      print "\n#    I will assume you do NOT have it in your sub lib. All subs will have 1.0 version no.\n";
                      if($1=~/(\d+\.?\d*)/){
                           $version_number=$ver=$1;
                      }
                      $out_subs{"$each_sub"}.="$lib[$j]";
                      $j++; $title_found='';
                      until($lib[$j]=~/^\}/){
                           $out_subs{"$each_sub"}.="$lib[$j]";  $j++;
                      }
                      $out_subs{"$each_sub"}.="$lib[$j]";  ## to fetch '}'
                      $j++;
                      goto SPLICE2; # it is in a previous line
                  }
	     }
	     if($char_opt =~/[rt]/i){
		     $left_out{$file[$i]}.=$lib[$j]; ## Remnant file content of the operation
	     }
	}
	close LIB_FILE;
	if($char_opt =~/t/i){
             open (LIB_FILE, ">$file[$i]");
	     print LIB_FILE $left_out{$file[$i]};
	     close LIB_FILE;
	}

   }#""""""""""""" end of for (@file)

   $no_of_subs_fetched = keys %out_subs;
   if(@array>0){
       print chr(7), chr(7);
       print "\n# Following subs are not found in \"", "@file","\"\n  ", "@array", "\n\n";
   }

   if($char_opt =~ /r/i){
       return( \%left_out ); # to get the files sans the subroutines.
   }else{
       return( \%hash2 );
   }
}


#________________________________________________________________________
# Title     : update_subroutines
# Usage     : &update_subroutines(\@file, \%fetched_subs);
# Function  : replaces subroutines of given file(s) with supplied subs.
#             If the given subroutine versions are not higher than the
#             ones in the program, no upgrade would happen.
#             This can read version information from '# Version  : 1.0' line
#              or sub xxxxx{  # Version : 1.0   line
# Example   : &update_subroutines($file, \%fetched_subs);
# Warning   :
# Keywords  : upgrade_subroutines,
# Options   :
# Returns   :
# Argument  :
# Category  :
# Version   : 2.8
#--------------------------------------------------------------------
sub update_subroutines{
  #"""""""""""""""""< handle_arguments{ head Ver 4.1 >"""""""""""""""""""
  my(@A)=&handle_arguments(@_);my($num_opt)=${$A[7]};my($char_opt)=${$A[8]};
  my(@hash)=@{$A[0]};my(@file)=@{$A[4]};my(@dir)=@{$A[3]};my(@array)=@{$A[1]};
  my(@string)=@{$A[2]};my(@num_opt)=@{$A[5]};my(@char_opt)=@{$A[6]};
  my(@raw_string)=@{$A[9]};my(%vars)=%{$A[10]};my(@range)=@{$A[11]};
  my($i,$j,$c,$d,$e,$f,$g,$h,$k,$l,$m,$n,$o,$p,$q,$r,$s,$t,$u,$v,$w,$x,$y,$z);
  if($debug==1){print "\n\t\@hash=\"@hash\"
  \@raw_string=\"@raw_string\"\n\t\@array=\"@array\"\n\t\@num_opt=\"@num_opt\"
  \@char_opt=\"@char_opt\"\n\t\@file=\"@file\"\n\t\@string=\"@string\"\n" }
  #""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # (1) %subs_from_lib is a default variable from &handle_arguments
  #______________________________________________________
  my %subs_from_lib=%{&merge_hash(@hash)};
  my @subs_from_lib = keys %subs_from_lib;            # @subs_from_lib are subroutine names

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~``
  # update_subroutines can handle many input perl files
  #__________________________________________________________________
  for($i=0; $i < @file; $i++){
        open(TARGET_FILE, "<$file[$i]") or die  "\n $file[$i]  <- $! \n";

        #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~`
        # (2) Reading in all the perl_file_lines into arrary
        #___________________________________________________
	my @perl_file_lines =<TARGET_FILE>;
	close TARGET_FILE;
        my (%temp, %temp_with_version_info, %final_out, %latest_sub_hash, $VER, $sub_name,$ver,
	    $first_line, @found_subs, $sub_name2);

	#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        # (3) checking each line in @perl_file_lines of target file with already provided %subs_from_lib of subroutines
        #____________________________________________________________________________________________________
        for($j=0; $j < @perl_file_lines; $j++){
	      my ($loop_count, $title_found, $sub_name,
                  $title_found, $sub_found, $VER, $ver);
              if( $perl_file_lines[$j]=~/^(#\!\/\w+.+perl)/){ ## first line match
                  $final_out{$file[$i]}.=$perl_file_lines[$j];
		  $j++;
		  print "\n# (INFO) Good! I found the very first line, $1 !!\n";
              }
              #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              # (4) Putting update information  line-> # Last Update by ./update_subrout
              #______________________________________________________________________________
              if($perl_file_lines[$j]=~/^# *last *update */i){
                  $final_out{$file[$i]}.="# Last Update by $0: ".`date`;
                  $j++;
              }elsif($perl_file_lines[$j+1]=~/^# *last *update */i){
                  $final_out{$file[$i]}.="$perl_file_lines[$j]# Last Update by $0: ".`date`;
                  $j+=2;
              }elsif($j < 4 and (!$perl_file_lines[$j]=~/^# *last *update */i) ){
                  $final_out{$file[$i]}.="# Last Update by $0: ".`date`.$perl_file_lines[$j];
                  $j++;
              }

	      if($perl_file_lines[$j]=~/^__END__/){ last } ## this is to stop $0 reading in junk sub calls after __END__ line

              #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~````
              # (5) this is to read non-subroutine related stuff