diff variant_effect_predictor/Bio/EnsEMBL/Utils/Eprof.pm @ 0:1f6dce3d34e0

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/EnsEMBL/Utils/Eprof.pm	Thu Apr 11 02:01:53 2013 -0400
@@ -0,0 +1,254 @@
+=head1 LICENSE
+
+  Copyright (c) 1999-2012 The European Bioinformatics Institute and
+  Genome Research Limited.  All rights reserved.
+
+  This software is distributed under a modified Apache license.
+  For license details, please see
+
+    http://www.ensembl.org/info/about/code_licence.html
+
+=head1 CONTACT
+
+  Please email comments or questions to the public Ensembl
+  developers list at <[e-mail]>.
+
+  Questions may also be sent to the Ensembl help desk at
+  <[e-mail]>.
+
+=cut
+
+=head1 NAME
+
+Bio::EnsEMBL::Utils::Eprof - Bespoke Ensembl profiler
+
+=head1 SYNOPSIS
+
+  use Bio::EnsEMBL::Utils::Eprof( 'eprof_start', 'eprof_end',
+    'eprof_dump' );
+
+  &eprof_start('function-a');
+  # ... do something
+  &eprof_end('function-a');
+
+  &eprof_dump( \*STDERR );
+
+  # there is an object based set for above as well, for running
+  # multiple concurrent profilers
+
+=head1 DESCRIPTION
+
+This is an Ensembl profiler as we broke the Perl profilers.
+
+=head1 METHODS
+
+=cut
+
+package Bio::EnsEMBL::Utils::Eprof;
+
+use strict;
+use warnings;
+
+use Bio::EnsEMBL::Utils::Exception ('throw');
+use Bio::EnsEMBL::Utils::EprofStack;
+
+use base qw( Exporter );
+
+our @EXPORT_OK =
+  ( 'eprof_start', 'eprof_end', 'eprof_dump', 'eprof_reset' );
+
+my $global;
+
+sub new {
+  my ($proto) = @_;
+
+  my $class = ref($proto) || $proto;
+  my $self = bless( { '_tags' => {} }, $class );
+
+  return $self;
+}
+
+=head2 eprof_start
+
+ Title   : eprof_start
+ Usage   :
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub eprof_start {
+  my ($tag) = @_;
+
+  if ( !defined($global) ) {
+    $global = Bio::EnsEMBL::Utils::Eprof->new();
+  }
+
+  $global->start($tag);
+}
+
+=head2 eprof_end
+
+ Title   : eprof_end
+ Usage   :
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub eprof_end {
+  my ($tag) = @_;
+
+  if ( !defined($global) ) {
+    $global = Bio::EnsEMBL::Utils::Eprof->new();
+  }
+
+  $global->end($tag);
+}
+
+sub eprof_dump {
+  my ($fh) = @_;
+
+  if ( !defined($global) ) { return }
+
+  $global->dump($fh);
+}
+
+=head2 eprof_reset
+
+ Title   : eprof_reset
+ Usage   :
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub eprof_reset { undef($global) }
+
+=head2 dump
+
+ Title   : dump
+ Usage   :
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub dump {
+  my ( $self, $fh ) = @_;
+
+  my @tags = sort {
+    $self->_tags()->{$a}->total_time()
+      <=> $self->_tags()->{$b}->total_time()
+  } keys %{ $self->_tags() };
+
+  foreach my $tag (@tags) {
+    my $st = $self->_tags->{$tag};
+
+    if ( $st->number() == 0 ) { next }
+
+    my $STD = '---';
+
+    if ( $st->number() > 1 ) {
+      my $SS =
+        $st->total_time_time() -
+        $st->total_time()*$st->total_time()/$st->number();
+
+      if ( $SS > 0 ) {
+        $STD = sprintf( "%6f",
+                        sqrt( $SS/$st->number()/( $st->number() - 1 ) )
+        );
+      }
+    }
+
+    print( $fh sprintf( "Eprof: %20s  %6f  %6f  %d  %s  [%6f,%6f]\n",
+                        $st->tag(), $st->total_time(),
+                        $st->total_time()/$st->number(), $st->number(),
+                        $STD, $st->min_time(),
+                        $st->max_time() ) );
+  } ## end foreach my $tag (@tags)
+} ## end sub dump
+
+=head2 start
+
+ Title   : start
+ Usage   : $eprof->start('this_tag');
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub start {
+  my ( $self, $tag ) = @_;
+
+  if ( !defined($tag) ) {
+    $self->throw("No tag, can't start.");
+  }
+
+  if ( !defined( $self->_tags()->{$tag} ) ) {
+    $self->_tags()->{$tag} = Bio::EnsEMBL::Utils::EprofStack->new($tag);
+  }
+
+  $self->_tags()->{$tag}->push_stack();
+}
+
+=head2 end
+
+ Title   : end
+ Usage   : $eprof->end('this_tag');
+ Function:
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub end {
+  my ( $self, $tag ) = @_;
+
+  if ( !defined($tag) ) {
+    $self->throw("No tag, can't end.");
+  }
+
+  if ( !defined( $self->_tags()->{$tag} ) ) {
+    $self->throw(
+                sprintf( "Ending with a nonexistant tag '%s'", $tag ) );
+  }
+
+  $self->_tags->{$tag}->pop_stack();
+}
+
+=head2 _tags
+
+ Title   : _tags
+ Usage   : $obj->_tags($newval)
+ Function: 
+ Returns : value of _tags
+ Args    : newvalue (optional)
+
+
+=cut
+
+sub _tags {
+  my ($obj) = @_;
+  return $obj->{'_tags'};
+}
+
+1;
+