File Coverage

blib/lib/Apache/Voodoo/Loader/Dynamic.pm
Criterion Covered Total %
statement 84 103 81.5
branch 11 20 55.0
condition 4 6 66.6
subroutine 17 18 94.4
pod 0 5 0.0
total 116 152 76.3


line stmt bran cond sub pod time code
1             package Apache::Voodoo::Loader::Dynamic;
2              
3             $VERSION = "3.0200";
4              
5 2     2   1232 use strict;
  2         5  
  2         82  
6 2     2   10 use warnings;
  2         5  
  2         67  
7              
8 2     2   12 use base("Apache::Voodoo::Loader");
  2         19  
  2         1059  
9              
10             sub new {
11 5     5 0 13 my $class = shift;
12              
13 5         7 my $self = {};
14 5         17 bless $self,$class;
15              
16 5         21 $self->{'module'} = shift;
17              
18 5         11 $self->{'bootstrapping'} = 1;
19 5         15 $self->refresh;
20 5         10 $self->{'bootstrapping'} = 0;
21              
22 5         11 $self->{'parents'} = {};
23 5         306 foreach (eval '@{'.$self->{'module'}.'::ISA}') {
24 5         17 $self->{'parents'}->{$_} = $self->get_mtime($_);
25             }
26              
27 5         25 return $self;
28             }
29              
30             sub init {
31 5     5 0 9 my $self = shift;
32              
33 5         12 $self->{'config'} = \@_;
34 5         27 $self->{'object'}->init(@_);
35             }
36              
37             sub get_mtime {
38 31     31 0 53 my $self = shift;
39 31   66     151 my $file = shift || $self->{'module'};
40              
41 31         251 $file =~ s/::/\//go;
42 31         51 $file .= ".pm";
43              
44 31 50       137 return 0 unless defined($INC{$file});
45              
46 31         917 my $mtime = (stat($INC{$file}))[9];
47              
48 31         138 return $mtime;
49             }
50              
51             sub refresh {
52 9     9 0 18 my $self = shift;
53              
54 9         49 $self->{'object'} = $self->load_module;
55 9         257 $self->{'mtime'} = $self->get_mtime;
56              
57             # zap our created closures.
58 9         16 foreach my $method (keys %{$self->{'provides'}}) {
  9         50  
59             # a little help from the Cookbook 10.14
60 2     2   13 no strict 'refs';
  2         5  
  2         75  
61 2     2   33 no warnings 'redefine';
  2         12  
  2         357  
62 6         503 *$method = undef;
63             }
64 9         37 $self->{'provides'} = {};
65             }
66              
67             #
68             # Override the built in 'can' to allow:
69             # a) trigger dynamically reloading the module as needed
70             # b) dynamically create closures to link Apache::Voodoo::Handler with the controllers
71             #
72             sub can {
73 9     9 0 2281 my $self = shift;
74 9         22 my $method = shift;
75 9         17 my $nosub = shift;
76              
77             # find out if this thing has changed
78 9 100       142 if ($self->{'mtime'} != $self->get_mtime) {
79 4         23 $self->refresh;
80 4         17 $self->{'object'}->init(@{$self->{'config'}});
  4         30  
81             }
82              
83 9 50 66     227 if (defined $self->{'provides'}->{$method}) {
    100          
84 0         0 return 1;
85             }
86             elsif ($self->{'object'}->isa("Apache::Voodoo::Zombie") || $self->{'object'}->can($method)) {
87             # Either we have a dead module and we map whatever was requested or
88             # we have a live one and has the requested method.
89              
90             # cache the existance of this method
91 8         24 $self->{'provides'}->{$method} = 1;
92              
93             # If we used the autoloader to get here, then we want to keep using
94             # it. Bypass the creation of the closure.
95 8 100       27 unless ($nosub) {
96             # create a closeure for this method (a little help from the Cookbook 10.14)
97 2     2   11 no strict 'refs';
  2         3  
  2         57  
98 2     2   9 no warnings 'redefine';
  2         3  
  2         681  
99 1     1   16 *$method = sub { my $self = shift; return $self->_handle($method,@_); };
  1         625  
  1         7  
100             }
101 8         37 return 1;
102             }
103              
104 1         7 return 0;
105             }
106              
107             #
108             # In scnearios where the caller doesn't know that can has been overloaded, we'll use
109             # autoload to catch it and call our overloaded can. We unfortunately end up with two
110             # different ways to do a very similar task because the constraints are slightly different.
111             # We want the calls from the A::V::Handler to the controllers to be aware of what methods
112             # actually exist so it can either call them or not. The controllers talking to the models
113             # shouldn't have to do anything special or even be aware that they're talking to this
114             # proxy object, thus the need for a autoload variation.
115             #
116             sub AUTOLOAD {
117 7 50   7   3390724 next unless ref($_[0]);
118              
119 7         17 our $AUTOLOAD;
120 7         21 my $method = $AUTOLOAD;
121 7         94 $method =~ s/.*:://;
122              
123 7         22 my $self = shift;
124              
125 7 50       37 if ($self->can($method,'1')) {
126 7         29 return $self->_handle($method,@_);
127             }
128              
129             # we don't handle this one
130 0         0 next;
131             }
132              
133             # now we need a stub for destroy to keep autoloader happy.
134 0     0   0 sub DESTROY { }
135              
136             sub _handle {
137 8     8   64 my $self = shift;
138 8         16 my $method = shift;
139 8         16 my @params = @_;
140              
141             # check parent modules for change
142 8         717 foreach my $module (eval '@{'.$self->{'module'}.'::ISA}') {
143 8         65 my $t = $self->get_mtime($module);
144 8 50       162 if ($self->{'parents'}->{$module} != $t) {
145 0         0 $self->{'parents'}->{$module} = $t;
146              
147 0         0 my $file = $module;
148 0         0 $file =~ s/::/\//go;
149 0         0 $file .= ".pm";
150              
151 2     2   12 no warnings 'redefine';
  2         2  
  2         97  
152 0         0 delete $INC{$file};
153 0         0 eval {
154 2     2   11 no warnings 'redefine';
  2         10  
  2         475  
155 0         0 require $file;
156             };
157 0 0       0 if ($@) {
158 0         0 my $error= "There was an error loading one of the base classes for this page ($_):\n\n$@\n";
159              
160 0         0 my $link = $self->{'module'};
161              
162 0         0 $link =~ s/::/\//g;
163 0 0       0 unless ($method eq "handle") {
164 0         0 $link =~ s/([^\/]+)$/$method."_".$1/e;
  0         0  
165             }
166              
167             # FIXME replace with a instance of Apache::Voodoo::Zombie
168 0         0 $self->debug("ZOMBIE: $self->{'module'} $method");
169 0         0 return $self->display_error($error,"/$link");
170             }
171             }
172             }
173              
174 8         58 return $self->{'object'}->$method(@params);
175             }
176              
177             1;
178              
179             ################################################################################
180             # Copyright (c) 2005-2010 Steven Edwards (maverick@smurfbane.org).
181             # All rights reserved.
182             #
183             # You may use and distribute Apache::Voodoo under the terms described in the
184             # LICENSE file include in this package. The summary is it's a legalese version
185             # of the Artistic License :)
186             #
187             ################################################################################