ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra/bin/cfshell
Revision: 1.3
Committed: Fri Jul 21 13:32:03 2006 UTC (17 years, 10 months ago) by root
Branch: MAIN
Changes since 1.2: +21 -40 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3 root 1.3 BEGIN { $ENV{PERL_RL} = "gnu" } use Term::ReadLine; # this suxx
4 root 1.1 use AnyEvent;
5     use Storable;
6     use YAML;
7    
8     @ARGV == 5 or die "Usage: $0 host port login password dm-pass\n";
9    
10     use base Crossfire::Protocol::Base;
11    
12 root 1.2 my $login = AnyEvent->condvar;
13 root 1.3 my $quit = AnyEvent->condvar;
14     my $rl = new Term::ReadLine "cfshell";
15 root 1.1
16     sub logged_in {
17     my ($self) = @_;
18    
19 root 1.2 $login->broadcast;
20    
21 root 1.1 $self->send_command ("dmhide $ARGV[4]");
22     print "\nlogged in.\n";
23     }
24    
25 root 1.2 sub fatal {
26 root 1.3 $rl->crlf;
27     $rl->deprep_terminal;
28     print "$_[0]\n";
29 root 1.2 exit 1;
30     }
31    
32 root 1.1 sub eof {
33     my ($self) = @_;
34    
35 root 1.2 fatal "server closed connection.";
36     }
37    
38     sub query {
39     my ($self, $flags, $prompt) = @_;
40     fatal "unexpected prompt: $prompt";
41     }
42    
43     sub drawinfo {
44     my ($self, $flags, $text) = @_;
45    
46 root 1.3 $rl->crlf;
47     print "$text\n";
48     $rl->forced_update_display;
49 root 1.1 }
50    
51     my $cf = new main
52     host => $ARGV[0],
53     port => $ARGV[1] || 13327,
54     user => $ARGV[2],
55     pass => $ARGV[3],
56     mapw => 1,
57     maph => 1;
58    
59 root 1.3 $login->wait;
60 root 1.2
61 root 1.3 my $w = AnyEvent->io (fh => $rl->IN, poll => 'r', cb => sub { $rl->callback_read_char });
62 root 1.2
63 root 1.3 $rl->callback_handler_install ("$ARGV[0]> ", sub {
64     $rl->add_history ($_[0]);
65     $cf->send_ext_req (perl_eval => $_[0], sub {
66 root 1.1 my ($data) = @_;
67    
68 root 1.3 $rl->crlf;
69 root 1.1
70     my ($status, $result) = split / /, $data, 2;
71     print "status: $status\n";
72     if ($status eq "ok") {
73     print Dump Storable::thaw $result;
74     } else {
75     $result =~ s/\n$//;
76     print "$result\n";
77     }
78 root 1.3
79     $rl->forced_update_display;
80 root 1.1 });
81 root 1.3 });
82    
83     $quit->wait;
84     $rl->callback_handler_remove;
85 root 1.1