File Coverage

blib/lib/IO/Async/XMLStream/SAXReader/DuckHandler.pm
Criterion Covered Total %
statement 14 35 40.0
branch 0 10 0.0
condition n/a
subroutine 5 10 50.0
pod 0 2 0.0
total 19 57 33.3


line stmt bran cond sub pod time code
1 1     1   445 use 5.006; # our
  1         2  
2 1     1   4 use strict;
  1         1  
  1         19  
3 1     1   12 use warnings;
  1         1  
  1         95  
4              
5             package IO::Async::XMLStream::SAXReader::DuckHandler;
6              
7             our $VERSION = '0.001001';
8              
9             # ABSTRACT: Deferred Handler proxy for IO::Async constructor-driven interface
10              
11             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
12              
13 1     1   5 use Scalar::Util qw(weaken);
  1         1  
  1         82  
14 1     1   3 use Carp qw(croak);
  1         1  
  1         287  
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25             sub new {
26 0     0 0   my ( $self, $opts ) = @_;
27 0 0         croak('SAXReader option is mandatory') unless exists $opts->{SAXReader};
28 0           weaken $opts->{SAXReader};
29 0           return bless $opts, $self;
30             }
31              
32             sub _dyn_method {
33 0     0     my ( $self, $method ) = @_;
34 0           my $sax = $self->{SAXReader};
35 0           my $event = 'on_' . $method;
36 0           my $callback = $sax->can_event($event);
37 0 0         return unless $callback;
38             return sub {
39 0     0     my ( undef, @args ) = @_;
40 0           return $callback->( $sax, @args );
41 0           };
42             }
43              
44             sub can {
45 0     0 0   my ( $self, $method ) = @_;
46 0           my $orig = $self->SUPER::can($method);
47 0 0         return $orig if $orig;
48 0           return $self->_dyn_method($method);
49             }
50              
51             ## no critic (ClassHierarchies::ProhibitAutoloading)
52             sub AUTOLOAD {
53 0     0     my ( $self, @args ) = @_;
54 0           ( my $methname = our $AUTOLOAD ) =~ s/.+:://msx;
55 0 0         return if 'DESTROY' eq $methname;
56 0 0         return unless my $meth = $self->_dyn_method($methname);
57 0           return $meth->( $self, @args );
58             }
59              
60             1;
61              
62             __END__