49
|
1 package PerfCounter;
|
|
2 use strict;
|
|
3 use Common;
|
|
4 use Exporter;
|
|
5 our @ISA = qw(Exporter);
|
|
6 our @EXPORT = qw(&GetTimeCounter &StartTimeCounter &StopTimeCounter &SetDBIPerfCounter);
|
|
7
|
|
8 our %Counters;
|
|
9
|
|
10 sub Reset() {
|
|
11 $_->Reset foreach values %Counters;
|
|
12 }
|
|
13
|
|
14 sub GetTimeCounter {
|
|
15 my $counter = $Counters{$_[0]};
|
|
16 die new Exception("'$_[0]' already exists and isn't a time counter.") if ref $counter and ref $counter ne 'PerfInterval';
|
|
17 if (not ref $counter) {
|
|
18 $counter = new PerfInterval;
|
|
19 $Counters{$_[0]} = $counter;
|
|
20 }
|
|
21 return $counter;
|
|
22 }
|
|
23
|
|
24 sub StartTimeCounter {
|
|
25 my $counter = GetTimeCounter($_[0]);
|
|
26 if (not $counter->IsOpened) {
|
|
27 $counter->OpenInterval;
|
|
28 }
|
|
29 }
|
|
30
|
|
31 sub StopTimeCounter {
|
|
32 my $counter = GetTimeCounter($_[0]);
|
|
33 if ($counter->IsOpened) {
|
|
34 $counter->CloseInterval;
|
|
35 }
|
|
36 }
|
|
37
|
|
38 sub SetDBIPerfCounter{
|
|
39 my ($dbh,$name) = @_;
|
|
40 $name ||= 'DBI';
|
|
41 $Counters{$name} = DBIPerfomance->new(DBH => $dbh);
|
|
42 }
|
|
43
|
|
44 package PerfInterval;
|
|
45 use Common;
|
|
46 use Time::HiRes qw(gettimeofday tv_interval);
|
|
47
|
|
48 sub new {
|
|
49 my $class = shift;
|
|
50 my $self = bless { StartTime => scalar(gettimeofday()) }, $class;
|
|
51 return $self;
|
|
52 }
|
|
53
|
|
54 sub CloseInterval {
|
|
55 my $this = shift;
|
|
56
|
|
57 if (not $this->{'EndTime'}) {
|
|
58 $this->{'EndTime'} = scalar(gettimeofday());
|
|
59 $this->{'Value'} += $this->{'EndTime'} - $this->{'StartTime'};
|
|
60 }
|
|
61
|
|
62 return $this->{'Value'};
|
|
63 }
|
|
64
|
|
65 sub Value {
|
|
66 my $this = shift;
|
|
67
|
|
68 if (not $this->{'EndTime'}) {
|
|
69 return sprintf ( '%.3f+',scalar(gettimeofday()) - $this->{'StartTime'});
|
|
70 } else {
|
|
71 return sprintf ( '%.3f',$this->{'Value'});
|
|
72 }
|
|
73 }
|
|
74
|
|
75 sub Add {
|
|
76 my ($this,$interval) = @_;
|
|
77
|
|
78 if(ref $interval eq 'PerfInterval') {
|
|
79 $this->{'Value'} += $interval->{'Value'};
|
|
80 } else {
|
|
81 $this->{'Value'} += $interval;
|
|
82 }
|
|
83
|
|
84 return $this->{'Value'};
|
|
85 }
|
|
86
|
|
87 sub IsOpened {
|
|
88 my $this = shift;
|
|
89 return( not $this->{'EndTime'} );
|
|
90 }
|
|
91
|
|
92 sub OpenInterval {
|
|
93 my $this = shift;
|
|
94
|
|
95 $this->{'StartTime'} = gettimeofday();
|
|
96 delete $this->{'EndTime'};
|
|
97
|
|
98 return 1;
|
|
99 }
|
|
100
|
|
101 sub Reset {
|
|
102 my ($this) = @_;
|
|
103
|
|
104 $this->CloseInterval();
|
|
105 $this->{'Value'} = 0;
|
|
106 }
|
|
107
|
|
108 package DBIPerfomance;
|
|
109 use Common;
|
|
110 our @ISA = qw(Object);
|
|
111
|
|
112 BEGIN {
|
|
113 DeclareProperty DBH => ACCESS_READ;
|
|
114
|
|
115 }
|
|
116
|
|
117 sub CTOR {
|
|
118 my $this=shift;
|
|
119 $this->SUPER::CTOR(@_);
|
|
120
|
|
121
|
|
122 $this->DBH->{Profile} = 6;
|
|
123 }
|
|
124
|
|
125 sub Reset {
|
|
126 my $this = shift;
|
|
127 $this->DBH->{Profile} = 6;
|
|
128 }
|
|
129
|
|
130 sub Value {
|
|
131 my ($this,%opt) = @_;
|
|
132
|
|
133 my $infoSelect = { count => 0, time => 0};
|
|
134 my $infoUpdate = { count => 0, time => 0};
|
|
135 my $infoTotal;
|
|
136
|
|
137 foreach my $stmt (grep /^SELECT/i,keys %{$this->DBH->{Profile}->{Data} || {}}) {
|
|
138 $infoSelect->{'count'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[0] || 0;
|
|
139 $infoSelect->{'time'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[1] || 0;
|
|
140 }
|
|
141
|
|
142 foreach my $stmt (grep /^UPDATE/i,keys %{$this->DBH->{Profile}->{Data} || {}}) {
|
|
143 $infoUpdate->{'count'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[0] || 0;
|
|
144 $infoUpdate->{'time'} += $this->DBH->{Profile}{Data}{$stmt}{execute}[1] || 0;
|
|
145 }
|
|
146
|
|
147 $infoTotal->{'count'} = $infoSelect->{'count'} + $infoUpdate->{'count'};
|
|
148 $infoTotal->{'time'} = $infoSelect->{'time'} + $infoUpdate->{'time'};
|
|
149
|
|
150 if ($opt{'extended'}) {
|
|
151 return ($infoSelect,$infoUpdate,$infoTotal);
|
|
152 } else {
|
|
153 return sprintf( '%i (%.2f)', $infoTotal->{count},$infoTotal->{time} );
|
|
154 }
|
|
155 }
|
|
156
|
|
157 sub Queries {
|
|
158 my ($this) = @_;
|
|
159 return [ map { "$this->{$DBH}{Profile}{Data}{$_}{execute}[0] x $_"} sort grep $_, keys %{$this->DBH->{Profile}->{Data}}];
|
|
160 }
|
|
161 1;
|