archive
/
milkbone
1
0
Fork 0
Code Pull Requests Projects Releases Activity
Browse Source

added Milkbone::Plugin and ::Conf

master
milkbone57 22 years ago
parent
f920a982ac
commit
565676106c
5 changed files with 228 additions and 99 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 206
      lib/Milkbone.pm
  2. 36
      lib/Milkbone/Conf.pm
  3. 18
      lib/Milkbone/Plugin.pm
  4. 32
      tk.pl
  5. 35
      tktest.pl

206
Milkbone.pm → lib/Milkbone.pm
Unescape View File

@ -1,11 +1,7 @@ @@ -1,11 +1,7 @@
# -----------------------------------------------------------------------------
# Author(s) : Bill Atkins
# Title : MOS core tools
# Date : 12.21.02
# 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
# Milkbone.pm
# Desc: Contains the code for the hook system and plugin management. Exports
# aliases to some of the other parts of the core.
# -----------------------------------------------------------------------------
package Milkbone;
@ -13,57 +9,63 @@ package Milkbone; @@ -13,57 +9,63 @@ package Milkbone;
use strict;
use warnings;
# standard modules
use Carp qw(longmess);
require Exporter;
# include the rest of the core
use Milkbone::HookEntry;
use Milkbone::AllHooks;
use Benchmark;
our $VERSION = "0.361";
# equal to the version of the current milkbone release
our $VERSION = "0.37";
# initialition
# XXX: FatalLog needs to go to the config
our $FatalLog = "fatals.txt";
push @INC, "./plugins";
require Exporter;
# exports
our @ISA = qw( Exporter );
our @EXPORT = qw( hook is_running abort queued_hook register_hook option path data %ARGS slurp
deregister_hook strip_html user_file set_option MOSLoop set_interval unload_plugin load_plugin init_plugin reload_core reload_plugin nix win32);
our @EXPORT_OK = qw( );
our @EXPORT = qw(hook is_running abort register_hook option data slurp
deregister_hook strip_html user_file set_option
unload_plugin load_plugin reload_core reload_plugin
nix win32 %ARGS);
# global variables
my ($running, $dirty);
my $interval = 0.006;
our (%hooks, %options, %data, %plugins);
our (%ARGS) = ();
$running = 1;
# autoflushing on
$| = 1;
# returns a boolean indicating whether or not the core loop is running
sub is_running
{
$running;
}
sub set_interval
{
$interval = shift;
$running;
}
# end the core loop and begin shutdown
sub abort
{
$running = 0;
die @_;
$running = 0;
print @_;
exit;
}
# initialize the core
sub init
{
# initialization
register_hook("load_options", \&load_options);
register_hook("load_plugins", \&load_plugins);
register_hook("post_mainloop", \&post_mainloop);
register_hook("pre_mainloop", \&pre_mainloop);
register_hook("save_options", \&save_options);
register_hook("loaded_plugins", \&plugin_list);
register_hook("error", \&error);
register_hook("load_plugins", \&load_plugins);
register_hook("pre_mainloop", \&pre_mainloop);
register_hook("post_mainloop", \&post_mainloop);
register_hook("save_options", \&save_options);
register_hook("loaded_plugins", \&plugin_list);
register_hook("error", \&error);
}
# ------------------------------------------
@ -73,7 +75,7 @@ sub init @@ -73,7 +75,7 @@ sub init
sub load_options
{
my ($directive, $temp, @args);
my $file = $ARGS{-file} || "mb.conf";
my $file = $ARGS{-file} || "mb.conf";
open(GLOBAL, "<$file") or die "Can't open config file: $!";
@ -103,7 +105,7 @@ sub load_options @@ -103,7 +105,7 @@ sub load_options
sub save_options
{
return unless $dirty;
return unless $dirty;
my ($val, @temp, $str);
open(GLOBAL, ">mb.conf") or die "Can't open config file: $!";
print GLOBAL "# mb.conf - milkbone global configuration file\n\n";
@ -151,66 +153,79 @@ sub set_option @@ -151,66 +153,79 @@ sub set_option
my ($name, $val) = @_;
$options{$name} = \$val;
$dirty = 1;
$dirty = 1;
}
sub load_plugin
# prepare plugin for loading by adding it to @INC
sub prep_plugin
{
my ($plugin) = @_;
return unless $plugin;
my ($plugin) = @_;
return unless $plugin;
if(-e path("plugins/$plugin.pl")) {
# single-file plugin - no need for @INC setting
}
elsif(-e path("plugins/$plugin") and -d path("plugins/$plugin")) {
# multi-file plugin - add its folder to @INC
unshift @INC, path("plugins/$plugin");
}
else {
# plugin doesn't exist
die "Couldn't load plugin $plugin";
return;
}
# mark plugin as loaded
$plugins{$plugin} = 1;
}
if(-e path("plugins/$plugin.pl"))
{
}
# PAR support - disabled in non-Mercury releases
#elsif(-e path("plugins/$plugin.zip"))
#{
# PAR->import(path("plugins/$plugin.zip"));
#}
elsif(-e path("plugins/$plugin") and -d path("plugins/$plugin"))
{
unshift @INC, path("plugins/$plugin");
}
else
{
die "Couldn't load plugin $plugin";
return;
}
# call a plugin's initialization code
sub init_plugin
{
my ($plugin) = @_;
eval "require \"$plugin.pl\";";
error("Couldn't require $plugin.pl for $plugin: $@") if $@;
}
$plugins{$plugin} = 1;
# load one or more plugins
sub load_plugin
{
for my $plugin (@_) {
prep_plugin($plugin);
init_plugin($plugin);
}
}
# unload a plugin from the core
sub unload_plugin
{
my ($plugin) = @_;
my $package = $plugin;
$package =~ s/-//g;
for my $element (keys %hooks)
my ($plugin) = @_;
my $package = $plugin;
$package =~ s/-//g;
for my $element (keys %hooks) {
my @new;
for(@{$hooks{$element}}) {
unless($_->{package} eq $package)
{
my @new;
for(@{$hooks{$element}})
{
unless($_->{package} eq $package)
{
push @new, $_;
}
}
$hooks{$element} = \@new;
}
delete $plugins{$plugin};
for(loaded_files())
{
if(/^plugins\/$plugin/)
{
s/plugins\///;
s/\/$plugin\///;
delete $INC{$_};
}
}
delete $plugins{$plugin};
for(loaded_files())
{
if(/^plugins\/$plugin/)
{
s/plugins\///;
s/\/$plugin\///;
delete $INC{$_};
}
}
}
sub plugin_list
@ -218,17 +233,11 @@ sub plugin_list @@ -218,17 +233,11 @@ sub plugin_list
[keys(%plugins)];
}
sub init_plugin
{
my ($plugin) = @_;
eval "require \"$plugin.pl\";" or hook("error", -short => "Couldn't require $plugin.pl for $plugin: $! $@");
}
sub load_plugins
{
my @plugins = grep({ $_ } (option("Modules"), option("Plugins")));
push @INC, "./plugins";
load_plugin($_) for @plugins;
init_plugin($_) for(@plugins);
}
@ -256,7 +265,7 @@ sub hook @@ -256,7 +265,7 @@ sub hook
%ARGS = %args;
$ARGS{$_} = $hook->{args}->{$_} for %{$hook->{args}};
eval { $res = $hook->call; };
eval { $res = $hook->call; };
print longmess($! . $@) if $@;
}
@ -293,18 +302,17 @@ sub deregister_hook @@ -293,18 +302,17 @@ sub deregister_hook
@{$hooks{$hook}} = @temp;
# delete $hooks{$hook} unless @temp;
# delete $hooks{$hook} unless @temp;
}
sub MOSLoop
{
register_hook "mainloop", sub {
my $i = 0;
while(is_running)
{
hook("tick");
# select(undef, undef, undef, $interval) if $i++ % 5 == 0 && $interval;
}
}
};
# ------------------------------------------
# Default Hooks
@ -410,10 +418,10 @@ sub user_file @@ -410,10 +418,10 @@ sub user_file
my ($file) = @_;
my $user = data("me");
$ENV{HOME} ||= '';
$ENV{HOME} ||= '';
my $dir = (nix() ? "$ENV{HOME}/.milkbone" :
(exists($ENV{APPDATA}) ? "$ENV{APPDATA}/milkbone" : "profiles"));
my $dir = (nix() ? "$ENV{HOME}/.milkbone" :
(exists($ENV{APPDATA}) ? "$ENV{APPDATA}/milkbone" : "profiles"));
mkdir $dir unless -e $dir && -d $dir;
mkdir path("$dir/$user") unless -e path("$dir/$user") && -d path("$dir/$user");
@ -427,15 +435,15 @@ sub loaded_files @@ -427,15 +435,15 @@ sub loaded_files
my @fList = sort {
# sort comparison function block
my $fa = substr($a, 0, 1) ;
my $fb = substr($b, 0, 1) ;
my $fa = substr($a, 0, 1) ;
my $fb = substr($b, 0, 1) ;
return $a cmp $b if ($fa eq '/') && ($fb eq '/') ;
return -1 if ($fb eq '/') && ($fa ne '/') ;
return 1 if ($fa eq '/' ) && ($fb ne '/') ;
return $a cmp $b if ($fa eq '/') && ($fb eq '/') ;
return -1 if ($fb eq '/') && ($fa ne '/') ;
return 1 if ($fa eq '/' ) && ($fb ne '/') ;
return $a cmp $b ;
return $a cmp $b ;
} grep s/^_<//, keys %main::;
}

