File Coverage

blib/lib/Data/Stag/ChainHandler.pm
Criterion Covered Total %
statement 75 78 96.1
branch 18 22 81.8
condition 3 3 100.0
subroutine 11 11 100.0
pod 3 8 37.5
total 110 122 90.1


line stmt bran cond sub pod time code
1             package Data::Stag::ChainHandler;
2              
3             =head1 NAME
4              
5             Data::Stag::ChainHandler - Chain Handler
6              
7             =head1 SYNOPSIS
8              
9              
10             =cut
11              
12             =head1 DESCRIPTION
13              
14              
15             =head1 PUBLIC METHODS -
16              
17             =cut
18              
19 2     2   12 use strict;
  2         4  
  2         89  
20 2     2   13 use base qw(Data::Stag::Base Data::Stag::Writer);
  2         5  
  2         269  
21              
22 2     2   13 use vars qw($VERSION);
  2         7  
  2         1823  
23             $VERSION="0.14";
24              
25             sub init {
26 2     2 0 5 my $self = shift;
27 2         8 return;
28             }
29              
30             sub subhandlers {
31 140     140 0 159 my $self = shift;
32 140 100       271 $self->{_subhandlers} = shift if @_;
33 140         231 return $self->{_subhandlers};
34             }
35              
36             sub blocked_event {
37 2     2 0 4 my $self = shift;
38 2 50       8 if (@_) {
39 2         5 my $e = shift;
40 2         4 $self->{_blocked_event} = $e;
41 2 50       10 unless (ref($e)) {
42 0         0 $e = [$e];
43             }
44 2         9 my %h = map {$_=>1} @$e;
  3         12  
45 2         9 $self->blocked_event_h(\%h);
46             }
47 2         7 return $self->{_blocked_event};
48             }
49              
50             sub blocked_event_h {
51 632     632 0 703 my $self = shift;
52 632 100       1085 $self->{_blocked_event_h} = shift if @_;
53 632         1214 return $self->{_blocked_event_h};
54             }
55              
56             sub is_blocked {
57 630     630 0 655 my $self = shift;
58 630         716 my $e = shift;
59 630 50       1076 if (!$e) {
60 0         0 $self->throw("must pass arg to is_blocked");
61             }
62 630         987 my $is = $self->blocked_event_h->{$e};
63 630         1347 return $is;
64             }
65              
66             sub start_event {
67 52     52 1 59 my $self = shift;
68 52         65 my $ev = shift;
69 52         151 my $stack = $self->elt_stack;
70 52         93 push(@$stack, $ev);
71              
72 52         115 my $sh = $self->subhandlers;
73 52         84 my $is_blocked = grep {$self->is_blocked($_)} @$stack;
  184         319  
74 52 100       91 if ($is_blocked) {
75 29         94 $sh->[0]->start_event($ev);
76             }
77             else {
78 23         41 foreach (@$sh) {
79 46         136 $_->start_event($ev);
80             }
81             }
82             }
83              
84             sub evbody {
85 34     34 1 48 my $self = shift;
86 34         43 my $ev = shift;
87 34         55 my @args = @_;
88              
89 34         94 my $stack = $self->elt_stack;
90              
91 34         89 my $sh = $self->subhandlers;
92 34 100       54 if (grep {$self->is_blocked($_)} @$stack) {
  136         243  
93 21         77 $sh->[0]->evbody($ev, @args);
94             }
95             else {
96 13         26 foreach (@$sh) {
97 26         77 $_->evbody($ev, @args);
98             }
99             }
100            
101 34         274 return;
102             }
103              
104             sub end_event {
105 52     52 1 61 my $self = shift;
106 52         62 my $ev = shift;
107              
108 52         128 my $stack = $self->elt_stack;
109 52         91 $ev = pop @$stack;
110 52 50       108 if (!$ev) {
111 0         0 $self->throw("no event name on stack");
112             }
113              
114 52         94 my $sh = $self->subhandlers;
115              
116              
117 52         92 my $inside_blocked = grep {$self->is_blocked($_)} @$stack;
  132         314  
118 52 100 100     102 if ($self->is_blocked($ev) &&
119             !$inside_blocked) {
120              
121             # condition:
122             # end of a blocked event, and we are
123             # not inside another blocked event
124 4         11 my ($h, @rest) = @$sh;
125              
126 4         15 my @R = $h->end_event($ev);
127 4         12 foreach my $handler (@rest) {
128 4 100       22 if (@R) {
129 2         18 $handler->event(@$_) foreach @R;
130 2         17 @$_ = () foreach @R;
131             }
132             }
133 4         18 my $tree = $h->tree;
134 4         22 $tree->free;
135             }
136             else {
137              
138 48 100       70 if (grep {$self->is_blocked($_)} @$stack) {
  126         218  
139 25         84 $sh->[0]->end_event($ev);
140             }
141             else {
142 23         42 foreach (@$sh) {
143 46         130 $_->end_event($ev);
144             }
145             }
146             }
147             }
148              
149             1;