| 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 |  |  |  |  |  |  | ################################################################################ |