File Coverage

blib/lib/HTML/Lint/Pluggable.pm
Criterion Covered Total %
statement 46 46 100.0
branch 3 6 50.0
condition 2 3 66.6
subroutine 12 12 100.0
pod 3 4 75.0
total 66 71 92.9


line stmt bran cond sub pod time code
1             package HTML::Lint::Pluggable;
2 3     3   161889 use strict;
  3         19  
  3         71  
3 3     3   13 use warnings;
  3         3  
  3         104  
4              
5             our $VERSION = '0.10';
6              
7 3     3   1087 use parent qw/ HTML::Lint /;
  3         718  
  3         15  
8              
9 3     3   46099 use Carp qw/croak/;
  3         7  
  3         169  
10 3     3   1206 use Module::Load ();
  3         2625  
  3         56  
11 3     3   1075 use Package::Stash;
  3         19030  
  3         665  
12              
13             sub new {
14 14     14 1 52300 my $class = shift;
15              
16 14         23 my $subclass;
17 14         20 do {
18 14         234 $subclass = sprintf '%s::__ANON__::%x%x%x', $class, $$, 0+{}, int(rand(65535));
19             } while $subclass->isa($class);
20              
21 14         26 push @{ Package::Stash->new($subclass)->get_or_add_symbol('@ISA') } => $class;
  14         420  
22              
23 14         61 return $subclass->SUPER::new(@_);
24             }
25              
26             sub load_plugins {
27 7     7 1 119 my $self = shift;
28 7         19 while (@_) {
29 10         16 my $plugin = shift;
30 10 50 66     51 my $conf = @_ > 0 && ref($_[0]) eq 'HASH' ? +shift : undef;
31 10         41 $self->load_plugin($plugin, $conf);
32             }
33             }
34              
35             sub load_plugin {
36 10     10 1 22 my ($self, $plugin, $conf) = @_;
37 10 50       34 $plugin = "HTML::Lint::Pluggable::${plugin}" unless $plugin =~ s/^\+//;
38 10         38 Module::Load::load($plugin);
39 10         416 $plugin->init($self, $conf);
40             }
41              
42             sub override {
43 10     10 0 66 my ($self, $method, $code) = @_;
44 10 50       25 my $class = ref($self) or croak('this method can called by instance only.');
45              
46 10         74 my $override_code = $code->($class->can($method));
47              
48             {
49 3     3   21 no strict 'refs'; ## no critic
  3         12  
  3         76  
  10         18  
50 3     3   15 no warnings 'redefine';
  3         5  
  3         210  
51 10         10 *{"${class}::${method}"} = $override_code;
  10         89  
52             }
53             }
54              
55             1;
56             __END__