1 |
cvsjoko |
1.1 |
package MJAM::Command::Core; |
2 |
|
|
|
3 |
|
|
use strict; |
4 |
|
|
use warnings; |
5 |
|
|
|
6 |
|
|
use Env qw ( HOME ); |
7 |
|
|
use Data::Dumper; |
8 |
|
|
use POE; |
9 |
|
|
use POE::Component::Terminal; |
10 |
|
|
use MJAM::main; |
11 |
|
|
|
12 |
|
|
my $poe_alias; |
13 |
|
|
my $poe_alias_cmdfd = "fcheck"; |
14 |
|
|
|
15 |
|
|
sub docmd { |
16 |
|
|
|
17 |
|
|
# ---------------------------------------------------- |
18 |
|
|
# get poe vars and resolve sender |
19 |
|
|
my ( $kernel, $session, $heap, $sender, $cmd, $target ) = @_[ KERNEL, SESSION, HEAP, SENDER, ARG0, ARG1 ]; |
20 |
|
|
my $recieved = $cmd; |
21 |
|
|
if ($sender == $kernel) { |
22 |
|
|
my $caller = "Kernel" . " (Kernel " . $sender->ID() . ")"; |
23 |
|
|
$recieved .= " (from \"" . $caller . "\")"; |
24 |
|
|
} else { |
25 |
|
|
my $sender_heap = $sender->get_heap(); |
26 |
|
|
my $caller = $sender_heap->{meta}{Caption} . " (Session " . $sender->ID() . ")"; |
27 |
|
|
$recieved .= " (from \"" . $caller . "\")"; |
28 |
|
|
} |
29 |
|
|
if ($target->{ResponseSession} && $target->{ResponseState}) { |
30 |
|
|
$recieved .= ' -> ' . $target->{ResponseSession} . ':' . $target->{ResponseState}; |
31 |
|
|
} |
32 |
|
|
#DEBUG() && print __PACKAGE__, ": #>", $recieved, "\n"; |
33 |
|
|
print __PACKAGE__, ": #>", $recieved, "\n"; |
34 |
|
|
# ---------------------------------------------------- |
35 |
|
|
|
36 |
|
|
my $response = ''; |
37 |
|
|
|
38 |
|
|
|
39 |
|
|
# ============================= |
40 |
|
|
# cmdfd-connector |
41 |
|
|
if ($cmd =~ m/tell cmdfd (.+?)$/) { |
42 |
|
|
my $subcmd = $1; |
43 |
|
|
#print "subcmd: ", $subcmd, "\n"; |
44 |
|
|
if ($subcmd eq 'start') { |
45 |
|
|
$heap->{$poe_alias_cmdfd} = MJAM::Connector::LocalFile::start( { |
46 |
|
|
'Alias' => $poe_alias_cmdfd, |
47 |
|
|
'File' => $HOME . '/.mjamcmd', |
48 |
|
|
'ResponseSession' => $poe_alias, |
49 |
|
|
'ResponseStateInput' => 'got_cmd_from_cmdfd', |
50 |
|
|
'ResponseStateError' => 'got_error_from_cmdfd', |
51 |
|
|
} ); |
52 |
|
|
|
53 |
|
|
} |
54 |
|
|
if ($subcmd eq 'stop') { |
55 |
|
|
MJAM::Connector::LocalFile::stop($poe_alias_cmdfd); |
56 |
|
|
delete $heap->{$poe_alias_cmdfd}; |
57 |
|
|
} |
58 |
|
|
} |
59 |
|
|
|
60 |
|
|
# ============================= |
61 |
|
|
# http-connector |
62 |
|
|
if ($cmd =~ m/tell httpd (.+?)$/) { |
63 |
|
|
my $subcmd = $1; |
64 |
|
|
#print "subcmd: ", $subcmd, "\n"; |
65 |
|
|
if ($subcmd eq 'start') { |
66 |
|
|
MJAM::Connector::TcpHttp::server_start('httpd'); |
67 |
|
|
} |
68 |
|
|
if ($subcmd eq 'stop') { |
69 |
|
|
MJAM::Connector::TcpHttp::server_stop('httpd'); |
70 |
|
|
} |
71 |
|
|
} |
72 |
|
|
|
73 |
|
|
# ============================= |
74 |
|
|
# rpcxml-connector |
75 |
|
|
if ($cmd =~ m/tell rpcxmld (.+?)$/) { |
76 |
|
|
my $subcmd = $1; |
77 |
|
|
#print "subcmd: ", $subcmd, "\n"; |
78 |
|
|
if ($subcmd eq 'start') { |
79 |
|
|
MJAM::Connector::TcpRpcXml::server_start('rpcxmld'); |
80 |
|
|
} |
81 |
|
|
if ($subcmd eq 'stop') { |
82 |
|
|
MJAM::Connector::TcpRpcXml::server_stop('rpcxmld'); |
83 |
|
|
} |
84 |
|
|
} |
85 |
|
|
|
86 |
|
|
# ============================= |
87 |
|
|
# dbi-connector |
88 |
|
|
if ($cmd =~ m/tell dbagent (.+?)$/) { |
89 |
|
|
my $subcmd = $1; |
90 |
|
|
#print "subcmd: ", $subcmd, "\n"; |
91 |
|
|
if ($subcmd eq 'start') { |
92 |
|
|
MJAM::Connector::Dbi::start('dbagent'); |
93 |
|
|
} |
94 |
|
|
if ($subcmd eq 'stop') { |
95 |
|
|
MJAM::Connector::Dbi::stop(); |
96 |
|
|
} |
97 |
|
|
} |
98 |
|
|
|
99 |
|
|
# ============================= |
100 |
|
|
# console |
101 |
|
|
if ($cmd =~ m/tell console (.+?)$/) { |
102 |
|
|
my $subcmd = $1; |
103 |
|
|
#print "subcmd: ", $subcmd, "\n"; |
104 |
|
|
if ($subcmd eq 'start core-shell') { |
105 |
|
|
POE::Component::Terminal->new( { |
106 |
|
|
Alias => 'console', |
107 |
|
|
Caption => 'core-shell', |
108 |
|
|
PromptPrefix => 'core', |
109 |
|
|
PromptPostfix => '#> ', |
110 |
|
|
RequestSession => $session, |
111 |
|
|
RequestState => 'docmd', |
112 |
|
|
ResponseSession => 'console', |
113 |
|
|
ResponseState => 'recieveResponse', |
114 |
|
|
PromptChangeState => 'recievePrompt', |
115 |
|
|
} ); |
116 |
|
|
} |
117 |
|
|
if ($subcmd eq 'start login-shell') { |
118 |
|
|
MJAM::Command::Shell::start('shell'); |
119 |
|
|
POE::Component::Terminal->new( { |
120 |
|
|
Alias => 'console', |
121 |
|
|
Caption => 'login-shell', |
122 |
|
|
PromptPrefix => 'jash', |
123 |
|
|
PromptPostfix => '#> ', |
124 |
|
|
RequestSession => 'shell', |
125 |
|
|
RequestState => 'issueCmd', |
126 |
|
|
ResponseSession => 'console', |
127 |
|
|
ResponseState => 'recieveResponse', |
128 |
|
|
PromptChangeState => 'recievePrompt', |
129 |
|
|
} ); |
130 |
|
|
} |
131 |
|
|
if ($subcmd eq 'stop') { |
132 |
|
|
MJAM::Command::Shell::stop('shell'); |
133 |
|
|
MJAM::Connector::Console::stop('console'); |
134 |
|
|
} |
135 |
|
|
} |
136 |
|
|
|
137 |
|
|
# ============================= |
138 |
|
|
# rpcxml-agent |
139 |
|
|
if ($cmd =~ m/tell rpcxmla (.+?)$/) { |
140 |
|
|
my $subcmd = $1; |
141 |
|
|
if ($subcmd eq 'start') { |
142 |
|
|
MJAM::Connector::TcpRpcXml::agent_start("rpcxmla"); |
143 |
|
|
} |
144 |
|
|
if ($subcmd eq 'stop') { |
145 |
|
|
MJAM::Connector::TcpRpcXml::agent_stop("rpcxmla"); |
146 |
|
|
} |
147 |
|
|
} |
148 |
|
|
|
149 |
|
|
|
150 |
|
|
# ============================= |
151 |
|
|
# dbagent |
152 |
|
|
if ($cmd =~ m/query/) { |
153 |
|
|
$kernel->post('dbagent', 'doQuery'); |
154 |
|
|
} |
155 |
|
|
|
156 |
|
|
|
157 |
|
|
# my $response_target = { |
158 |
|
|
# ResponseSession => $self->{ResponseSession}, |
159 |
|
|
# ResponseState => $self->{ResponseState}, |
160 |
|
|
# }; |
161 |
|
|
# $kernel->post( $self->{RequestSession} => $self->{RequestState} => $buf, $response_target); |
162 |
|
|
|
163 |
|
|
if ($sender != $kernel) { |
164 |
|
|
$response = __PACKAGE__ . ': executed "' . $cmd . '"'; |
165 |
|
|
$kernel->post( $target->{ResponseSession} => $target->{ResponseState} => $response); |
166 |
|
|
} |
167 |
|
|
|
168 |
|
|
} |
169 |
|
|
|
170 |
|
|
|
171 |
|
|
|
172 |
|
|
sub got_cmd_from_cmdfd { |
173 |
|
|
my ( $kernel, $session, $heap, $cmd ) = @_[ KERNEL, SESSION, HEAP, ARG0 ]; |
174 |
|
|
my $target = { |
175 |
|
|
ResponseSession => 'cmdfd', |
176 |
|
|
ResponseState => 'response', |
177 |
|
|
}; |
178 |
|
|
$kernel->post($session, 'docmd', $cmd, $target); |
179 |
|
|
} |
180 |
|
|
sub got_error_from_cmdfd { |
181 |
|
|
my ( $kernel, $session, $heap, $errmsg ) = @_[ KERNEL, SESSION, HEAP, ARG0 ]; |
182 |
|
|
DEBUG() && print __PACKAGE__, "-Error: ", $errmsg, "\n"; |
183 |
|
|
} |
184 |
|
|
|
185 |
|
|
|
186 |
|
|
sub _start { |
187 |
|
|
my ( $kernel, $session, $heap, $cmd ) = @_[ KERNEL, SESSION, HEAP ]; |
188 |
|
|
$kernel->alias_set($poe_alias); |
189 |
|
|
DEBUG() && print __PACKAGE__, " started", "\n"; |
190 |
|
|
} |
191 |
|
|
sub _stop { |
192 |
|
|
DEBUG() && print __PACKAGE__, " stopped", "\n"; |
193 |
|
|
} |
194 |
|
|
|
195 |
|
|
|
196 |
|
|
sub start { |
197 |
|
|
|
198 |
|
|
$poe_alias = shift; |
199 |
|
|
|
200 |
|
|
my @handlers = qw( |
201 |
|
|
_start |
202 |
|
|
_stop |
203 |
|
|
docmd |
204 |
|
|
got_cmd_from_cmdfd |
205 |
|
|
got_error_from_cmdfd |
206 |
|
|
); |
207 |
|
|
|
208 |
|
|
my $pkg = __PACKAGE__; |
209 |
|
|
|
210 |
|
|
# the main session for the command-engine |
211 |
|
|
POE::Session->create( |
212 |
|
|
package_states => [ $pkg => \@handlers ], |
213 |
|
|
); |
214 |
|
|
|
215 |
|
|
} |
216 |
|
|
|
217 |
|
|
1; |