File Coverage

blib/lib/App/Environ.pm
Criterion Covered Total %
statement 64 64 100.0
branch 21 24 87.5
condition n/a
subroutine 8 8 100.0
pod 2 2 100.0
total 95 98 96.9


line stmt bran cond sub pod time code
1             package App::Environ;
2              
3 3     3   56082 use 5.008000;
  3         9  
4 3     3   11 use strict;
  3         4  
  3         54  
5 3     3   9 use warnings;
  3         8  
  3         125  
6              
7             our $VERSION = '0.18';
8              
9 3     3   11 use Carp qw( croak );
  3         4  
  3         1310  
10              
11             my %REGD_HANDLERS;
12             my %MODULES_IDX;
13              
14              
15             sub register {
16 6     6 1 90 my $class = shift;
17 6         9 my $module_class = shift;
18 6         31 my %handlers = @_;
19              
20 6 100       22 unless ( defined $module_class ) {
21 1         159 croak 'Module class must be specified';
22             }
23              
24 5 50       14 unless ( exists $MODULES_IDX{$module_class} ) {
25 5         12 $MODULES_IDX{$module_class} = {};
26             }
27 5         9 my $events_idx = $MODULES_IDX{$module_class};
28              
29 5         22 while ( my ( $event_name, $handler ) = each %handlers ) {
30 17 50       29 next if exists $events_idx->{$event_name};
31              
32 17         18 $events_idx->{$event_name} = 1;
33 17 100       31 unless ( exists $REGD_HANDLERS{$event_name} ) {
34 10         13 $REGD_HANDLERS{$event_name} = [];
35             }
36 17 100       48 if ( $event_name =~ m/\:r$/ ) {
37 7         8 unshift( @{ $REGD_HANDLERS{$event_name} }, $handler );
  7         27  
38             }
39             else {
40 10         11 push( @{ $REGD_HANDLERS{$event_name} }, $handler );
  10         31  
41             }
42             }
43              
44 5         14 return;
45             }
46              
47             sub send_event {
48 8     8 1 3913 my $class = shift;
49 8         22 my $event_name = shift;
50 8 100       24 my $cb = pop if ref( $_[-1] ) eq 'CODE';
51 8         13 my @args = @_;
52              
53 8 100       16 unless ( defined $event_name ) {
54 1         92 croak 'Event name must be specified';
55             }
56              
57 7 100       13 unless ( exists $REGD_HANDLERS{$event_name} ) {
58 1 50       4 $cb->() if defined $cb;
59 1         3 return;
60             }
61              
62 6         7 my @handlers = @{ $REGD_HANDLERS{$event_name} };
  6         17  
63 6 100       11 if ( defined $cb ) {
64 2         6 $class->_process_async( \@handlers, \@args, $cb );
65             }
66             else {
67 4         6 foreach my $handler (@handlers) {
68 11         52 $handler->(@args);
69             }
70             }
71              
72 5         19 return;
73             }
74              
75             sub _process_async {
76 4     4   4 my $class = shift;
77 4         4 my $handlers = shift;
78 4         4 my $args = shift;
79 4         4 my $cb = shift;
80              
81 4         2 my $handler = shift @{$handlers};
  4         5  
82              
83 4         18 $handler->( @{$args},
84             sub {
85 4     4   26 my $err = shift;
86              
87 4 100       8 if ( defined $err ) {
88 1         3 $cb->($err);
89 1         3 return;
90             }
91              
92 3 100       2 if ( @{$handlers} ) {
  3         9  
93 2         7 $class->_process_async( $handlers, $args, $cb );
94 2         4 return;
95             }
96              
97 1         2 $cb->();
98             }
99 4         4 );
100              
101 4         17 return;
102             }
103              
104             1;
105             __END__