File Coverage

blib/lib/Aion/Spirit.pm
Criterion Covered Total %
statement 43 43 100.0
branch 12 12 100.0
condition 3 3 100.0
subroutine 17 17 100.0
pod 4 4 100.0
total 79 79 100.0


line stmt bran cond sub pod time code
1             package Aion::Spirit;
2 1     1   59880 use 5.22.0;
  1         5  
3 1     1   5 no strict; no warnings; no diagnostics;
  1     1   1  
  1     1   47  
  1         10  
  1         1  
  1         57  
  1         544  
  1         188869  
  1         250  
4 1     1   9 use common::sense;
  1         2  
  1         13  
5              
6             our $VERSION = "0.0.1";
7              
8 1     1   86 use Exporter qw/import/;
  1         1  
  1         123  
9             our @EXPORT = our @EXPORT_OK = grep {
10             *{$Aion::Spirit::{$_}}{CODE} && !/^(_|(NaN|import)\z)/n
11             } keys %Aion::Spirit::;
12              
13              
14 1     1   495 use Sub::Util qw//;
  1         287  
  1         378  
15              
16             #@category Аспект-ориентированное программирование
17              
18             # Оборачивает функции в пакете в указанную по регулярке.
19             # Имя функции идёт вместе с пакетом
20             sub aroundsub($$;$) {
21 2 100   2 1 1174 my ($pkg, $re, $around) = @_==3? @_: (scalar caller, @_);
22 2         4 my $x = \%{"${pkg}::"};
  2         7  
23              
24 2         7 for my $g (values %$x) {
25 12 100       27 next if ref \$g ne "GLOB";
26 11         13 my $sub = *{$g}{CODE};
  11         26  
27              
28 11 100 100     87 if($sub && Sub::Util::subname($sub) =~ $re) {
29 4         8 *$g = wrapsub($sub => $around);
30             }
31             }
32             }
33              
34             # Оборачивает функцию в другую
35             sub wrapsub($$) {
36 5     5 1 250 my ($sub, $around) = @_;
37              
38 5     5   18 my $s = sub { unshift @_, $sub; goto &$around };
  5     5   10131  
  5     5   18  
        5      
        5      
        5      
39              
40 5         25 my $subname = Sub::Util::subname $sub;
41              
42 5         18 Sub::Util::set_subname "${subname}__AROUND" =>
43             Sub::Util::set_prototype Sub::Util::prototype($sub) => $s;
44              
45 5         2157 $s
46             }
47              
48             #@category Проверки
49              
50             # assert
51             sub ASSERT ($$) {
52 3 100   3 1 3748 die "ASSERT: ".(ref $_[1]? $_[1]->(): $_[1])."\n" if !$_[0];
    100          
53             }
54              
55             #@category Списки
56              
57             # Ищет в списке первое совпадение и возвращает индекс найденного элемента
58             sub firstidx (&@) {
59 2     2 1 3121 my $s = shift;
60              
61 2         4 my $i = 0;
62 2         3 for(@_) {
63 6 100       10 return $i if $s->();
64 5         22 $i++;
65             }
66 1         2 return undef;
67             }
68              
69             1;
70              
71             __END__