summaryrefslogtreecommitdiff
path: root/lib/DAKKAR/p.pm
blob: c38121597ce3eb677a5657f458fe61c337d9fa14 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
package DAKKAR::p; 
use 5.012;
use strict;
use warnings;
use utf8 ();
use feature ();
use true ();
use TryCatch ();
use Carp ();
use Sub::Import ();
use namespace::autoclean;
use B::Hooks::EndOfScope;
use Hook::AfterRuntime;
use autobox ();
use Moose::Autobox ();
 
sub import {
    my ($class,@opts) = @_;
    my $caller = caller;
 
    strict->import();
    warnings->import('FATAL'=>'all');
    feature->import':5.12' );
    utf8->import($caller);
    true->import();
    TryCatch->import({into=>$caller});
    Sub::Import->import('Carp',{into=>$caller});
    Moose::Autobox->import();
 
    for (@opts) {
        when ('class') {
            require Moose;
            require MooseX::Params::Validate;
            Moose->import({into=>$caller});
            MooseX::Params::Validate->import({into=>$caller});
            after_runtime {
                $caller->meta->make_immutable;
            }
        };
        when ('role') {
            require Moose::Role;
            require MooseX::Params::Validate;
            Moose::Role->import({into=>$caller});
            MooseX::Params::Validate->import({into=>$caller});
        };
        when ('exporter') {
            on_scope_end {
                __PACKAGE__->mark_as_method('import',$caller);
            }
        };
        when ('test') {
            require lib;
            lib->import('t/lib');
            # yes, this is ugly, but I couldn't find a better way; 
            eval <<"MAGIC" or die "Couldn't set up testing policy: $@";
package $caller;
use Test::Most '-Test::Deep';
use Test::Deep '!blessed';
use Data::Printer;
1;
MAGIC
        }
    }
 
    # this must come after the on_scope_end call above, otherwise the 
    # clean happens before the mark_as_method, and 'import' is cleaned 
    # even though we don't want it to be 
    namespace::autoclean->import(
        -cleanee => $caller,
    );
}
 
sub mark_as_method {
    my ($self,$method_name,$class)=@_;
 
    $class //caller;
 
    my $meta=Class::MOP::Class->initialize($class);
    return if $meta->has_method($method_name);
    my $code = $meta->get_package_symbol({
        name  => $method_name,
        sigil => '&',
        type  => 'CODE',
    });
 
    do { warn "$method_name not found as a CODE symbol!"return }
        unless defined $code;
 
    $meta->add_method(
        $method_name => (
            $meta->wrap_method_body(
                associated_metaclass => $meta,
                name => $method_name,
                body => $code,
            ),
        )
    );
 
    return;
}
 
1;
 
__END__
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=head1 COPYRIGHT AND LICENSE
 
This software is copyright (c) 2011 by Gianni Ceccarelli.
 
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, version 3.
 
=cut