Bio::EnsEMBL::Analysis::Tools ConfigUtils
Included librariesPackage variablesGeneral documentationMethods
Toolbar
WebCvsRaw content
Package variables
No package variables defined.
Included modules
Bio::EnsEMBL::Analysis::Tools::Stashes qw ( package_stash )
Bio::EnsEMBL::Utils::Argument qw ( rearrange )
Bio::EnsEMBL::Utils::Exception qw ( verbose throw warning )
Data::Dumper(1)
Data::Dumper(2)
FindBin
PPI
lib " $FindBin ::Bin "
Inherit
Unavailable
Synopsis
No synopsis!
Description
No description!
Methods
append_hrefDescriptionCode
backup_existing_configDescriptionCode
check
No description
Code
config_moduleDescriptionCode
configurationDescriptionCode
exists_in_config
No description
Code
fileDescriptionCode
get_Block
No description
Code
get_Comments
No description
Code
get_Pod
No description
Code
get_Variables
No description
Code
get_X
No description
Code
get_all_keys
No description
Code
get_all_statements
No description
Code
get_all_symbols
No description
Code
get_config_by_name
No description
Code
get_config_hash
No description
Code
get_config_section
No description
Code
get_include_statements
No description
Code
get_package_statement
No description
Code
get_subroutine
No description
Code
new
No description
Code
print
No description
Code
print_keys
No description
Code
result
No description
Code
varnameDescriptionCode
write_configDescriptionCode
Methods description
append_href code    nextTop
  Arg [1]    : Hashref
Arg [2] : opt. String
Example :
Description: appends a new config value (href, aref) to the configuration hash
if Arg[2] is given the new key will be placed in this level / section
Returntype :
Exceptions : none
backup_existing_configcodeprevnextTop
  Example    : $self->backup_existing_config()
Description: tests if the original config file exists, if the file exists it
copies it to a new file and extends the filename by ".bak.X"

Returntype : true/false
config_modulecodeprevnextTop
  Arg [1]    : String describing Class name of config 
Example : $config->config_module("Bio::EnsEMBL::Analysis::Config::Exonerate2Genes");
Description: getter/setter for config name
Returntype : string
Exceptions : none
configurationcodeprevnextTop
  Arg [1]    : Hashref 
Example : $config->configuration(\%config)
Description: getter/setter for the configuration hash exported by config module
Returntype : Hashref
Exceptions : none
filecodeprevnextTop
  Arg [1]    : none
Example : $config->file; print $rf->name();
Description: Returns absolute path to config file
Returntype : string
Exceptions : none
varnamecodeprevnextTop
  Arg [1]    : String
Example : $config->varname($string)
Description: getter/setter for hash-name of the variable used in the config file
Returntype : String
Exceptions : none
write_configcodeprevnextTop
  Example    : $self->write_config() 
