File Coverage

blib/lib/Ark.pm
Criterion Covered Total %
statement 43 52 82.6
branch 7 10 70.0
condition n/a
subroutine 8 8 100.0
pod n/a
total 58 70 82.8


line stmt bran cond sub pod time code
1             package Ark;
2 61     61   4643951 use 5.008001;
  61         645  
3 61     61   21909 use Mouse 1.00;
  61         1311250  
  61         315  
4 61     61   23267 use Mouse::Exporter;
  61         142  
  61         257  
5              
6 61     61   32793 use Ark::Core;
  61         5973  
  61         11816  
7              
8             our $VERSION = '1.22';
9              
10             do {
11             my %EXPORTS;
12              
13             sub import {
14 184     184   103420 my ($class, @bases) = @_;
15              
16 184         438 my $caller = caller;
17              
18 184         36332 require utf8; import utf8;
  184         1770  
19              
20 184         979 my @super;
21 184 100       641 push @bases, 'Core' unless @bases;
22 184         430 for my $base (@bases) {
23 184         257 my $pkg;
24 184 100       708 if ($base =~ /^\+/) {
25 2         10 ($pkg = $base) =~ s/^\+//;
26             } else {
27 182         538 $pkg = "Ark::${base}";
28             }
29 184         429 push @super, $pkg;
30 184         842 Ark::Core->ensure_class_loaded($pkg);
31              
32 61     61   492 no strict 'refs';
  61         167  
  61         14357  
33 184         6229 for my $keyword (@{ $pkg . '::EXPORT' }) {
  184         840  
34 0         0 push @{ $EXPORTS{$caller} }, $keyword;
  0         0  
35 0         0 *{ $class . '::' . $keyword } = *{ $pkg . '::' . $keyword };
  0         0  
  0         0  
36             }
37              
38 184 100       1496 if (my $exporter = $pkg->can('EXPORT')) {
39 70         193 $exporter->($pkg, $caller);
40             }
41             }
42              
43 184         5364 Mouse::Meta::Class->initialize($caller);
44              
45 184         6431 my ($import, $unimport) = Mouse::Exporter->build_import_methods(
46             exporting_package => $caller,
47             also => "Mouse",
48             );
49              
50 184         43660 $caller->$import({ into => $caller });
51 184         54717 $caller->meta->superclasses(@super);
52              
53 184         12759 push @{ $EXPORTS{$class} }, $unimport;
  184         16594  
54             }
55              
56             sub unimport {
57 11     11   43 my $caller = caller;
58              
59 11 50       40 for my $item (@{ $EXPORTS{$caller} || [] }) {
  11         5446  
60 0 0         if (ref $item eq 'CODE') {
61 0           $caller->$item;
62             }
63             else {
64 61     61   448 no strict 'refs';
  61         141  
  61         5677  
65 0           delete ${ $caller . '::' }{ $item };
  0            
66             }
67             }
68             }
69             };
70              
71             1;
72             __END__
73              
74             =head1 NAME
75              
76             Ark - light weight Catalyst-ish web application framework
77              
78             =head1 SYNOPSIS
79              
80             use Ark;
81              
82             =head1 DESCRIPTION
83              
84             Ark is light weight Catalyst-ish web application framework.
85              
86             =head1 LICENSE
87              
88             Copyright (C) Daisuke Murase.
89              
90             This library is free software; you can redistribute it and/or modify
91             it under the same terms as Perl itself.
92              
93             =head1 AUTHOR
94              
95             Daisuke Murase <typester@cpan.org>
96              
97             =cut