Core cleanup

guid/tk.pl

@@ -0,0 +1,41 @@
+# -----------------------------------------------------------------------------
+# tk.pl
+# Desc: Default guidance script; loads and intializes the Tk interface
+# -----------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Milkbone::Hooks qw(create_logon_prompt pre_mainloop mainloop
+		       post_mainloop);
+
+Milkbone->init;
+
+# the main GUI module - code for ticking, etc.
+load_plugin "Tk-GUI";
+
+# load each GUI component
+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";
+
+# display the logon prompt
+create_logon_prompt;
+
+pre_mainloop;
+
+# begin ticking
+mainloop;
+
+post_mainloop;
+
+return 1;

guid/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;

lib/Milkbone.pm

@@ -15,6 +15,8 @@ require Exporter;
 
 # include the rest of the core
 use Milkbone::HookEntry;
+use Milkbone::Util;
+use Milkbone::Plugin;
 
 # equal to the version of the current milkbone release
 our $VERSION = "0.37";
@@ -26,10 +28,12 @@ push @INC, "./plugins";
 
 # exports
 our @ISA = qw( Exporter );
-our @EXPORT = qw(hook is_running abort register_hook option data slurp
+our @EXPORT = qw(@Milkbone::Util::EXPORT 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);
+our @EXPORT_OK = qw(@Milkbone::Util::EXPORT_OK);
 
 # global variables
 my ($running, $dirty);
@@ -340,113 +344,12 @@ sub error
 # Utilities
 # ------------------------------------------
 
-sub path
-{
-	my ($in) = @_;
-
-	if($^O =~ /Win32/)
-	{
-		$in =~ s~/~\\~g;
-	}
-	else
-	{
-		$in =~ s~\\~/~g; 
-	}
-	return $in;
-}
-
 sub data : lvalue
 {
 	$data{$_[0]};
 }
 
-sub slurp
-{
-	my ($file, $no_chomp) = @_;
-	open(FILE, $file) or return "FAILED";
-	my @all = <FILE>;
-	close(FILE) or return "FAILED";
-
-	chomp @all unless $no_chomp;
-
-	if(wantarray)
-	{
-		return @all;
-	}
-	else
-	{
-		return join('', @all);
-	}
-}
-
-sub strip_html
-{
-	$_ = shift;
-	s/<br>/\n/gi;
-	s/<.*?>//gi;	
-	s/&amp;/&/gi;
-	s/&gt;/>/gi;
-	s/&lt;/</gi;
-	s/&quot;/\"/gi;
-	return $_;
-}
-
-# This code assumes that Win32 and *NIX are the only architectures milkbone
-# will be used on.  This probably isn't that bad of an assumption, since Mac
-# OS X is now BSD-based.
-
-sub nix
-{
-    $^O !~ /Win32/;
-}
-
-sub win32
-{
-    $^O =~ /Win32/;
-}
-
-sub nt
-{
-    return unless win32();
-    
-    eval 'use Win32';
-    return (Win32::GetOSVersion())[4];
-}
-
-sub user_file
-{
-	my ($file) = @_;
-	my $user = data("me");
-
-	$ENV{HOME} ||= '';
 
-	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");
-
-	return path("$dir/$user/$file");
-}
-
-# Stolen from Devel::ptkdb - thanks!
-sub loaded_files
-{
-    my @fList = sort { 
-    
-	# sort comparison function block
-	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 ;
-
-    } grep s/^_<//, keys %main::;
-}
 
 # ------------------------------------------
 # Overrrides

lib/Milkbone/Plugin.pm

@@ -10,7 +10,11 @@ use warnings;
 
 sub new {
   my $class = shift;
-  my $self = {};
+  my $self = {
+	      desc => '',
+	      name => '',
+	      package => ''
+	     };
 
   bless $self, $class;
 }

lib/Milkbone/Util.pm

@@ -0,0 +1,102 @@
+# -----------------------------------------------------------------------------
+# Milkbone::Util
+# Generic Milkbone utilities
+# -----------------------------------------------------------------------------
+
+package Milkbone::Util;
+
+use strict;
+use warnings;
+
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(slurp win32 nix nt loaded_files user_path strip_html);
+
+# read a file in one big slurp
+sub slurp
+{
+  my ($file, $no_chomp) = @_;
+  open(my $handle, $file) or die "Failed loading $file";
+  my @all = <$handle>;
+  close($handle);
+
+  chomp @all unless $no_chomp;
+
+  if(wantarray) {
+    return @all;
+  }
+  else {
+    return join('', @all);
+  }
+}
+
+# general heuristic for removing html from a string
+sub strip_html
+{
+	$_ = shift;
+	s/<br>/\n/gi;
+	s/<.*?>//gi;	
+	s/&amp;/&/gi;
+	s/&gt;/>/gi;
+	s/&lt;/</gi;
+	s/&quot;/\"/gi;
+	return $_;
+}
+
+# This code assumes that Win32 and *NIX are the only architectures milkbone
+# will be used on.  This probably isn't that bad of an assumption, since Mac
+# OS X is now BSD-based.
+
+sub nix
+{
+    $^O !~ /Win32/;
+}
+
+sub win32
+{
+    $^O =~ /Win32/;
+}
+
+sub nt
+{
+    return unless win32();
+    
+    eval 'use Win32';
+    return (Win32::GetOSVersion())[4];
+}
+
+sub user_file
+{
+	my ($file) = @_;
+	my $user = data("me");
+
+	$ENV{HOME} ||= '';
+
+	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");
+
+	return path("$dir/$user/$file");
+}
+
+# Stolen from Devel::ptkdb - thanks!
+sub loaded_files
+{
+    my @fList = sort { 
+    
+	# sort comparison function block
+	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 ;
+
+    } grep s/^_<//, keys %main::;
+}
+
+1;

milkbone

@@ -16,7 +16,7 @@ use warnings;
 # sets default values (e.g. $Milkbone::FatalLog).
 
 use lib 'lib';
-use Milkbone;
+use Milkbone qw(slurp);
 
 # Launch the correct guidance script based on the command-line parameters.
 # Note that linking this script to milkbone-x and then invoking that link
@@ -41,11 +41,7 @@ else {
 # something must have gone terribly wrong.  Note that the guidance script
 # doesn't return until the user has closed milkbone.
 
-my $script = slurp($target . ".pl", 1);
-$script = <<'END' . $script;
-use strict;
-use warnings;
-END
+my $script = slurp("guid/" . $target . ".pl", 1);
 
 eval $script;
 

sample.conf

@@ -0,0 +1,5 @@
+<?xml version='1.0' encoding='UTF-8' ?>
+<milkbone>
+	<goodbye default="true">sorry gotta go</goodbye>
+	
+</milkbone>