Description: writes new config file to disk
package statement, pod and import-method are read out of old config file
and transferred to new config file the comments in the Config hash section
will be lost
Methods code
append_hrefdescriptionprevnextTop
sub append_href {
  my ($self, $href_to_append, $section, $logic_name) = @_ ;     
  
  warning("$logic_name already exists in config file") if ($self->exists_in_config($logic_name));  

  # now walk trough hash and replace at the !!correct!! level  
# but how to we get the correct level ? ? ?
my %new_config = %{ $self->configuration } ; $new_config{$section}{$logic_name} = $href_to_append ; $self->configuration(\%new_config) ;
}
backup_existing_configdescriptionprevnextTop
sub backup_existing_config {
    my ($self) = @_ ;       
   my $backuped_file = $self->file;  
   my $count = 0 ; 
   while ( -e $backuped_file ) {   
     #print "file exists : $backuped_file \n" ;  
$backuped_file = $self->file.".bak.$count" ; $count++; } my $old_file = $self->file; #my $cmd = "cp " . $self->file ." $backuped_file";
#`$cmd`;
open(OLD,"$old_file") || throw(" could not read old config $old_file\n"); my @conf= <OLD> ; close(OLD) ; my $backup_time = `date +%a","%d" "%B" "%T`; unshift (@conf, "\#\n\# this file was backuped on $backup_time\#\n\n"); open(NEW,">$backuped_file") || throw "Could not write to file $backuped_file\n" ; print NEW join("", @conf ) ; close(NEW) ; print "file $old_file backuped + modified to :\n$backuped_file\n" ;
}
checkdescriptionprevnextTop
sub check {
    my ($self)  = @_ ;
  throw ( " you need to hand over a Bio::EnsEMBL::Analysis::Tools::ConfigUtils object") 
  unless ( $self->isa("Bio::EnsEMBL::Analysis::Tools::ConfigUtils")) ;
}
config_moduledescriptionprevnextTop
sub config_module {
  my ($self, $c) =@_ ;  
  if ( $c ) {  
    $self->{_config} = $c; 
    # setenv PERL5LIB /nfs/acari/jhv/lib:${PERL5LIB} 
# load $c;
#
# we could use self->file here
my $d = $c ; $c.=".pm" ; $c=~ s{::}{/}g; require $c; my ($config_href, $varname ) = @{package_stash("$d")}; $self->configuration($config_href) ; $self->varname($varname) ; } return $self->{_config} ;
}
configurationdescriptionprevnextTop
sub configuration {
   my ($self, $c) =@_ ; 
  $self->{_configuration} = $c if $c ; 
  return $self->{_configuration} ;
}
exists_in_configdescriptionprevnextTop
sub exists_in_config {
   my ($self, $name) = @_;   
   $self->check();   

   my @to_check = @{$self->get_all_keys() } ;  
   my %hc ; 
   @hc{@to_check} = 1 ; 
   return 1 if ( exists $hc{$name} ) ; 
   return 0 ;
}
filedescriptionprevnextTop
sub file {
   my ( $self ) = @_ ; 
  (my $path = $self->config_module) =~s/\:\:/\//g;
$path.=".pm"; return $INC{$path} ; } 1;
}
get_BlockdescriptionprevnextTop
sub get_Block {
   my ($self) = @_ ;  
   return $self->{_doc}->find("PPI::Structure::List");
}
get_CommentsdescriptionprevnextTop
sub get_Comments {
   my ($self) = @_ ;  
   return $self->{_doc}->find("PPI::Token::Comment");
}
get_PoddescriptionprevnextTop
sub get_Pod {
    my ($self) = @_ ;  
   return $self->{_doc}->find("PPI::Token::Pod");
}
get_VariablesdescriptionprevnextTop
sub get_Variables {
    my ($self) = @_ ;  
   return $self->{_doc}->find("PPI::Statement::Variable");
}
get_XdescriptionprevnextTop
sub get_X {
   my ($self) = @_ ;  
   #return $self->{_doc}->find("PPI::Structure::Constructor"); 
return $self->{_doc}->find("PPI::Node"); #return $self->{_doc}->find("PPI::Element");
#return $self->{_doc}->find("PPI::Structure::List");
}
get_all_keysdescriptionprevnextTop
sub get_all_keys {
    my ($self) = @_ ;    
  my @keys ; 
  my %tmp = %{$self->configuration};  
  
  my @ak = @{print_keys (\%tmp)} ; 
  my %hc ;    
  @hc{@ak} =1 ;  
  return [keys %hc] ; 
} 

# returns list of all keys which hold an anonymous hash in config 
}
get_all_statementsdescriptionprevnextTop
sub get_all_statements {
   my ($self) = @_ ;    
   my @rs;  
   for my $s (@{$self->{_doc}->find("PPI::Statement")}) {   
     push @rs,$s unless ref($s)=~m/PPI::Statement::/; 
   }
   return\@ rs ;
}
get_all_symbolsdescriptionprevnextTop
sub get_all_symbols {
   my ($self) = @_ ;  
   return $self->{_doc}->find("PPI::Token::Symbol");
}
get_config_by_namedescriptionprevnextTop
sub get_config_by_name {
     my  ($self, $name, $config_href)  = @_ ;    

   # this method can either be called on an object itself 
# $self->get_config_by_name as well as
# in a non oo style for recuriveness
# get_config_by_name( $obj, $name )
my %tmp ; unless ( $config_href ) { %tmp = %{$self->configuration} ; } else { %tmp = %$config_href ; } my $result ; KEY: foreach my $key ( keys %tmp ) { next KEY unless $tmp{$key}; if ( $key eq $name ) { $self->result($tmp{$key}) ; $result = $tmp{$key} ; return $result; } if (ref($tmp{$key}) =~m/HASH/ ){ $self->get_config_by_name($name, $tmp{$key}); } } return $result ;
}
get_config_hashdescriptionprevnextTop
sub get_config_hash {
   my ($self) = @_ ;     

   my $rs ; 
   my $v = $self->varname ;   
   for my $s ( @{$self->get_all_statements} ) {        
     if ($s->first_token=~m/$v/ && $s->first_token->isa("PPI::Token::Symbol")) {  
        # config_hash found : %Config %Databases ...  
throw("statement appears twice in config - error!\n") if $rs ; $rs=$s; } } return $rs ;
}
get_config_sectiondescriptionprevnextTop
sub get_config_section {
    my ($self,$section) = @_ ;   

  my %tmp = %{$self->configuration} ;   
  foreach my $k ( keys %tmp ) {   
    print " get_config_section : $k\tval $tmp{$k}\n" ; 
    if ($k eq $section){
       print "found $k\n" ;  
       return $tmp{$k} ; 
    }
  }
}
get_include_statementsdescriptionprevnextTop
sub get_include_statements {
    my ($self) = @_ ;  
   return $self->{_doc}->find("PPI::Statement::Include");  
} 


