use
5.006;
BEGIN {
use
vars
qw( $VERSION @ISA )
;
@ISA
=
qw( UI::Dialog::Backend )
;
$VERSION
=
'1.08'
;
}
sub
new {
my
$proto
=
shift
();
my
$class
=
ref
(
$proto
) ||
$proto
;
my
$cfg
= ((
ref
(
$_
[0]) eq
"HASH"
) ?
$_
[0] : (
@_
) ? {
@_
} : {});
my
$self
= {};
bless
(
$self
,
$class
);
$self
->{
'_state'
} = {};
$self
->{
'_opts'
} = {};
my
$CFG_PATH
=
$cfg
->{
'PATH'
};
if
(
$CFG_PATH
) {
if
(
ref
(
$CFG_PATH
) eq
"ARRAY"
) {
$self
->{
'PATHS'
} =
$CFG_PATH
; }
elsif
(
$CFG_PATH
=~ m!:!) {
$self
->{
'PATHS'
} = [
split
(/:/,
$CFG_PATH
) ]; }
elsif
(-d
$CFG_PATH
) {
$self
->{
'PATHS'
} = [
$CFG_PATH
]; }
}
elsif
(
$ENV
{
'PATH'
}) {
$self
->{
'PATHS'
} = [
split
(/:/,
$ENV
{
'PATH'
}) ]; }
else
{
$self
->{
'PATHS'
} =
''
; }
$self
->{
'_opts'
}->{
'literal'
} =
$cfg
->{
'literal'
} || 0;
$self
->{
'_opts'
}->{
'callbacks'
} =
$cfg
->{
'callbacks'
} ||
undef
();
$self
->{
'_opts'
}->{
'debug'
} =
$cfg
->{
'debug'
} ||
undef
();
$self
->{
'_opts'
}->{
'title'
} =
$cfg
->{
'title'
} ||
undef
();
$self
->{
'_opts'
}->{
'backtitle'
} =
$cfg
->{
'backtitle'
} ||
undef
();
$self
->{
'_opts'
}->{
'width'
} =
$cfg
->{
'width'
} || 65;
$self
->{
'_opts'
}->{
'height'
} =
$cfg
->{
'height'
} || 10;
$self
->{
'_opts'
}->{
'percentage'
} =
$cfg
->{
'percentage'
} || 1;
$self
->{
'_opts'
}->{
'bin'
} ||=
$self
->_find_bin(
'gdialog.real'
) ||
$self
->_find_bin(
'gdialog'
) ||
'/usr/bin/gdialog'
;
$self
->{
'_opts'
}->{
'autoclear'
} =
$cfg
->{
'autoclear'
} || 0;
$self
->{
'_opts'
}->{
'clearbefore'
} =
$cfg
->{
'clearbefore'
} || 0;
$self
->{
'_opts'
}->{
'clearafter'
} =
$cfg
->{
'clearafter'
} || 0;
$self
->{
'_opts'
}->{
'beepbin'
} =
$cfg
->{
'beepbin'
} ||
$self
->_find_bin(
'beep'
) ||
'/usr/bin/beep'
;
$self
->{
'_opts'
}->{
'beepbefore'
} =
$cfg
->{
'beepbefore'
} || 0;
$self
->{
'_opts'
}->{
'beepafter'
} =
$cfg
->{
'beepafter'
} || 0;
$self
->{
'_opts'
}->{
'timeout'
} =
$cfg
->{
'timeout'
} || 0;
$self
->{
'_opts'
}->{
'wait'
} =
$cfg
->{
'wait'
} || 0;
unless
(-x
$self
->{
'_opts'
}->{
'bin'
}) {
croak(
"the gdialog binary could not be found at: "
.
$self
->{
'_opts'
}->{
'bin'
});
}
return
(
$self
);
}
my
$SIG_CODE
= {};
sub
_del_gauge {
my
$CODE
=
$SIG_CODE
->{$$};
unless
(not
ref
(
$CODE
)) {
delete
(
$CODE
->{
'_GAUGE'
});
$CODE
->rv(
'1'
);
$CODE
->rs(
'null'
);
$CODE
->ra(
'null'
);
$SIG_CODE
->{$$} =
""
;
}
}
sub
_mk_cmnd {
my
$self
=
shift
();
my
$final
=
shift
();
my
$cmnd
;
my
$args
=
$self
->_merge_attrs(
@_
);
$cmnd
=
$args
->{
'bin'
};
$cmnd
.=
' --title "'
. (
$args
->{
'title'
} ||
$args
->{
'title'
}) .
'"'
unless
not
$args
->{
'title'
} and not
$args
->{
'title'
};
$cmnd
.=
' --backtitle "'
. (
$args
->{
'backtitle'
} ||
$args
->{
'backtitle'
}) .
'"'
unless
not
$args
->{
'backtitle'
} and not
$args
->{
'backtitle'
};
$cmnd
.=
' --separate-output'
unless
not
$args
->{
'separate-output'
} and not
$args
->{
'separate-output'
};
$cmnd
.=
" "
.
$final
;
return
(
$cmnd
);
}
sub
yesno {
my
$self
=
shift
();
my
$caller
= (
caller
(1))[3] ||
'main'
;
$caller
= (
$caller
=~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((
caller
(2))[3]||
'main'
) :
$caller
;
if
(
$_
[0] &&
$_
[0] eq
'caller'
) {
shift
();
$caller
=
shift
(); }
my
$args
=
$self
->_pre(
$caller
,
@_
);
my
$command
=
$self
->_mk_cmnd(
' --yesno'
,
@_
);
$command
.=
' "'
. ((
$args
->{
'literal'
} ?
$args
->{
'text'
} :
$self
->_organize_text(
$args
->{
'text'
}))||
' '
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'height'
}||
'20'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'width'
}||
'65'
) .
'"'
;
my
$rv
=
$self
->command_state(
$command
);
$self
->rv(
$rv
||
'null'
);
$self
->ra(
'null'
);
my
$this_rv
;
if
(
$rv
&&
$rv
>= 1) {
$self
->ra(
"NO"
);
$self
->rs(
"NO"
);
$this_rv
= 0;
}
else
{
$self
->ra(
"YES"
);
$self
->rs(
"YES"
);
$this_rv
= 1;
}
$self
->_post(
$args
);
return
(
$this_rv
);
}
sub
inputbox {
my
$self
=
shift
();
my
$caller
= (
caller
(1))[3] ||
'main'
;
$caller
= (
$caller
=~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((
caller
(2))[3]||
'main'
) :
$caller
;
if
(
$_
[0] &&
$_
[0] eq
'caller'
) {
shift
();
$caller
=
shift
(); }
my
$args
=
$self
->_pre(
$caller
,
@_
);
my
$command
=
$self
->_mk_cmnd(
' --inputbox'
,
@_
);
$command
.=
' "'
. ((
$args
->{
'literal'
} ?
$args
->{
'text'
} :
$self
->_organize_text(
$args
->{
'text'
}))||
' '
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'height'
}||
'20'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'width'
}||
'65'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'init'
}||
''
) .
'"'
unless
not
$args
->{
'init'
} and not
$args
->{
'entry'
};
my
(
$rv
,
$text
) =
$self
->command_string(
$command
);
$self
->rv(
$rv
||
'null'
);
$self
->ra(
'null'
);
my
$this_rv
;
if
(
$rv
&&
$rv
>= 1) {
$self
->rs(
'null'
);
$this_rv
= 0;
}
else
{
$self
->ra(
$text
);
$self
->rs(
$text
);
$this_rv
=
$text
;
}
$self
->_post(
$args
);
return
(
$this_rv
);
}
sub
password {
my
$self
=
shift
();
$self
->msgbox(
text
=>
'GDialog does not support passwords at all, '
.
'you will see the text as you type in the next dialog.'
);
return
(
$self
->inputbox(
'caller'
,((
caller
(1))[3]||
'main'
),
@_
));
}
sub
msgbox {
my
$self
=
shift
();
my
$caller
= (
caller
(1))[3] ||
'main'
;
$caller
= (
$caller
=~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((
caller
(2))[3]||
'main'
) :
$caller
;
if
(
$_
[0] &&
$_
[0] eq
'caller'
) {
shift
();
$caller
=
shift
(); }
my
$args
=
$self
->_pre(
$caller
,
@_
);
$args
->{
'msgbox'
} ||=
'msgbox'
;
my
$command
=
$self
->_mk_cmnd(
' --'
.
$args
->{
'msgbox'
},
@_
);
$command
.=
' "'
. ((
$args
->{
'literal'
} ?
$args
->{
'text'
} :
$self
->_organize_text(
$args
->{
'text'
}))||
' '
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'height'
}||
'20'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'width'
}||
'65'
) .
'"'
;
my
$rv
=
$self
->command_state(
$command
);
$self
->rv(
$rv
||
'null'
);
$self
->ra(
'null'
);
$self
->rs(
'null'
);
my
$this_rv
;
if
(
$rv
&&
$rv
>= 1) {
$this_rv
= 0;
}
else
{
$this_rv
= 1;
}
$self
->_post(
$args
);
return
(
$this_rv
);
}
sub
infobox {
my
$self
=
shift
();
return
(
$self
->msgbox(
'caller'
,((
caller
(1))[3]||
'main'
),
@_
,
'msgbox'
,
'infobox'
));
}
sub
textbox {
my
$self
=
shift
();
my
$caller
= (
caller
(1))[3] ||
'main'
;
$caller
= (
$caller
=~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((
caller
(2))[3]||
'main'
) :
$caller
;
if
(
$_
[0] &&
$_
[0] eq
'caller'
) {
shift
();
$caller
=
shift
(); }
my
$args
=
$self
->_pre(
$caller
,
@_
);
my
$command
=
$self
->_mk_cmnd(
" --textbox"
,
@_
);
$command
.=
' "'
. (
$args
->{
'path'
}||
'.'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'height'
}||
'20'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'width'
}||
'65'
) .
'"'
;
my
(
$rv
,
$text
) =
$self
->command_string(
$command
);
$self
->rv(
$rv
||
'null'
);
$self
->ra(
'null'
);
my
$this_rv
;
if
(
$rv
&&
$rv
>= 1) {
$self
->rs(
'null'
);
$this_rv
= 0;
}
else
{
$self
->ra(
$text
);
$self
->rs(
$text
);
$this_rv
=
$text
;
}
$self
->_post(
$args
);
return
(
$this_rv
);
}
sub
menu {
my
$self
=
shift
();
my
$caller
= (
caller
(1))[3] ||
'main'
;
$caller
= (
$caller
=~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((
caller
(2))[3]||
'main'
) :
$caller
;
if
(
$_
[0] &&
$_
[0] eq
'caller'
) {
shift
();
$caller
=
shift
(); }
my
$args
=
$self
->_pre(
$caller
,
@_
);
my
$command
=
$self
->_mk_cmnd(
" --menu"
,
@_
);
$command
.=
' "'
. ((
$args
->{
'literal'
} ?
$args
->{
'text'
} :
$self
->_organize_text(
$args
->{
'text'
}))||
' '
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'height'
}||
'20'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'width'
}||
'65'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'menuheight'
}||
$args
->{
'listheight'
}||
'5'
) .
'"'
;
if
(
$args
->{
'list'
}) {
$args
->{
'list'
} = [
' '
,
' '
]
unless
ref
(
$args
->{
'list'
}) eq
"ARRAY"
;
foreach
my
$item
(@{
$args
->{
'list'
}}) {
$command
.=
' "'
.
$item
.
'"'
;
}
}
else
{
$args
->{
'items'
} = [
' '
,
' '
]
unless
ref
(
$args
->{
'items'
}) eq
"ARRAY"
;
foreach
my
$item
(@{
$args
->{
'items'
}}) {
$command
.=
' "'
.
$item
.
'"'
;
}
}
my
(
$rv
,
$selected
) =
$self
->command_string(
$command
);
$self
->rv(
$rv
||
'null'
);
$self
->ra(
'null'
);
my
$this_rv
;
if
(
$rv
&&
$rv
>= 1) {
$self
->rs(
'null'
);
$this_rv
= 0;
}
else
{
$self
->ra(
$selected
);
$self
->rs(
$selected
);
$this_rv
=
$selected
;
}
$self
->_post(
$args
);
return
(
$this_rv
);
}
sub
checklist {
my
$self
=
shift
();
my
$caller
= (
caller
(1))[3] ||
'main'
;
$caller
= (
$caller
=~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((
caller
(2))[3]||
'main'
) :
$caller
;
if
(
$_
[0] &&
$_
[0] eq
'caller'
) {
shift
();
$caller
=
shift
(); }
my
$args
=
$self
->_pre(
$caller
,
@_
);
$self
->{
'checklist'
} ||=
'checklist'
;
my
$command
=
$self
->_mk_cmnd(
" --"
.
$self
->{
'checklist'
},
@_
,
'separate-output'
,1);
$command
.=
' "'
. ((
$args
->{
'literal'
} ?
$args
->{
'text'
} :
$self
->_organize_text(
$args
->{
'text'
}))||
' '
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'height'
}||
'20'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'width'
}||
'65'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'menuheight'
}||
$args
->{
'listheight'
}||
'5'
) .
'"'
;
if
(
$args
->{
'list'
}) {
$args
->{
'list'
} = [
' '
, [
' '
, 0] ]
unless
ref
(
$args
->{
'list'
}) eq
"ARRAY"
;
my
(
$item
,
$info
);
while
(@{
$args
->{
'list'
}}) {
$item
=
shift
(@{
$args
->{
'list'
}});
$info
=
shift
(@{
$args
->{
'list'
}});
$command
.=
' "'
.
$item
.
'" "'
.
$info
->[0].
'" "'
.((
$info
->[1]) ?
'on'
:
'off'
).
'"'
;
}
}
else
{
$args
->{
'items'
} = [
' '
,
' '
,
'off'
]
unless
ref
(
$args
->{
'items'
}) eq
"ARRAY"
;
foreach
my
$item
(@{
$args
->{
'items'
}}) {
$command
.=
' "'
.
$item
.
'"'
;
}
}
my
(
$rv
,
$selected
) =
$self
->command_array(
$command
);
$self
->rv(
$rv
||
'null'
);
$self
->rs(
'null'
);
my
$this_rv
;
if
(
$rv
&&
$rv
>= 1) {
$self
->ra(
'null'
);
$this_rv
= 0;
}
else
{
$self
->rs(
join
(
"\n"
,
@$selected
));
$self
->ra(
@$selected
);
$this_rv
=
$selected
;
}
$self
->_post(
$args
);
return
(
$this_rv
)
unless
ref
(
$this_rv
) eq
"ARRAY"
;
return
(@{
$this_rv
});
}
sub
radiolist {
my
$self
=
shift
();
my
$caller
= (
caller
(1))[3] ||
'main'
;
$caller
= (
$caller
=~ /^UI\:\:Dialog\:\:Backend\:\:/) ? ((
caller
(2))[3]||
'main'
) :
$caller
;
if
(
$_
[0] &&
$_
[0] eq
'caller'
) {
shift
();
$caller
=
shift
(); }
my
$args
=
$self
->_pre(
$caller
,
@_
);
$self
->{
'radiolist'
} ||=
'radiolist'
;
my
$command
=
$self
->_mk_cmnd(
" --"
.
$self
->{
'radiolist'
},
@_
);
$command
.=
' "'
. ((
$args
->{
'literal'
} ?
$args
->{
'text'
} :
$self
->_organize_text(
$args
->{
'text'
}))||
' '
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'height'
}||
'20'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'width'
}||
'65'
) .
'"'
;
$command
.=
' "'
. (
$args
->{
'menuheight'
}||
$args
->{
'listheight'
}||
'5'
) .
'"'
;
if
(
$args
->{
'list'
}) {
$args
->{
'list'
} = [
' '
, [
' '
, 0] ]
unless
ref
(
$args
->{
'list'
}) eq
"ARRAY"
;
my
(
$item
,
$info
);
while
(@{
$args
->{
'list'
}}) {
$item
=
shift
(@{
$args
->{
'list'
}});
$info
=
shift
(@{
$args
->{
'list'
}});
$command
.=
' "'
.
$item
.
'" "'
.
$info
->[0].
'" "'
.((
$info
->[1]) ?
'on'
:
'off'
).
'"'
;
}
}
else
{
$args
->{
'items'
} = [
' '
,
' '
,
'off'
]
unless
ref
(
$args
->{
'items'
}) eq
"ARRAY"
;
foreach
my
$item
(@{
$args
->{
'items'
}}) {
$command
.=
' "'
.
$item
.
'"'
;
}
}
my
(
$rv
,
$selected
) =
$self
->command_string(
$command
);
$self
->rv(
$rv
||
'null'
);
$self
->ra(
'null'
);
my
$this_rv
;
if
(
$rv
&&
$rv
>= 1) {
$self
->rs(
'null'
);
$this_rv
= 0;
}
else
{
$self
->ra(
$selected
);
$self
->rs(
$selected
);
$this_rv
=
$selected
;
}
$self
->_post(
$args
);
return
(
$this_rv
);
}
1;