|
|
@ -1,12 +1,10 @@ |
|
|
|
# ----------------------------------------------------------------------------- |
|
|
|
# ---------------------------------------------------------------------- |
|
|
|
# Author(s) : Bill Atkins and Eric Thul |
|
|
|
# Author(s) : Bill Atkins |
|
|
|
# Title : MOS core tools |
|
|
|
# Title : MOS core |
|
|
|
# Date : 12.21.02 |
|
|
|
# Date : 12.21.02 |
|
|
|
# Desc : the hamster that keep MOS going |
|
|
|
# Desc : the hamster that keep MOS going |
|
|
|
# QoTP : got milkbone tools? |
|
|
|
|
|
|
|
# Notes : for more information see the plugin documentation |
|
|
|
|
|
|
|
# License : under the same terms as mos.pl |
|
|
|
# License : under the same terms as mos.pl |
|
|
|
# ----------------------------------------------------------------------------- |
|
|
|
# ---------------------------------------------------------------------- |
|
|
|
|
|
|
|
|
|
|
|
package Milkbone; |
|
|
|
package Milkbone; |
|
|
|
|
|
|
|
|
|
|
@ -203,9 +201,9 @@ sub unload_plugin |
|
|
|
{ |
|
|
|
{ |
|
|
|
if(/^plugins\/$plugin/) |
|
|
|
if(/^plugins\/$plugin/) |
|
|
|
{ |
|
|
|
{ |
|
|
|
s/plugins\///; |
|
|
|
s/plugins\///; |
|
|
|
s/\/$plugin\///; |
|
|
|
s/\/$plugin\///; |
|
|
|
delete $INC{$_}; |
|
|
|
delete $INC{$_}; |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
|
} |
|
|
@ -245,7 +243,7 @@ sub hook |
|
|
|
%ARGS = %args; |
|
|
|
%ARGS = %args; |
|
|
|
|
|
|
|
|
|
|
|
$ARGS{$_} = $hook->{args}->{$_} for %{$hook->{args}}; |
|
|
|
$ARGS{$_} = $hook->{args}->{$_} for %{$hook->{args}}; |
|
|
|
eval { $res = $hook->call; }; |
|
|
|
eval { $res = $hook->call; }; |
|
|
|
print longmess($! . $@) if $@; |
|
|
|
print longmess($! . $@) if $@; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
@ -267,6 +265,7 @@ sub register_hook |
|
|
|
my $entry = new Milkbone::HookEntry($hook, $coderef, $args, $package); |
|
|
|
my $entry = new Milkbone::HookEntry($hook, $coderef, $args, $package); |
|
|
|
|
|
|
|
|
|
|
|
push @{$hooks{$hook}}, $entry; |
|
|
|
push @{$hooks{$hook}}, $entry; |
|
|
|
|
|
|
|
print "$hook registered by $file\n"; |
|
|
|
} |
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
sub deregister_hook |
|
|
|
sub deregister_hook |
|
|
@ -275,10 +274,12 @@ sub deregister_hook |
|
|
|
my ($file, $package, $line) = caller; |
|
|
|
my ($file, $package, $line) = caller; |
|
|
|
my @temp = @{$hooks{$hook}}; |
|
|
|
my @temp = @{$hooks{$hook}}; |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
print "$hook deregistered by $file\n"; |
|
|
|
|
|
|
|
|
|
|
|
die "Required hook missing" if !exists($hooks{$hook}) and $hook eq "tick"; |
|
|
|
die "Required hook missing" if !exists($hooks{$hook}) and $hook eq "tick"; |
|
|
|
warn "Unregistered hook deleted: $hook" if !exists($hooks{$hook}); |
|
|
|
warn "Unregistered hook deleted: $hook" if !exists($hooks{$hook}); |
|
|
|
|
|
|
|
|
|
|
|
@temp = grep { ($_->{package} ne $package) && ($_->{hook_name} ne $hook) } @temp; |
|
|
|
@temp = grep { ($_->{package} ne $package) && ($_->{hook_name} ne $hook) } @{$hooks{$hook}}; |
|
|
|
|
|
|
|
|
|
|
|
@{$hooks{$hook}} = @temp; |
|
|
|
@{$hooks{$hook}} = @temp; |
|
|
|
} |
|
|
|
} |
|
|
|