annotate Lib/IMPL/Profiler/Memory.pm @ 393:69a1f1508696

minor security refactoring
author cin
date Fri, 14 Feb 2014 16:41:12 +0400
parents 4d0e1962161c
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
1 package IMPL::Profiler::Memory;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
2
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
3 use strict;
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
4 use Carp qw(longmess shortmess);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
5 use Scalar::Util qw(refaddr weaken isweak);
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
6
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
7 my %listeners;
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
8 my $trapped;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
9
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
10 BEGIN {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
11 $trapped = 0;
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
12 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
13
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
14 sub import {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
15 if (not $trapped) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
16 *CORE::GLOBAL::bless = sub {
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
17 $_[1] |= caller unless $_[1];
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
18 my $ref = CORE::bless $_[0],$_[1];
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
19
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
20 $_->track($ref) foreach values %listeners;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
21
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
22 return $ref;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
23 };
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
24 $trapped = 1;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
25 }
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
26 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
27
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
28 sub _ConnectListener {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
29 my ($self,$listener) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
30
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
31 die "Invalid listener" unless ref $listener;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
32
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
33 $listeners{refaddr($listener)} = $listener;
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
34 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
35
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
36 sub _RemoveListener {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
37 my ($self,$listener) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
38
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
39 die "Invalid listener" unless ref $listener;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
40
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
41 delete $listeners{refaddr($listener)};
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
42 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
43
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
44 sub Monitor {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
45 my ($self,$code) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
46
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
47 my $data = IMPL::Profiler::Memory::Data->new();
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
48
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
49 $data->Monitor($code);
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
50
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
51 return $data;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
52 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
53
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
54 package IMPL::Profiler::Memory::Data;
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
55 use parent qw(IMPL::Object::Fields);
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
56
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
57 use Data::Dumper();
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
58 use Scalar::Util qw(refaddr weaken isweak);
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
59
190
cd1ff7029a63 IMLP::Web::View refactored, added new method 'require' which is available inside templates. Changed document rendering.
cin
parents: 189
diff changeset
60 use fields qw( objects counter);
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
61
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
62 sub CTOR {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
63 my $this = shift;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
64 $this->{objects} = [];
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
65 $this->{counter} = 0;
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
66 }
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
67
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
68 sub track {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
69 my $i = scalar @{$_[0]->{objects}};
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
70 $_[0]->{objects}[$i] = $_[1];
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
71 weaken($_[0]->{objects}[$i]);
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
72 $_[0]->{counter} ++;
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
73 }
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
74
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
75 sub Purge {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
76 my $this = shift;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
77
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
78 return $this->{objects} = [ grep defined($_), @{$this->{objects}}];
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
79 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
80
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
81 sub Dump {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
82 my $this = shift;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
83 return Data::Dumper->Dump([$this->{objects}]);
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
84 }
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
85
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
86 sub isLeak {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
87 my ($this) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
88 $this->Purge();
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
89 return ( scalar(@{$this->{objects}}) > 0);
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
90 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
91
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
92 sub Monitor {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
93 my ($this,$code) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
94
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
95 die "A reference to a subroutine is required" unless ref $code;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
96
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
97 IMPL::Profiler::Memory->_ConnectListener($this);
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
98 eval {
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
99 $code->();
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
100 };
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
101 my $err = $@;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
102 IMPL::Profiler::Memory->_RemoveListener($this);
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
103
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
104 die $err if $err;
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
105
4d0e1962161c Replaced tabs with spaces
cin
parents: 190
diff changeset
106 return;
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
107 }
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
108
188
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
109
029c9610528c Memory leak tests in IMPL::Web::View
cin
parents: 49
diff changeset
110
49
16ada169ca75 migrating to the Eclipse IDE
wizard@linux-odin.local
parents: 0
diff changeset
111 1;