diff --git a/Makefile b/Makefile index 21daf8a..1265705 100644 --- a/Makefile +++ b/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 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..980ab68 --- /dev/null +++ b/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 diff --git a/docs/VERSION.txt b/docs/VERSION.txt index 33c845f..531331f 100644 --- a/docs/VERSION.txt +++ b/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 diff --git a/lib/Milkbone.pm b/lib/Milkbone.pm index e8f1047..cbbcbda 100644 --- a/lib/Milkbone.pm +++ b/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)]; diff --git a/lib/Milkbone/Conf.pm b/lib/Milkbone/Conf.pm index 5cf300a..3594d4c 100644 --- a/lib/Milkbone/Conf.pm +++ b/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 { } diff --git a/lib/Milkbone/Util.pm b/lib/Milkbone/Util.pm index 48a4fa5..872d7f3 100644 --- a/lib/Milkbone/Util.pm +++ b/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/
/\n/gi; s/<.*?>//gi; @@ -49,49 +49,44 @@ 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 -{ - my ($file) = @_; - my $user = data("me"); +sub user_dir { + 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/$user" unless -e path("$dir/$user") && -d path("$dir/$user"); + mkdir $dir unless -e $dir && -d $dir; + 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 -{ - my @fList = sort { - +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 '/') ; @@ -102,10 +97,9 @@ sub loaded_files } grep s/^_'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; diff --git a/milkbone-0.36.ebuild b/milkbone-0.36.ebuild deleted file mode 100644 index 6440e54..0000000 --- a/milkbone-0.36.ebuild +++ /dev/null @@ -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 -} diff --git a/milkbone.pl b/milkbone.pl index 2bcbbbe..0e676aa 100755 --- a/milkbone.pl +++ b/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 $script; +eval { require $script }; # Really serious exceptions will get logged into the file pointed to by # $Milkbone::FatalLog. diff --git a/modes/demotk.pl b/modes/demotk.pl index b70fdf5..b8987ec 100644 --- a/modes/demotk.pl +++ b/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 => 'hey'); - # }); - - # hook("after", -time => 1500, -code => sub { - # hook("protocol_send_im", -dest => 'thatguy', - # -msg => 'hey there'); - - 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 diff --git a/tk.pl b/modes/mosh.pl similarity index 64% rename from tk.pl rename to modes/mosh.pl index 282299d..e256e06 100644 --- a/tk.pl +++ b/modes/mosh.pl @@ -1,15 +1,22 @@ # ----------------------------------------------------------------------------- -# tk.pl -# Desc: Default guidance script; loads and intializes the Tk interface +# mosh.pl +# 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; diff --git a/modes/tk.pl b/modes/tk.pl index 65c7a6e..bfdf642 100644 --- a/modes/tk.pl +++ b/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"; diff --git a/milkbone b/nix/milkbone similarity index 100% rename from milkbone rename to nix/milkbone diff --git a/plugins/Log.pl b/plugins/Log.pl index 31edfcc..4367923 100644 --- a/plugins/Log.pl +++ b/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}), "" . $ARGS{-buddy} . " signed in at $hour:$min:$sec.
\n\n"); diff --git a/plugins/Unit-Test.pl b/plugins/Unit-Test.pl new file mode 100644 index 0000000..94b7ac2 --- /dev/null +++ b/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 => 'hey'); + # }); + + # hook("after", -time => 1500, -code => sub { + # hook("protocol_send_im", -dest => 'thatguy', + # -msg => 'hey there'); + + 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"; diff --git a/sample.conf b/sample.conf index 2fcb2c1..a2c6e42 100644 --- a/sample.conf +++ b/sample.conf @@ -1,5 +1,31 @@ + + + fatals.txt + + sorry gotta go - + heavy + + + 0 + + + + savannah@batkins.com + mail.batkins.com + + yourname_here + yourpass_here + + + + 0 + + + + 500 + + \ No newline at end of file diff --git a/tktest.pl b/tktest.pl deleted file mode 100644 index dba250c..0000000 --- a/tktest.pl +++ /dev/null @@ -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;