more restructuring

Makefile

@@ -1,11 +1,12 @@
 # based on tkabber's Makefile
 
-PREFIX = /usr/local
+PREFIX = /usr/
 
 SUBDIRS = plugins           \
           sounds	    \
           images	    \
-	  lib
+	  lib		    \
+	  modes		    
 
 install:
 	mkdir -p $(DESTDIR)/$(PREFIX)/share/milkbone

Makefile.PL

@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+# -----------------------------------------------------------------------------
+# Makefile.PL
+# Currently only works on UNIX-based machines.  Downloads and installs the
+# latest Tk if necessary.  Creates a Makefile that can be used to install
+# milkbone.
+# -----------------------------------------------------------------------------
+
+# automatically install dependencies
+use ExtUtils::AutoInstall (
+			   -version => '0.40',
+			   -config => {
+				       -make_args => "XFT=1"
+				      },
+			   'GUI' => [
+				     'Tk' => '804.025'
+				    ],
+			   'XMMS' => [
+				      'Xmms::Remote' => '',
+				     ]
+			  );
+
+open my $mk, ">Makefile";
+print $mk <<'END';
+END

docs/VERSION.txt

@@ -1,6 +1,9 @@
 0.37
 --
 
+* OS-specific files moved into separate directories
+* user_file replaced with user_dir
+* Dots now replace arrows (e.g. $obj->meth becomes $obj.meth)
 * Fixed Ctrl-Return bug in convos
 * Balloon information for link mouseovers
 * Error dialog now properly focuses the OK button

lib/Milkbone.pm

@@ -8,6 +8,7 @@ package Milkbone;
 
 use strict;
 use warnings;
+use dots;
 
 # standard modules
 use Carp qw(longmess);
@@ -16,7 +17,7 @@ require Exporter;
 # include the rest of the core
 use Milkbone::HookEntry;
 use Milkbone::Util qw(path slurp win32 nix nt loaded_files user_path 
-		      strip_html user_file);
+		      strip_html user_dir);
 use Milkbone::Plugin;
 
 # equal to the version of the current milkbone release
@@ -34,7 +35,7 @@ our @EXPORT = (@Milkbone::Util::EXPORT, qw(hook is_running abort register_hook
 		 unload_plugin reload_core reload_plugin
 		 nix win32 %ARGS path));
 our @EXPORT_OK = (@EXPORT, @Milkbone::Util::EXPORT_OK,
-		  qw(load_plugin));
+		  qw(load_plugin after));
 
 # global variables
 my ($running, $dirty);
@@ -236,6 +237,9 @@ sub unload_plugin
 	}
 }
 