# hands back subroutine with $name out of config file  
}
get_package_statementdescriptionprevnextTop
sub get_package_statement {
    my ($self) = @_ ;  
   return $self->{_doc}->find("PPI::Statement::Package");
}
get_subroutinedescriptionprevnextTop
sub get_subroutine {
    my ($self,$name) = @_ ;  

   my @subs = @{$self->{_doc}->find("PPI::Statement::Sub")};
   for my $s ( @subs ) { 
     return $s if ($s->name eq $name); 
   } 
   return undef;
}
newdescriptionprevnextTop
sub new {
    my ($class,@args) = @_;
  my $self = bless {},$class; 
  
  my ($config_module) = rearrange (['CONFIG'], @args);     
   
  $self->config_module($config_module) if $config_module ;  
  $self->{_doc}= PPI::Document->new($self->file) ;    
  #print $self->config_module() . "\n" ;  
#$self->file() ;
#print join("\n" , @{$self->get_Block});
#for my $element ( @{$self->get_X}) {
# print ref($element) . "\t$element\n" ;
#}
#
#my $a = $self->get_subroutine("import") ;
# print join("\n" , @{$self->get_package_statement});
# print join("\n" , @{$self->get_Pod});
# print join("\n" , @{$self->get_Variables});
# print join("\n" , @{$self->get_Comments});
# for my $symbol ( @{$self->get_all_symbols}){
# print $symbol ."\t:". $symbol->raw_type . "\t".$symbol->symbol_type ."\n" ;
# }
# Create a tokenizer for a file, array or string
#my $Tokenizer = PPI::Tokenizer->new( $self->file );
#my $tokens = $Tokenizer->all_tokens;
#while ( my $Token = $Tokenizer->get_token ) {
# print ref($Token) . "\t:$Token\n" ;
#}
# my $c = $self->get_config_hash;
#
# # this is the braced config object %Config = ( ........ )
# my @lists= @{$c->find("PPI::Structure::List")} ;
# throw("there should be only one braced obj in conf...\n") if scalar(@lists) >1;
#
# my $list = $lists[0];
# my @l;
# for my $s (@{$list->find("PPI::Statement::Expression")}) {
# #for my $s (@{$list->find("PPI::Structure::Block")}) {
#
# my @elements = $s->tokens;
# for ( @elements ) {
# print ref($_) . "\t" . $_ . "\n" ;
# }
# }
#
return $self;
}
printdescriptionprevnextTop
sub print {
    my ($self) = @_ ;    

  my $var_name = $self->varname;    

  my $d = Data::Dumper->new([$self->configuration],[( "*var_name" )]);   
  # $d->Purity(1);  
# $d->Terse(1);
$d->Indent(1); $d->Deepcopy(1); my $rep = $d->Dump() ; $rep=~s/\%var_name/\%$var_name/;
return $rep ;
}
print_keysdescriptionprevnextTop
sub print_keys {
   my ($t) = @_ ; 
   my %tmp= %{$t};   
   my @ak ; 
   KEY: foreach my $key ( %tmp ) {    
      next KEY unless $key ;  
      if (ref($tmp{$key}) =~m/HASH/  ){  
         push @ak, @{print_keys($tmp{$key})}; 
      }
     push @ak , $key   if (ref($tmp{$key}) =~m/HASH/) ;  
  }
  return\@ ak;
}
resultdescriptionprevnextTop
sub result {
  my ($self, $r) = @_ ;  
  $self->{_result} = $r if $r ; 
  return $self->{_result};
}
varnamedescriptionprevnextTop
sub varname {
  my ($self, $c) =@_ ; 
  $self->{_varname} = $c if $c ; 
  return $self->{_varname} ;
}
write_configdescriptionprevnextTop
sub write_config {
    my ($self) = @_ ;       
   
   print "backing up old config file if it exists...\n";   

   $self->backup_existing_config() if ( -e $self->file ) ; 

   my @content; 
   push @content, "\n\n", @{$self->get_Pod},"\n\n", @{$self->get_package_statement};
   push @content, "\n\n" , $self->print;  
   push @content, "\n\n",$self->get_subroutine("import"),"\n\n1;";
   
   my $f = $self->file ;  
   open (I,">$f") || die "Can't acess file ".$self->file()."\n";    
     print I join("\n" ,@content) ; 
   close(I);
}
General documentation
No general documentation available.