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