+sub after {
+}
+
 sub plugin_list
 {
     [keys(%plugins)];

lib/Milkbone/Conf.pm

@@ -10,22 +10,23 @@ use strict;
 use warnings;
 
 use Milkbone;
+use XML::Simple;
 
 # standard modules
 use XML::Simple;
 
 # global variables
-my $xml;
+my $config;
 
 # exports
 require Exporter;
 our @EXPORT = qw(option set_option);
 
-register_hook "save_options", sub {
+sub load_options {
-};
+    my ($name, $file) = @_;
 
-register_hook "load_options", sub {
+    $config->{$name} = XMLin($file);
-};
+}
 
 sub option {
 }

lib/Milkbone/Util.pm

@@ -7,13 +7,14 @@ package Milkbone::Util;
 
 use strict;
 use warnings;
+use dots;
 
 use Carp;
 
 our @ISA = qw(Exporter);
 our @EXPORT = qw();
 our @EXPORT_OK = qw(slurp win32 nix nt loaded_files user_path strip_html path
-		   user_file);
+		   user_dir merge_hash);
 
 # read a file in one big slurp
 sub slurp {
@@ -33,8 +34,7 @@ sub slurp {
 }
 
 # general heuristic for removing html from a string
-sub strip_html
+sub strip_html {
-{
 	$_ = shift;
 	s/<br>/\n/gi;
 	s/<.*?>//gi;	
@@ -49,43 +49,38 @@ sub strip_html
 # will be used on.  This probably isn't that bad of an assumption, since Mac
 # OS X is now BSD-based.
 
-sub nix
+sub nix {
-{
     $^O !~ /Win32/;
 }
 
-sub win32
+sub win32 {
-{
     $^O =~ /Win32/;
 }
 
-sub nt
+sub nt {
-{
     return unless win32();
 
     eval 'use Win32';
     return (Win32::GetOSVersion())[4];
 }
 
-sub user_file
+sub user_dir {
-{
+    my $user = data("me");
-	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"));
 
-	mkdir $dir unless -e $dir && -d $dir;
+    mkdir $dir unless -e $dir && -d $dir;
-	mkdir "$dir/$user" unless -e path("$dir/$user") && -d path("$dir/$user");
+    mkdir "$dir/$user" unless -e path("$dir/$user") && 
+      -d path("$dir/$user");
 
-	return "$dir/$user/$file";
+    return "$dir/$user";
 }
 
 # Stolen from Devel::ptkdb - thanks!
-sub loaded_files
+sub loaded_files {
-{
     my @fList = sort {
 	
 	# sort comparison function block
@@ -102,10 +97,9 @@ sub loaded_files
     } grep s/^_<//, keys %main::;
 }
 
-sub path
+sub path {
-{
+    confess "Milkbone::path is deprecated";
-  confess "Milkbone::path is deprecated";
+    return @_;
-  return @_;
 }
 
 1;

lib/dots.pm

@@ -0,0 +1,15 @@
+# -----------------------------------------------------------------------------
+# dots.pm
+# Allows the user to use dots instead of ->'s in OO syntax.  This is nothing
+# more than a repackaging of the DotsForArrows source filter from
+# Damian Conway's Filter::Simple module.
+# -----------------------------------------------------------------------------
+
+package dots;
+
+use Filter::Simple;
+
+FILTER { s/\.(?=[a-z_\$({[])/->/gi };
+
+
+1;

milkbone-0.36.ebuild

@@ -1,23 +0,0 @@
-DESCRIPTION="IM client written in Perl/Tk"
-HOMEPAGE="http://www.milkbone.org"
-IUSE=""
-
-DEPEND=">=dev-lang/perl-5.6*
-	>=dev-perl/perl-tk-800.02*"
-
-SLOT="0"
-LICENSE="GPL-2"
-KEYWORDS="~x86 ~ppc ~alpha ~sparc"
-
-MY_P="$(echo ${P}|sed 's/b$/beta/')"
-SRC_URI="mirror://sourceforge/gaim/${P}.tar.gz"
-S=${WORKDIR}/${MY_P}
-
-src_compile() {
-	true
-
-}
-
-src_install() {
-	einstall || die "Couldn't install
-}

milkbone.pl

@@ -43,9 +43,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("modes/" . $target . ".pl", 1);
+eval { require $script };
-
-eval $script;
 
 # Really serious exceptions will get logged into the file pointed to by
 # $Milkbone::FatalLog.

modes/demotk.pl

@@ -3,11 +3,15 @@
 # Desc: Testing runmode; loads and intializes the Tk interface
 # -----------------------------------------------------------------------------
 
+use strict;
+use warnings;
+use dots;
+
 use Milkbone qw(load_plugin);
 use Milkbone::Hooks qw(create_logon_prompt pre_mainloop mainloop
 		       post_mainloop protocol_signon);
 
-Milkbone->init;
+Milkbone.init;
 
 load_plugin "Tk-GUI";
 
@@ -23,72 +27,9 @@ load_plugin "Tk-PluginsConf";
 load_plugin "Tk-Profile";
 
 # begin unit testing code
+load_plugin "Unit-Test';
 
-register_hook "protocol_signon", sub {
-    hook("after", -time => 10, -code => sub { hook("signed_in") });
-	
-    register_hook "protocol_add_buddy", sub { hook("buddy_in", 
-						   -buddy => $ARGS{-buddy},
-						   -group => $ARGS{-group}); };
-
-    register_hook "protocol_get_groups", sub { return ["Buddies", "You"] };
-    register_hook "protocol_get_realname", sub { return lc $ARGS{-user} };
-    register_hook "protocol_request_info", sub {
-	hook("after", -time => 1000, -code => sub {
-		 hook("protocol_info_received_$ARGS{-user}",
-		      -profile => 'test', -away => 'test');
-	     });
-    };
-
-    register_hook "protocol_send_im", sub {
-	hook("after", -time => 500, -code => [sub {
-				hook("msg_sent_$_[0]",
-				     -user => $_[0],
-				     -msg => $_[1],
-				     -away => 0);
-				hook("after", -time => 500, sub {
-					 hook("msg_in", -user => $_[0], 
-					      -msg => $_[1], -away => 0);
-					 hook("msg_in_$_[0]", -user => $_[0], 
-					      -msg => $_[1], -away => 0);
-				     });
-			    }, $ARGS{-dest}, $ARGS{-msg}]);
-    };
-    register_hook "protocol_away_status", sub { 0 };
-		
-    hook("after", -time => 1000, -code => sub {
-	     hook("buddy_in", -group => 'Buddies', -buddy => 'test_user');
-	 });
-
-    # 	hook("after", -time => 1000, -code => sub {
-    # 		hook("msg_in", -user => 'thatguy', -msg => '<b>hey</b>');
-    # 	});
-
-    # 	hook("after", -time => 1500, -code => sub {
-    # 		hook("protocol_send_im", -dest => 'thatguy', 
-    #           -msg => '<b>hey there</b>');
-
-    hook("after", -time => 500, -code => sub {
-	     register_hook "protocol_chat_accept", sub {
-                 hook("protocol_chat_joined", -name => 'erer', -user => 'er',
-                      -url => 'ere');
-                 hook("protocol_chat_buddy_in_ere", -user => 'charles');
-	     };
-
-	     hook("protocol_chat_invited", -user => 'thatguy', 
-		  -url => 'er');
-	 });
-    register_hook "protocol_get_groups", sub {
-	return ["guys"];
-    };
-
-    register_hook "signed_in", sub {
-	hook("buddy_in", -buddy => 'guy', -group => 'guys');
-    };
-};
 
-protocol_signon -user => 'test', -pass => 'test';
-data("me") = "lala";
 
 # end unit testing code
 

modes/mosh.pl

@@ -1,15 +1,22 @@
 # -----------------------------------------------------------------------------
-# tk.pl
+# mosh.pl
-# Desc: Default guidance script; loads and intializes the Tk interface
+# Desc: Default runmode; loads and intializes the MilkbOne SHell interface
 # -----------------------------------------------------------------------------
 
+use strict;
+use warnings;
+use dots;
+
+use Milkbone qw(load_plugin);
 use Milkbone::Hooks qw(create_logon_prompt pre_mainloop mainloop
-		       post_mainloop protocol_signon);
+		       post_mainloop);
 
-Milkbone->init;
+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";
@@ -23,10 +30,14 @@ load_plugin "Tk-Profile";
 
 load_plugin "Net-OSCAR";
 
+# display the logon prompt
 create_logon_prompt;
 
 pre_mainloop;
+
+# begin ticking
 mainloop;
+
 post_mainloop;
 
-1;
+return 1;

modes/tk.pl

@@ -5,12 +5,13 @@
 
 use strict;
 use warnings;
+use dots;
 
 use Milkbone qw(load_plugin);
 use Milkbone::Hooks qw(create_logon_prompt pre_mainloop mainloop
 		       post_mainloop);
 
-Milkbone->init;
+Milkbone.init;
 
 # the main GUI module - code for ticking, etc.
 load_plugin "Tk-GUI";

plugins/Log.pl

@@ -1,6 +1,6 @@
 package Log;
 
-use Milkbone;
+use Milkbone qw(user_dir);
 use File::Path;
 
 use strict;
@@ -9,7 +9,7 @@ use warnings;
 our $dir;
 
 register_hook("signed_in", sub {
-    $dir = user_file("log");
+    $dir = user_dir . "log";
     mkpath($dir);
 });
 
@@ -28,7 +28,7 @@ sub on_msg_in
 
 sub on_buddy_in
 {
-    return unless -e user_file("log") . "/$ARGS{-buddy}";
+    return unless -e user_dir . "log/" . "/$ARGS{-buddy}";
     my ($hour, $min, $sec) = (localtime)[2,1,0];
     log_item(user_log_file($ARGS{-buddy}), "<font color=\"blue\">" . 
 	     $ARGS{-buddy} . " signed in at $hour:$min:$sec.</font><br>\n\n");

plugins/Unit-Test.pl

@@ -0,0 +1,70 @@
+# -----------------------------------------------------------------------------
+# Unit-Test.pl
+# Tests out some hooks; should be run successfully before any commital
+# -----------------------------------------------------------------------------
+
+register_hook "protocol_signon", sub {
+    hook("after", -time => 10, -code => sub { hook("signed_in") });
+	
+    register_hook "protocol_add_buddy", sub { hook("buddy_in", 
+						   -buddy => $ARGS{-buddy},
+						   -group => $ARGS{-group}); };
+
+    register_hook "protocol_get_groups", sub { return ["Buddies", "You"] };
+    register_hook "protocol_get_realname", sub { return lc $ARGS{-user} };
+    register_hook "protocol_request_info", sub {
+	hook("after", -time => 1000, -code => sub {
+		 hook("protocol_info_received_$ARGS{-user}",
+		      -profile => 'test', -away => 'test');
+	     });
+    };
+
+    register_hook "protocol_send_im", sub {
+	hook("after", -time => 500, -code => [sub {
+				hook("msg_sent_$_[0]",
+				     -user => $_[0],
+				     -msg => $_[1],
+				     -away => 0);
+				hook("after", -time => 500, sub {
+					 hook("msg_in", -user => $_[0], 
+					      -msg => $_[1], -away => 0);
+					 hook("msg_in_$_[0]", -user => $_[0], 
+					      -msg => $_[1], -away => 0);
+				     });
+			    }, $ARGS{-dest}, $ARGS{-msg}]);
+    };
+    register_hook "protocol_away_status", sub { 0 };
+		
+    hook("after", -time => 1000, -code => sub {
+	     hook("buddy_in", -group => 'Buddies', -buddy => 'test_user');
+	 });
+
+    # 	hook("after", -time => 1000, -code => sub {
+    # 		hook("msg_in", -user => 'thatguy', -msg => '<b>hey</b>');
+    # 	});
+
+    # 	hook("after", -time => 1500, -code => sub {
+    # 		hook("protocol_send_im", -dest => 'thatguy', 
+    #           -msg => '<b>hey there</b>');
+
+    hook("after", -time => 500, -code => sub {
+	     register_hook "protocol_chat_accept", sub {
+                 hook("protocol_chat_joined", -name => 'erer', -user => 'er',
+                      -url => 'ere');
+                 hook("protocol_chat_buddy_in_ere", -user => 'charles');
+	     };
+
+	     hook("protocol_chat_invited", -user => 'thatguy', 
+		  -url => 'er');
+	 });
+    register_hook "protocol_get_groups", sub {
+	return ["guys"];
+    };
+
+    register_hook "signed_in", sub {
+	hook("buddy_in", -buddy => 'guy', -group => 'guys');
+    };
+};
+
+protocol_signon -user => 'test', -pass => 'test';
+data("me") = "lala";

sample.conf

@@ -1,5 +1,31 @@
 <?xml version='1.0' encoding='UTF-8' ?>
 <milkbone>
+
+	<core>
+		<fatal_log>fatals.txt</fatal_log>
+	</core>
+
 	<goodbye default="true">sorry gotta go</goodbye>
+	<logging>heavy</logging>
+
+	<item name="buddy-list">
+		<showlogo>0</showlogo>
+	</item>
+
+	<plugin name="Monitor">
+		<recipient>savannah@batkins.com</recipient>
+		<server>mail.batkins.com</server>
+
+		<username>yourname_here</username>
+		<password>yourpass_here</password>
+	</plugin>
+
+	<plugin name="Win32-Tray">
+		<active>0</active>
+	</plugin>
+
+	<plugin name="Away-Manager">
+		<timeout>500</timeout>
+	</plugin>
 
 </milkbone>

tktest.pl

@@ -1,35 +0,0 @@
-# -----------------------------------------------------------------------------
-# 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;