added Milkbone::Plugin and ::Conf

lib/Milkbone.pm

@@ -1,11 +1,7 @@
 # -----------------------------------------------------------------------------
-# Author(s)	:	Bill Atkins
+# Milkbone.pm
-# Title		:	MOS core tools
+# Desc: Contains the code for the hook system and plugin management.  Exports
-# Date		:	12.21.02
+# aliases to some of the other parts of the core.
-# 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
 # -----------------------------------------------------------------------------
 
 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
+our @EXPORT = qw(hook is_running abort register_hook option data slurp
-	deregister_hook strip_html user_file set_option MOSLoop set_interval unload_plugin load_plugin init_plugin reload_core reload_plugin nix win32);
+		 deregister_hook strip_html user_file set_option
-our @EXPORT_OK = qw( );
+		 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;
+  $running;
-}
-
-sub set_interval
-{
-	$interval = shift;
 }
 
+# end the core loop and begin shutdown
 sub abort
 {
-	$running = 0;
+  $running = 0;
-	die @_;
+  print @_;
+  exit;
 }
 
+# initialize the core
 sub init
 {
-	# initialization
+  register_hook("load_plugins", \&load_plugins);
-	register_hook("load_options", \&load_options);
+  register_hook("pre_mainloop", \&pre_mainloop);
-	register_hook("load_plugins", \&load_plugins);
+  register_hook("post_mainloop", \&post_mainloop);
-	register_hook("post_mainloop", \&post_mainloop);
+  register_hook("save_options", \&save_options);
-	register_hook("pre_mainloop", \&pre_mainloop);
+  register_hook("loaded_plugins", \&plugin_list);
-	register_hook("save_options", \&save_options);
+  register_hook("error", \&error);
-	register_hook("loaded_plugins", \&plugin_list);
-	register_hook("error", \&error);
 }
 
 # ------------------------------------------
@@ -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
 
 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
 	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) = @_;
+  my ($plugin) = @_;
-
+
-	return unless $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"))
+# call a plugin's initialization code
-	{
+sub init_plugin
-	}
+{
-        # PAR support - disabled in non-Mercury releases
+  my ($plugin) = @_;
-	#elsif(-e path("plugins/$plugin.zip"))
+  eval "require \"$plugin.pl\";";
-	#{
+  error("Couldn't require $plugin.pl for $plugin: $@") if $@;
-	#	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;
-	}
 
-        $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 ($plugin) = @_;
-        my $package = $plugin;
+  my $package = $plugin;
-        $package =~ s/-//g;
+  $package =~ s/-//g;
-
+
-	for my $element (keys %hooks)
+  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};
+	delete $plugins{$plugin};
-
+
-        for(loaded_files())
+	for(loaded_files())
-        {
+	{
-           if(/^plugins\/$plugin/)
+	   if(/^plugins\/$plugin/)
-           {
+	   {
-             s/plugins\///;
+	     s/plugins\///;
-             s/\/$plugin\///;
+	     s/\/$plugin\///;
-             delete $INC{$_};
+	     delete $INC{$_};
-           } 
+	   } 
-        }
+	}
 }
 
 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
 		%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
 
 	@{$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
 	my ($file) = @_;
 	my $user = data("me");
 
-        $ENV{HOME} ||= '';
+	$ENV{HOME} ||= '';
 
-        my $dir = (nix()  ? "$ENV{HOME}/.milkbone" : 
+	my $dir = (nix()  ? "$ENV{HOME}/.milkbone" : 
-            (exists($ENV{APPDATA}) ? "$ENV{APPDATA}/milkbone" : "profiles"));
+	    (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
     my @fList = sort { 
     
 	# sort comparison function block
-        my $fa = substr($a, 0, 1) ;
+	my $fa = substr($a, 0, 1) ;
-        my $fb = substr($b, 0, 1) ;
+	my $fb = substr($b, 0, 1) ;
 
-        return $a cmp $b if ($fa eq '/') && ($fb eq '/') ;
+	return $a cmp $b if ($fa eq '/') && ($fb eq '/') ;
 	
-        return -1 if ($fb eq '/') && ($fa ne '/') ;
+	return -1 if ($fb eq '/') && ($fa ne '/') ;
-        return 1 if ($fa eq '/' ) && ($fb ne '/') ;
+	return 1 if ($fa eq '/' ) && ($fb ne '/') ;
 
-        return $a cmp $b ;
+	return $a cmp $b ;
 
     } grep s/^_<//, keys %main::;
 }

lib/Milkbone/Conf.pm

@@ -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;

lib/Milkbone/Plugin.pm

@@ -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;

tk.pl

@@ -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;

tktest.pl

@@ -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;