Browse Source

more restructuring

master
milkbone57 22 years ago
parent
commit
5167fe6973
  1. 5
      Makefile
  2. 25
      Makefile.PL
  3. 3
      docs/VERSION.txt
  4. 8
      lib/Milkbone.pm
  5. 11
      lib/Milkbone/Conf.pm
  6. 50
      lib/Milkbone/Util.pm
  7. 15
      lib/dots.pm
  8. 23
      milkbone-0.36.ebuild
  9. 4
      milkbone.pl
  10. 71
      modes/demotk.pl
  11. 21
      modes/mosh.pl
  12. 3
      modes/tk.pl
  13. 0
      nix/milkbone
  14. 6
      plugins/Log.pl
  15. 70
      plugins/Unit-Test.pl
  16. 28
      sample.conf
  17. 35
      tktest.pl

5
Makefile

@ -1,11 +1,12 @@ @@ -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

25
Makefile.PL

@ -0,0 +1,25 @@ @@ -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

3
docs/VERSION.txt

@ -1,6 +1,9 @@ @@ -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

8
lib/Milkbone.pm

@ -8,6 +8,7 @@ package Milkbone; @@ -8,6 +8,7 @@ package Milkbone;
use strict;
use warnings;
use dots;
# standard modules
use Carp qw(longmess);
@ -16,7 +17,7 @@ require Exporter; @@ -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 @@ -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 @@ -236,6 +237,9 @@ sub unload_plugin
}
}
sub after {
}
sub plugin_list
{
[keys(%plugins)];

11
lib/Milkbone/Conf.pm

@ -10,22 +10,23 @@ use strict; @@ -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 {
}

50
lib/Milkbone/Util.pm

@ -7,13 +7,14 @@ package Milkbone::Util; @@ -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 { @@ -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,49 +49,44 @@ sub strip_html @@ -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 @@ -102,10 +97,9 @@ sub loaded_files
} grep s/^_<//, keys %main::;
}
sub path
{
confess "Milkbone::path is deprecated";
return @_;
sub path {
confess "Milkbone::path is deprecated";
return @_;
}
1;

15
lib/dots.pm

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

23
milkbone-0.36.ebuild

@ -1,23 +0,0 @@ @@ -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
}

4
milkbone.pl

@ -43,9 +43,7 @@ else { @@ -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.

71
modes/demotk.pl

@ -3,11 +3,15 @@ @@ -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"; @@ -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

21
tk.pl → modes/mosh.pl

@ -1,15 +1,22 @@ @@ -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"; @@ -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;

3
modes/tk.pl

@ -5,12 +5,13 @@ @@ -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";

0
milkbone → nix/milkbone

6
plugins/Log.pl

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
package Log;
use Milkbone;
use Milkbone qw(user_dir);
use File::Path;
use strict;
@ -9,7 +9,7 @@ use warnings; @@ -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 @@ -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");

70
plugins/Unit-Test.pl

@ -0,0 +1,70 @@ @@ -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";

28
sample.conf

@ -1,5 +1,31 @@ @@ -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>

35
tktest.pl

@ -1,35 +0,0 @@ @@ -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;
Loading…
Cancel
Save