File: ModuleLoader.pm

package info (click to toggle)
libur-perl 0.470%2Bds-3
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 7,192 kB
  • sloc: perl: 61,814; javascript: 255; xml: 108; sh: 13; makefile: 9
file content (165 lines) | stat: -rw-r--r-- 4,535 bytes parent folder | download | duplicates (3)
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

package UR::ModuleLoader;

use strict;
use warnings;
require UR;
our $VERSION = "0.47"; # UR $VERSION;

Class::Autouse->autouse(\&dynamically_load_class);
Class::Autouse->autouse(\&dynamically_load_role);
Class::Autouse->sugar(\&define_class);

our @CARP_NOT = qw(Class::Autouse UR::Namespace);

sub define_class {
    my ($class,$func,@params) = @_;
    return unless $UR::initialized;
    return unless $Class::Autouse::ORIGINAL_CAN->("UR::Object::Type","get");

    # Handle the special case of defining a new class
    # This lets us have the effect of a UNIVERSAL::class method, w/o mucking with UNIVERSAL
    if (defined($func) and $func eq "class" and @params > 1 and $class ne "UR::Object::Type") {
        my @class_params;
        if (@params == 2 and ref($params[1]) eq 'HASH') {
            @class_params = %{ $params[1] };
        }
        elsif (@params == 2 and ref($params[1]) eq 'ARRAY') {
            @class_params = @{ $params[1] };
        }
        else {
            @class_params = @params[1..$#params];
        }
        my $class_meta = UR::Object::Type->define(class_name => $class, @class_params);
        unless ($class_meta) {
            Carp::croak "error defining class $class!";
        }
        return sub { $class };
    }

    else {
        return;
    }
}

sub _should_dynamically_load_package {
    my $package = shift;
    # Don't even try to load unless we're done boostrapping somewhat.
    return unless $UR::initialized;
    return unless $Class::Autouse::ORIGINAL_CAN->("UR::Object::Type","get");

    # Some modules (Class::DBI, recently) call UNIVERSAL::can directly with things which don't even resemble
    # class names.  Skip doing any work on anything which isn't at least a two-part class name.
    # We refuse explicitly to handle top-level namespaces below anyway, and this will keep us from 
    # slowing down other modules just to fail late.

    my ($namespace) = ($package =~ /^(.*?)::/);
    return unless $namespace;

    unless ($namespace->isa("UR::Namespace")) {
        return;
    }

    unless ($namespace->should_dynamically_load_class($package)) {
        return;
    }

    return $namespace;
}

our %loading;

sub dynamically_load_class {
    my ($class,$func,@params) = @_;

    return unless my $namespace = _should_dynamically_load_package($class);

    if (defined($func) and $func eq "class" and @params > 1 and $class ne "UR::Object::Type") {
        # a "class" statement caught by the above define_class call
        return;
    }

    return if $loading{$class};
    local %loading = ( %loading, $class => 1 );

    # Attempt to get a class object, loading it as necessary (probably).
    # TODO: this is a non-standard accessor
    my $meta = $namespace->get_member_class($class);
    unless ($meta) {
        return;
    }

    # Handle the case in which the class is not "generated".
    # These are generated by default when used, so this is a corner case.
    unless ($meta->generated())
    {
        # we have a new class
        # attempt to auto-generate it
        unless ($meta->generate)
        {
            Carp::confess("failed to auto-generate $class");
        }
    }

    # Return a descriptive error message for the caller.
    my $fref;
    if (defined $func) {
        $fref = $class->can($func);
        unless ($fref) {
            Carp::confess("$class was auto-generated successfully but cannot find method $func");
        }
        return $fref;
    }

    return 1;
};

sub dynamically_load_role {
    my($role_name, $func, @params) = @_;

    return unless _should_dynamically_load_package($role_name);

    return if $loading{$role_name};
    local %loading = ( %loading, $role_name => 1 );

    # The module may have actually been loaded by dynamically_load_class(),
    # but failed the check for class-ness
    if (UR::Role::Prototype->is_loaded($role_name)
        &&
        $role_name->can($func)
    ) {
        return 1;
    }

    if (UR::Util::use_package_optimistically($role_name)) {
        if (UR::Role::Prototype->is_loaded($role_name)
            &&
            $role_name->can($func)
        ) {
            return 1;
        }
    }

    return;
}

1;


=pod

=head1 NAME

UR::ModuleLoader - UR hooks into Class::Autouse

=head1 DESCRIPTION

UR uses Class::Autouse to handle automagic loading for modules.  As long
as some part of an application "use"s a Namespace module, the autoloader
will handle loading modules under that namespace when they are needed.

=head1 SEE ALSO

UR, UR::Namespace

=cut