File: mass_example

package info (click to toggle)
libobject-event-perl 1.230-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, buster, sid, trixie
  • size: 240 kB
  • sloc: perl: 1,099; makefile: 8
file content (41 lines) | stat: -rwxr-xr-x 746 bytes parent folder | download | duplicates (3)
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
#!/opt/perl/bin/perl
# just a small example script for testing whether memory might be leaked.

package test;

use Object::Event;

our @ISA = qw/Object::Event/;

sub new {
   my $c = shift;
   my $self = $c->SUPER::new (@_);

   # register on the 'up' event and then call the 'down' event
   $self->reg_cb (up => sub { $self->event ('down'); });

   $self
}

sub up {
   my ($self) = @_;

   $self->event ('up'); # genereate an internal up event
}

package main;

my $t = test->new;

my $cnt = 0;
$t->reg_cb ( # reg_cb registers on a set of specific events
   down => sub {
      my ($t) = @_;
      $cnt++;
   }
);

for (1..1000000) {
   $t->up; # test will emit the 'down' even we registered upon above
   if ($cnt % 1000) { print "$cnt\n" }
}