#!/usr/bin/perl
use
5.012004;
our
$VERSION
=
'0.001'
;
has
'id'
=> (
is
=>
'ro'
,
isa
=>
'String'
);
has
'parent'
=> (
is
=>
'ro'
,
isa
=>
'Ref'
);
has
'client'
=> (
is
=>
'rw'
,
isa
=>
'Ref'
);
sub
new {
my
$class
=
shift
;
my
(
%params
) =
@_
;
my
$g
= Data::GUID->new;
my
$self
= {
'version'
=>
$VERSION
,
'id'
=>
$g
->as_string,
};
bless
$self
,
$class
;
if
(!
defined
(
$params
{
'Parent'
})) {
$self
->error(
"Parent is undefined. Ham::Fldigi::Shell should only be called with Ham::Fldigi->shell()!"
);
return
undef
;
}
else
{
$self
->{parent} =
$params
{
'Parent'
};
}
$self
->debug(
"Constructor called. Version "
.
$VERSION
.
", with ID "
.
$self
->id.
"."
);
if
(!
defined
(
$params
{
'Client'
})) {
$self
->debug(
"No client passed."
);
}
else
{
$self
->client(
$params
{
'Client'
});
$self
->debug(
"Passed client ref is for client named "
.
$self
->client->name.
", with an XML-RPC URL of "
.
$self
->client->url.
"."
);
}
$self
->debug(
"Returning..."
);
return
$self
;
}
sub
start {
my
(
$self
) =
@_
;
$self
->debug(
"Starting shell..."
);
my
$term
= Term::ReadLine->new(
'Ham::Fldigi shell'
);
print
"Ham::Fldigi::Shell v"
.
$VERSION
.
"\n"
;
print
"(c) 2012 Andy Smith M0VKG\n"
;
my
$prompt
;
if
(
defined
(
$self
->client)) {
$prompt
=
"fldigi("
.
$self
->client->name.
")> "
;
}
else
{
$prompt
=
"fldigi> "
;
}
my
$OUT
=
$term
->OUT || \
*STDOUT
;
my
$running
= 1;
while
(
$running
== 1) {
my
$c
=
$term
->
readline
(
$prompt
);
if
((
defined
(
$c
)) && (
$c
=~ /\S/)) {
my
(
$cmd
,
@args
) =
split
(
" "
,
$c
);
$term
->addhistory(
$_
);
switch (
$cmd
) {
case /^
connect
$|^c$/ {
if
(
defined
(
$self
->parent->clients))
{
if
(
@args
) {
if
(!
defined
(
$self
->parent->clients->{
$args
[0]})) {
print
$OUT
"No client with name '"
.
$args
[0].
"'.\n"
;
}
else
{
$self
->client(
$self
->parent->clients->{
$args
[0]});
print
$OUT
"Switched to client '"
.
$args
[0].
"'.\n"
;
$prompt
=
"fldigi("
.
$self
->client->name.
")> "
;
}
}
}
}
case /^disconnect$|^d$/ {
if
(
defined
(
$self
->client)) {
print
$OUT
"Disconnected from client '"
.
$self
->client->name.
".\n"
;
$self
->{client} =
undef
;
$prompt
=
"fldigi> "
;
}
else
{
print
$OUT
"Not connected to a client.\n"
;
}
}
case /^list$|^l$/ {
if
(
defined
(
$self
->parent->clients))
{
foreach
my
$client
(
keys
%{
$self
->parent->clients}) {
print
$OUT
"\t"
.
$client
.
"\t\t("
.
$self
->parent->clients->{
$client
}->url.
")\n"
;
}
}
else
{
print
$OUT
"No clients found!"
;
}
}
case
qr/^set|^s$/
{
if
(
defined
(
$args
[0])) {
switch (
$args
[0]) {
case
"debug_level"
{
if
(
defined
(
$args
[1])) {
$Ham::Fldigi::Debug::debug_level
=
$args
[1];
}
print
$OUT
"debug_level is "
.
$Ham::Fldigi::Debug::debug_level
;
}
case
"debug_file"
{
if
(
defined
(
$args
[1])) {
$Ham::Fldigi::Debug::debug_file
=
$args
[1];
}
print
$OUT
"debug_file is "
.
$Ham::Fldigi::Debug::debug_file
;
}
case
"debug_print"
{
if
(
defined
(
$args
[1])) {
$Ham::Fldigi::Debug::debug_print
=
$args
[1];
}
print
$OUT
"debug_print is "
.
$Ham::Fldigi::Debug::debug_print
;
}
case
"debug_write"
{
if
(
defined
(
$args
[1])) {
$Ham::Fldigi::Debug::debug_write
=
$args
[1];
}
print
$OUT
"debug_write is "
.
$Ham::Fldigi::Debug::debug_write
;
}
}
}
else
{
print
$OUT
"\tdebug_level\t\t"
.
$Ham::Fldigi::Debug::debug_write
.
"\tDebug level (0-4)\n"
;
print
$OUT
"\tdebug_file\t\t"
.
$Ham::Fldigi::Debug::debug_write
.
"\tFile to log to (path)\n"
;
print
$OUT
"\tdebug_print\t\t"
.
$Ham::Fldigi::Debug::debug_write
.
"\tLog to screen (1) or not (0)\n"
;
print
$OUT
"\tdebug_write\t\t"
.
$Ham::Fldigi::Debug::debug_write
.
"\tLog to file (1) or not (0)\n"
;
}
}
case
qr/^quit|^q$/
{
print
$OUT
"Exiting shell..."
;
$running
= 0;
}
case
qr/\w+/
{
if
(
defined
(
$self
->client)) {
my
$arg
=
join
(
" "
,
@args
);
chomp
(
$arg
);
my
$r
=
$self
->client->command(
$cmd
,
$arg
);
print
$OUT
$r
.
"\n"
;
}
else
{
print
$OUT
"Not connected to a client.\n"
;
}
}
}
}
}
$self
->debug(
"Shell stopped."
);
return
1;
}
1;