Dave Cross: Still Munging Data With Perl: Online event - Mar 17 Learn more

CADE / Time-RTM-1.14 / lib / Time / RTM / Scope.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
—
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147

              
##############################################################################
#
#  Time::RTM::Scope
#  2024 (c) Vladi Belperchinov-Shabanski "Cade" <cade@noxrun.com>
#
#  This is internal module, see Time::RTM for external API
#
#  DISTRIBUTED UNDER GPLv2
#
##############################################################################
package Time::RTM::Scope;
use strict;
use Time::HiRes;
use Carp;
our $VERSION = '1.14';
##############################################################################
sub new
{
  my $class = shift;
  my $rtm   = shift; # controller bject
  my @keys  = @_;
   
  carp( "second argument is expected to be Time::RTM" ) unless ref( $rtm ) eq 'Time::RTM';
  push @keys, '*' if @keys == 0;
   
  $class = ref( $class ) || $class;
  my $self = {
               'RTM'  => $rtm,
               'KEYS' => \@keys,
             };
  bless $self, $class;
   
  $self->restart();
   
  return $self;
}
sub restart
{
  my $self = shift;
   
  $self->{ 'START' } = Time::HiRes::time();
}
# TODO: pause() cont()
sub split_str
{
  my $self = shift;
   
  return "n/a/n" unless $self->{ 'START' };
  return $self->{ 'START' } . "/" . Time::HiRes::time() . "/" . (Time::HiRes::time() - $self->{ 'START' });
}
sub split
{
  my $self = shift;
   
  return undef unless $self->{ 'START' };
  return Time::HiRes::time() - $self->{ 'START' };
}
sub stop
{
  my $self = shift;
  carp( "scope timer is not started, use start() first" ) if $self->{ 'START' } == 0;
  my $st = $self->{ 'START' };
  my $dt = Time::HiRes::time() - $st;
   
  my $rtm = $self->__rtm();
   
  my $keys = $self->{ 'KEYS' };
  for my $key ( @$keys )
    {
    $key = $self->auto_key() if $key =~ /^\*?$/;
    $rtm->__add_dt( $key, $st, $dt );
    }
  delete $self->{ 'START' };
}
sub DESTROY
{
  my $self = shift;
  $self->stop() if $self->{ 'START' };
}
sub auto_key
{
  my $self = shift;
  my @key;
  my $i = 0;
  my $se = 1; # skip eval
  while ( my ( $pack, $file, $line, $subname, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash ) = caller($i++) )
    {
    next if $subname =~ /^Time::RTM::/; # skip self
    next if $subname eq '(eval)' and $se;
    $se = 0;
    push @key, "$subname";
    }
  push @key, 'main::';
     
  my $key = join '/', reverse @key;
   
  return $key;
}
### INTERNAL #################################################################
sub __rtm
{
  my $self = shift;
   
  return $self->{ 'RTM' };
}
##############################################################################
=pod
=head1 NAME
Time::RTM::Scope is used internally by Time::RTM. 
See Time::RTM manual.
=head1 AUTHOR
  Vladi Belperchinov-Shabanski "Cade"
  <cade@noxrun.com> <cade@cpan.org>
  http://cade.noxrun.com
=cut
##############################################################################
1;
##############################################################################