… | |
… | |
2 | |
2 | |
3 | Coro - coroutine process abstraction |
3 | Coro - coroutine process abstraction |
4 | |
4 | |
5 | =head1 SYNOPSIS |
5 | =head1 SYNOPSIS |
6 | |
6 | |
7 | use Coro; |
7 | use Coro; |
8 | |
8 | |
9 | async { |
9 | async { |
10 | # some asynchronous thread of execution |
10 | # some asynchronous thread of execution |
11 | print "2\n"; |
11 | print "2\n"; |
12 | cede; # yield back to main |
12 | cede; # yield back to main |
13 | print "4\n"; |
13 | print "4\n"; |
14 | }; |
14 | }; |
15 | print "1\n"; |
15 | print "1\n"; |
16 | cede; # yield to coroutine |
16 | cede; # yield to coroutine |
17 | print "3\n"; |
17 | print "3\n"; |
18 | cede; # and again |
18 | cede; # and again |
19 | |
19 | |
20 | # use locking |
20 | # use locking |
21 | my $lock = new Coro::Semaphore; |
21 | my $lock = new Coro::Semaphore; |
22 | my $locked; |
22 | my $locked; |
23 | |
23 | |
24 | $lock->down; |
24 | $lock->down; |
25 | $locked = 1; |
25 | $locked = 1; |
26 | $lock->up; |
26 | $lock->up; |
27 | |
27 | |
28 | =head1 DESCRIPTION |
28 | =head1 DESCRIPTION |
29 | |
29 | |
30 | This module collection manages coroutines. Coroutines are similar |
30 | This module collection manages coroutines. Coroutines are similar |
31 | to threads but don't run in parallel at the same time even on SMP |
31 | to threads but don't run in parallel at the same time even on SMP |
… | |
… | |
64 | our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); |
64 | our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub); |
65 | our %EXPORT_TAGS = ( |
65 | our %EXPORT_TAGS = ( |
66 | prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], |
66 | prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)], |
67 | ); |
67 | ); |
68 | our @EXPORT_OK = (@{$EXPORT_TAGS{prio}}, qw(nready)); |
68 | our @EXPORT_OK = (@{$EXPORT_TAGS{prio}}, qw(nready)); |
69 | |
|
|
70 | { |
|
|
71 | my @async; |
|
|
72 | my $init; |
|
|
73 | |
|
|
74 | # this way of handling attributes simply is NOT scalable ;() |
|
|
75 | sub import { |
|
|
76 | no strict 'refs'; |
|
|
77 | |
|
|
78 | Coro->export_to_level (1, @_); |
|
|
79 | |
|
|
80 | my $old = *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"}{CODE}; |
|
|
81 | *{(caller)[0]."::MODIFY_CODE_ATTRIBUTES"} = sub { |
|
|
82 | my ($package, $ref) = (shift, shift); |
|
|
83 | my @attrs; |
|
|
84 | for (@_) { |
|
|
85 | if ($_ eq "Coro") { |
|
|
86 | push @async, $ref; |
|
|
87 | unless ($init++) { |
|
|
88 | eval q{ |
|
|
89 | sub INIT { |
|
|
90 | &async(pop @async) while @async; |
|
|
91 | } |
|
|
92 | }; |
|
|
93 | } |
|
|
94 | } else { |
|
|
95 | push @attrs, $_; |
|
|
96 | } |
|
|
97 | } |
|
|
98 | return $old ? $old->($package, $ref, @attrs) : @attrs; |
|
|
99 | }; |
|
|
100 | } |
|
|
101 | |
|
|
102 | } |
|
|
103 | |
69 | |
104 | =over 4 |
70 | =over 4 |
105 | |
71 | |
106 | =item $main |
72 | =item $main |
107 | |
73 | |