1 |
#!/opt/bin/perl |
2 |
|
3 |
use AnyEvent; |
4 |
use Storable; |
5 |
use YAML; |
6 |
|
7 |
@ARGV == 5 or die "Usage: $0 host port login password dm-pass\n"; |
8 |
|
9 |
use base Crossfire::Protocol::Base; |
10 |
|
11 |
my $login = AnyEvent->condvar; |
12 |
|
13 |
sub refresh; |
14 |
|
15 |
sub logged_in { |
16 |
my ($self) = @_; |
17 |
|
18 |
$login->broadcast; |
19 |
|
20 |
$self->send_command ("dmhide $ARGV[4]"); |
21 |
print "\nlogged in.\n"; |
22 |
refresh; |
23 |
} |
24 |
|
25 |
sub fatal { |
26 |
print "\n$_[0]\n"; |
27 |
readline::ResetTTY (); |
28 |
exit 1; |
29 |
} |
30 |
|
31 |
sub eof { |
32 |
my ($self) = @_; |
33 |
|
34 |
fatal "server closed connection."; |
35 |
} |
36 |
|
37 |
sub query { |
38 |
my ($self, $flags, $prompt) = @_; |
39 |
fatal "unexpected prompt: $prompt"; |
40 |
} |
41 |
|
42 |
sub drawinfo { |
43 |
my ($self, $flags, $text) = @_; |
44 |
|
45 |
print "\n$text\n"; |
46 |
refresh; |
47 |
} |
48 |
|
49 |
my $cf = new main |
50 |
host => $ARGV[0], |
51 |
port => $ARGV[1] || 13327, |
52 |
user => $ARGV[2], |
53 |
pass => $ARGV[3], |
54 |
mapw => 1, |
55 |
maph => 1; |
56 |
|
57 |
#===========================================================================# |
58 |
# very hackish non-blocking readline. |
59 |
|
60 |
BEGIN { $ENV{PERL_RL} = "Perl o=0" } |
61 |
use Term::ReadLine; |
62 |
|
63 |
sub refresh { |
64 |
$readline::force_redraw = 1; |
65 |
readline::redisplay (); |
66 |
} |
67 |
|
68 |
my $stdin = AnyEvent->condvar; |
69 |
|
70 |
my $w = AnyEvent->io (fh => \*STDIN, poll => 'r', cb => sub { $stdin->broadcast }); |
71 |
|
72 |
sub Term::ReadLine::Tk::Tk_loop { |
73 |
$stdin->wait; |
74 |
$stdin = AnyEvent->condvar; |
75 |
} |
76 |
|
77 |
sub Tk::DoOneEvent { } |
78 |
sub Term::ReadLine::Tk::register_Tk { } |
79 |
|
80 |
$rl = new Term::ReadLine "mpg123sh"; |
81 |
$rl->tkRunning(1); |
82 |
|
83 |
#===========================================================================# |
84 |
|
85 |
$login->wait; |
86 |
|
87 |
while (defined (my $cmd = $rl->readline ("$ARGV[0]> "))) { |
88 |
$cf->send_ext_req (perl_eval => $cmd, sub { |
89 |
my ($data) = @_; |
90 |
|
91 |
print "\n"; |
92 |
|
93 |
my ($status, $result) = split / /, $data, 2; |
94 |
print "status: $status\n"; |
95 |
if ($status eq "ok") { |
96 |
print Dump Storable::thaw $result; |
97 |
} else { |
98 |
$result =~ s/\n$//; |
99 |
print "$result\n"; |
100 |
} |
101 |
refresh; |
102 |
}); |
103 |
} |
104 |
|