1 |
root |
1.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 |
root |
1.2 |
my $login = AnyEvent->condvar; |
12 |
|
|
|
13 |
root |
1.1 |
sub refresh; |
14 |
|
|
|
15 |
|
|
sub logged_in { |
16 |
|
|
my ($self) = @_; |
17 |
|
|
|
18 |
root |
1.2 |
$login->broadcast; |
19 |
|
|
|
20 |
root |
1.1 |
$self->send_command ("dmhide $ARGV[4]"); |
21 |
|
|
print "\nlogged in.\n"; |
22 |
|
|
refresh; |
23 |
|
|
} |
24 |
|
|
|
25 |
root |
1.2 |
sub fatal { |
26 |
|
|
print "\n$_[0]\n"; |
27 |
|
|
readline::ResetTTY (); |
28 |
|
|
exit 1; |
29 |
|
|
} |
30 |
|
|
|
31 |
root |
1.1 |
sub eof { |
32 |
|
|
my ($self) = @_; |
33 |
|
|
|
34 |
root |
1.2 |
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 |
root |
1.1 |
} |
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 |
root |
1.2 |
#===========================================================================# |
84 |
|
|
|
85 |
|
|
$login->wait; |
86 |
|
|
|
87 |
root |
1.1 |
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 |
|
|
|