File Coverage

blib/lib/Mojo/Webqq/Base.pm
Criterion Covered Total %
statement 51 67 76.1
branch 17 36 47.2
condition 6 15 40.0
subroutine 22 242 9.0
pod 0 3 0.0
total 96 363 26.4


line stmt bran cond sub pod time code
1             package Mojo::Webqq::Base;
2 1     1   6 use strict;
  1         3  
  1         27  
3 1     1   5 use warnings;
  1         2  
  1         23  
4 1     1   5 use feature ();
  1         2  
  1         12  
5            
6             # No imports because we get subclassed, a lot!
7 1     1   4 use Carp ();
  1         1  
  1         13  
8            
9             # Only Perl 5.14+ requires it on demand
10 1     1   530 use IO::Handle ();
  1         6142  
  1         128  
11            
12             # Supported on Perl 5.22+
13             my $NAME
14             = eval { require Sub::Util; Sub::Util->can('set_subname') } || sub { $_[1] };
15            
16             # Protect subclasses using AUTOLOAD
17       0     sub DESTROY { }
18            
19             # Declared here to avoid circular require problems in Mojo::Util
20             sub _monkey_patch {
21 224     224   587 my ($class, %patch) = @_;
22 1     1   7 no strict 'refs';
  1         2  
  1         40  
23 1     1   6 no warnings 'redefine';
  1         2  
  1         579  
24 224         1468 *{"${class}::$_"} = $NAME->("${class}::$_", $patch{$_}) for keys %patch;
  224         1334  
25             }
26            
27             sub attr {
28 133     133 0 260 my ($self, $attrs, $value) = @_;
29 133 50 33     602 return unless (my $class = ref $self || $self) && $attrs;
      33        
30            
31 133 50 66     313 Carp::croak 'Default has to be a code reference or constant value'
32             if ref $value && ref $value ne 'CODE';
33            
34 133 100       171 for my $attr (@{ref $attrs eq 'ARRAY' ? $attrs : [$attrs]}) {
  133         394  
35 214 50       728 Carp::croak qq{Attribute "$attr" invalid} unless $attr =~ /^[a-zA-Z_]\w*$/;
36            
37             # Very performance sensitive code with lots of micro-optimizations
38 214 100       420 if (ref $value) {
    100          
39             _monkey_patch $class, $attr, sub {
40             return
41 0 0   0   0 exists $_[0]{$attr} ? $_[0]{$attr} : ($_[0]{$attr} = $value->($_[0]))
    0   0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
42             if @_ == 1;
43 0         0 $_[0]{$attr} = $_[1];
44 0         0 $_[0];
45 35         143 };
46             }
47             elsif (defined $value) {
48             _monkey_patch $class, $attr, sub {
49 0 0   0   0 return exists $_[0]{$attr} ? $_[0]{$attr} : ($_[0]{$attr} = $value)
    0   0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
50             if @_ == 1;
51 0         0 $_[0]{$attr} = $_[1];
52 0         0 $_[0];
53 66         284 };
54             }
55             else {
56             _monkey_patch $class, $attr,
57 113 0   0   418 sub { return $_[0]{$attr} if @_ == 1; $_[0]{$attr} = $_[1]; $_[0] };
  0     0   0  
  0     0   0  
  0     0   0  
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
        0      
58             }
59             }
60             }
61            
62             sub import {
63 25     25   52 my $class = shift;
64 25 100       5414 return unless my $flag = shift;
65            
66             # Base
67 10 100 66     104 if ($flag eq '-base') { $flag = $class }
  2 50       5  
    100          
68            
69             # Strict
70 0         0 elsif ($flag eq '-strict') { $flag = undef }
71            
72             # Module
73             elsif ((my $file = $flag) && !$flag->can('new')) {
74 2         20 $file =~ s!::|'!/!g;
75 2         859 require "$file.pm";
76             }
77            
78             # ISA
79 10 50       184795 if ($flag) {
80 10         25 my $caller = caller;
81 1     1   7 no strict 'refs';
  1         2  
  1         237  
82 10         14 push @{"${caller}::ISA"}, $flag;
  10         124  
83 10     133   57 _monkey_patch $caller, 'has', sub { attr($caller, @_) };
  133     133   262  
        133      
        133      
        133      
        133      
        133      
        133      
        133      
        133      
        133      
84             }
85            
86             # Mojo modules are strict!
87 10         124 $_->import for qw(strict warnings);
88 10         4441 feature->import(':5.10');
89             }
90            
91             sub new {
92 0     0 0   my $class = shift;
93 0 0 0       bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
  0 0          
94             }
95            
96             sub tap {
97 0     0 0   my ($self, $cb) = (shift, shift);
98 0           $_->$cb(@_) for $self;
99 0           return $self;
100             }
101            
102             1;