36
lib/Milkbone/Conf.pm
Unescape View File

@ -0,0 +1,36 @@ @@ -0,0 +1,36 @@
# -----------------------------------------------------------------------------
# Milkbone::Conf
# Desc: Registers hooks for loading, modifying, reading, and saving XML
# configuration.
# -----------------------------------------------------------------------------
package Milkbone::Conf;
use strict;
use warnings;
use Milkbone;
# standard modules
use XML::Simple;
# global variables
my $xml;
# exports
require Exporter;
our @EXPORT = qw(option set_option);
register_hook "save_options", sub {
};
register_hook "load_options", sub {
};
sub option {
}
sub set_option {
}
1;

18
lib/Milkbone/Plugin.pm
Unescape View File

@ -0,0 +1,18 @@ @@ -0,0 +1,18 @@
# -----------------------------------------------------------------------------
# Milkbone::Plugin
# Desc: Stores information about each running plugin
# -----------------------------------------------------------------------------
package Milkbone::Plugin;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
}
1;

32
tk.pl
Unescape View File

@ -0,0 +1,32 @@ @@ -0,0 +1,32 @@
# -----------------------------------------------------------------------------
# tk.pl
# Desc: Default guidance script; loads and intializes the Tk interface
# -----------------------------------------------------------------------------
use Milkbone::Hooks qw(create_logon_prompt pre_mainloop mainloop
post_mainloop protocol_signon);
Milkbone->init;
load_plugin "Tk-GUI";
load_plugin "Tk-About";
load_plugin "Tk-AddBuddy";
load_plugin "Tk-BList";
load_plugin "Tk-Convo";
load_plugin "Tk-Chat";
load_plugin "Tk-Conf";
load_plugin "Tk-File";
load_plugin "Tk-Logon";
load_plugin "Tk-PluginsConf";
load_plugin "Tk-Profile";
load_plugin "Net-OSCAR";
create_logon_prompt;
pre_mainloop;
mainloop;
post_mainloop;
1;

35
tktest.pl
Unescape View File

@ -0,0 +1,35 @@ @@ -0,0 +1,35 @@
# -----------------------------------------------------------------------------
# tktest.pl
# Desc: Testing guidance script; loads and intializes the Tk interfacey
# -----------------------------------------------------------------------------
use Milkbone::Hooks qw(create_logon_prompt pre_mainloop mainloop
post_mainloop protocol_signon);
Milkbone->init;
load_plugin "Tk-GUI";
load_plugin "Tk-About";
load_plugin "Tk-AddBuddy";
load_plugin "Tk-BList";
load_plugin "Tk-Convo";
load_plugin "Tk-Chat";
load_plugin "Tk-Conf";
load_plugin "Tk-File";
load_plugin "Tk-Logon";
load_plugin "Tk-PluginsConf";
load_plugin "Tk-Profile";
# begin unit testing code
protocol_signon -user => 'test', -pass => 'test';
data("me") = "lala";
# end unit testing code
pre_mainloop;
mainloop;
post_mainloop;
1;
Write Preview
Loading…
Cancel
Save