Skip to content

GitLab

Commit da2ebf35 authored by Andreas Kusalananda Kähäri's avatar Andreas Kusalananda Kähäri
Browse files

Remove dependency on Bio::EnsEMBL::Root. 

Beautify.
parent fd634024
Hide whitespace changes
Inline Side-by-side
Showing with 197 additions and 162 deletions
modules/Bio/EnsEMBL/Utils/Eprof.pm
View file @ da2ebf35
......@@ -42,32 +42,29 @@ The rest of the documentation details each of the object methods. Internal metho
=cut
# Let the code begin...
package Bio::EnsEMBL::Utils::Eprof;
use vars qw(@ISA @EXPORT_OK);
use strict;
use Exporter;
use Bio::EnsEMBL::Utils::EprofStack;
# Object preamble - inheriets from Bio::Root::Object
use strict;
use warnings;
use Bio::EnsEMBL::Root;
use Bio::EnsEMBL::Utils::Exception ('throw');
use Bio::EnsEMBL::Utils::EprofStack;
@ISA = qw(Bio::EnsEMBL::Root Exporter);
@EXPORT_OK = qw(eprof_start eprof_end eprof_dump eprof_reset);
use base('Exporter');
our @EXPORT_OK =
( 'eprof_start', 'eprof_end', 'eprof_dump', 'eprof_reset' );
my $global;
sub new {
my ($class) = shift;
my $self = {};
$self->{'_tags'} = {};
bless $self,$class;
sub new {
my ($proto) = @_;
my $class = ref($proto) || $proto;
my $self = bless( { '_tags' => {} }, $class );
return $self;
return $self;
}
=head2 eprof_start
......@@ -82,10 +79,14 @@ sub new {
=cut
sub eprof_start{
my ($tag) = @_;
$global = Bio::EnsEMBL::Utils::Eprof->new() unless defined $global;
$global->start($tag);
sub eprof_start {
my ($tag) = @_;
if ( !defined($global) ) {
$global = Bio::EnsEMBL::Utils::Eprof->new();
}
$global->start($tag);
}
=head2 eprof_end
......@@ -101,19 +102,21 @@ sub eprof_start{
=cut
sub eprof_end {
my ($tag) = @_;
$global = Bio::EnsEMBL::Utils::Eprof->new() unless defined $global;
$global->end($tag);
my ($tag) = @_;
if ( !defined($global) ) {
$global = Bio::EnsEMBL::Utils::Eprof->new();
}
$global->end($tag);
}
sub eprof_dump {
my $fh = shift;
my ($fh) = @_;
if( !defined $global ) {
return;
}
if ( !defined($global) ) { return }
$global->dump($fh);
$global->dump($fh);
}
=head2 eprof_reset
......@@ -128,9 +131,7 @@ sub eprof_dump {
=cut
sub eprof_reset{
undef($global);
}
sub eprof_reset { undef($global) }
=head2 dump
......@@ -144,23 +145,40 @@ sub eprof_reset{
=cut
sub dump{
my ($self,$fh) = @_;
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 @tags = sort {
$self->_tags()->{$a}->total_time()
<=> $self->_tags()->{$b}->total_time()
} keys %{ $self->_tags() };
foreach my $tag (@tags) {
my $st = $self->_tags->{$tag};
next if $st->number == 0;
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;
$STD = sprintf "%6f", sqrt( $SS/$st->number/($st->number-1) ) if $SS>0;
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);
}
}
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
......@@ -174,11 +192,18 @@ sub dump{
=cut
sub start{
my ($self,$tag) = @_;
$self->throw("Must start on tag") unless defined $tag;
$self->_tags->{$tag} = Bio::EnsEMBL::Utils::EprofStack->new($tag) unless defined $self->_tags->{$tag};
$self->_tags->{$tag}->push_stack();
sub start {
my ( $self, $tag ) = @_;
if ( !defined($tag) ) {
$self->throw("Must start on tag");
}
if ( !defined( $self->_tags()->{$tag} ) ) {
$self->_tags()->{$tag} = Bio::EnsEMBL::Utils::EprofStack->new($tag);
}
$self->_tags()->{$tag}->push_stack();
}
=head2 end
......@@ -193,14 +218,20 @@ sub start{
=cut
sub end{
my ($self,$tag) = @_;
$self->throw("Must end on tag") unless defined $tag;
$self->throw("Ending with a nonexistant tag") unless defined $self->_tags->{$tag};
sub end {
my ( $self, $tag ) = @_;
if ( !defined($tag) ) {
$self->throw("Must end on tag");
}
if ( !defined( $self->_tags()->{$tag} ) ) {
$self->throw("Ending with a nonexistant tag");
}
$self->_tags->{$tag}->pop_stack();
}
=head2 _tags
Title : _tags
......@@ -212,8 +243,8 @@ sub end{
=cut
sub _tags{
my $obj = shift;
sub _tags {
my ($obj) = @_;
return $obj->{'_tags'};
}
......
modules/Bio/EnsEMBL/Utils/EprofStack.pm
View file @ da2ebf35
#
# BioPerl module for Bio::EnsEMBL::Util::EprofStack
#
......@@ -28,42 +27,45 @@ Describe contact details here
=head1 APPENDIX
The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _
=cut
# Let the code begin...
package Bio::EnsEMBL::Utils::EprofStack;
use POSIX;
use strict;
use warnings;
use POSIX;
use Bio::EnsEMBL::Utils::Exception ('warning');
use Bio::EnsEMBL::Utils::Exception qw(warning);
BEGIN {
eval {
require Time::HiRes;
Time::HiRes->import('time');
};
};
sub new {
my ($class,$name) = @_;
my $self = {
'is_active' => 0,
'total_time' => 0,
'total_time_time' => 0,
'max_time' => 0,
'min_time' => 999999999,
'number' => 0,
'tag' => $name
};
bless $self,$class;
return $self;
eval {
require Time::HiRes;
Time::HiRes->import('time');
};
}
sub new {
my ( $proto, $name ) = @_;
my $class = ref($proto) || $proto;
my $self = bless( { 'is_active' => 0,
'total_time' => 0,
'total_time_time' => 0,
'max_time' => 0,
'min_time' => 999999999,
'number' => 0,
'tag' => $name
},
$class );
return $self;
}
=head2 push_stack
......@@ -78,16 +80,21 @@ sub new {
=cut
sub push_stack{
my ($self,@args) = @_;
sub push_stack {
my ( $self, @args ) = @_;
if ( $self->{'is_active'} == 1 ) {
warning(
sprintf( "Attempting to push stack on tag '%s' "
. "when active. Discarding previous push."
. $self->tag() ) );
}
if( $self->{'is_active'} == 1 ) {
warning("Attempting to push stack on tag ".$self->tag." when active. Discarding previous push");
}
#my($user,$sys) = times();
# $self->{'current_start'} = (POSIX::times)[0];
$self->{'current_start'} = time();
$self->{'is_active'}=1
# my ( $user, $sys ) = times();
# $self->{'current_start'} = (POSIX::times)[0];
$self->{'current_start'} = time();
$self->{'is_active'} = 1;
}
=head2 pop_stack
......@@ -102,23 +109,35 @@ sub push_stack{
=cut
sub pop_stack{
my ($self,@args) = @_;
if( $self->{'is_active'} == 0 ) {
warning("Attempting to pop stack on tag ".$self->tag." when not active. Ignoring");
}
#my($user,$sys) = times();
# my $clocktime = ( (POSIX::times)[0] - $self->{'current_start'} ) / POSIX::sysconf(&POSIX::_SC_CLK_TCK);
my $clocktime = time() - $self->{'current_start'};
$self->{'max_time'} = $clocktime if $self->{'max_time'} < $clocktime;
$self->{'min_time'} = $clocktime if $self->{'min_time'} > $clocktime;
$self->{'total_time'}+=$clocktime;
$self->{'total_time_time'} += $clocktime * $clocktime;
$self->{'number'}++;
$self->{'is_active'}=0;
}
sub pop_stack {
my ( $self, @args ) = @_;
if ( $self->{'is_active'} == 0 ) {
warning(
sprintf( "Attempting to pop stack on tag '%s' "
. "when not active. Ignoring.",
$self->tag() ) );
}
# my ( $user, $sys ) = times();
# my $clocktime =
# ( (POSIX::times)[0] - $self->{'current_start'} )/
# POSIX::sysconf(&POSIX::_SC_CLK_TCK);
my $clocktime = time() - $self->{'current_start'};
if ( $self->{'max_time'} < $clocktime ) {
$self->{'max_time'} = $clocktime;
}
if ( $self->{'min_time'} > $clocktime ) {
$self->{'min_time'} = $clocktime;
}
$self->{'total_time'} += $clocktime;
$self->{'total_time_time'} += $clocktime*$clocktime;
$self->{'number'}++;
$self->{'is_active'} = 0;
} ## end sub pop_stack
=head2 total_time_time
......@@ -132,13 +151,11 @@ sub pop_stack{
=cut
sub total_time_time {
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'total_time_time'} = $value;
}
return $obj->{'total_time_time'};
my ( $self, $value ) = @_;
if ( defined($value) ) { $self->{'total_time_time'} = $value }
return $self->{'total_time_time'};
}
=head2 max_time
......@@ -152,13 +169,12 @@ sub total_time_time {
=cut
sub max_time{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'max_time'} = $value;
}
return $obj->{'max_time'};
sub max_time {
my ( $self, $value ) = @_;
if ( defined($value) ) { $self->{'max_time'} = $value }
return $self->{'max_time'};
}
=head2 min_time
......@@ -172,13 +188,12 @@ sub max_time{
=cut
sub min_time{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'min_time'} = $value;
}
return $obj->{'min_time'};
sub min_time {
my ( $self, $value ) = @_;
if ( defined($value) ) { $self->{'min_time'} = $value }
return $self->{'min_time'};
}
=head2 total_time
......@@ -192,14 +207,12 @@ sub min_time{
=cut
sub total_time{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'total_time'} = $value;
}
return $obj->{'total_time'};
sub total_time {
my ( $self, $value ) = @_;
if ( defined($value) ) { $self->{'total_time'} = $value }
return $self->{'total_time'};
}
=head2 number
......@@ -213,14 +226,12 @@ sub total_time{
=cut
sub number{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'number'} = $value;
}
return $obj->{'number'};
sub number {
my ( $self, $value ) = @_;
if ( defined($value) ) { $self->{'number'} = $value }
return $self->{'number'};
}
=head2 is_active
......@@ -234,14 +245,12 @@ sub number{
=cut
sub is_active{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'is_active'} = $value;
}
return $obj->{'is_active'};
sub is_active {
my ( $self, $value ) = @_;
if ( defined($value) ) { $self->{'is_active'} = $value }
return $self->{'is_active'};
}
=head2 current_start
......@@ -255,16 +264,13 @@ sub is_active{
=cut
sub current_start{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'current_start'} = $value;
}
return $obj->{'current_start'};
sub current_start {
my ( $self, $value ) = @_;
}
if ( defined($value) ) { $self->{'current_start'} = $value }
return $self->{'current_start'};
}
=head2 tag
......@@ -277,14 +283,12 @@ sub current_start{
=cut
sub tag{
my $obj = shift;
if( @_ ) {
my $value = shift;
$obj->{'tag'} = $value;
}
return $obj->{'tag'};
sub tag {
my ( $self, $value ) = @_;
if ( defined($value) ) { $self->{'tag'} = $value }
return $self->{'tag'};
}
1;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment