1package UI::Dialog::Gauged; 2############################################################################### 3# Copyright (C) 2004-2016 Kevin C. Krinke <kevin@krinke.ca> 4# 5# This library is free software; you can redistribute it and/or 6# modify it under the terms of the GNU Lesser General Public 7# License as published by the Free Software Foundation; either 8# version 2.1 of the License, or (at your option) any later version. 9# 10# This library is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13# Lesser General Public License for more details. 14# 15# You should have received a copy of the GNU Lesser General Public 16# License along with this library; if not, write to the Free Software 17# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 18############################################################################### 19use 5.006; 20use strict; 21use warnings; 22use Carp; 23 24BEGIN { 25 use vars qw($VERSION); 26 $VERSION = '1.21'; 27} 28 29#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 30#: Constructor Method 31#: 32 33sub new { 34 my $proto = shift(); 35 my $class = ref($proto) || $proto; 36 my $cfg = {@_} || {}; 37 my $self = {}; 38 bless($self, $class); 39 40 $self->{'debug'} = $cfg->{'debug'} || 0; 41 42 #: Dynamic path discovery... 43 my $CFG_PATH = $cfg->{'PATH'}; 44 if ($CFG_PATH) { 45 if (ref($CFG_PATH) eq "ARRAY") { $self->{'PATHS'} = $CFG_PATH; } 46 elsif ($CFG_PATH =~ m!:!) { $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; } 47 elsif (-d $CFG_PATH) { $self->{'PATHS'} = [ $CFG_PATH ]; } 48 } elsif ($ENV{'PATH'}) { $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; } 49 else { $self->{'PATHS'} = ''; } 50 51 if (not $cfg->{'order'} and ($ENV{'DISPLAY'} && length($ENV{'DISPLAY'}) > 0)) { 52 #: Pick a GUI mode 'cause a DISPLAY was detected 53 if ($ENV{'TERM'} =~ /^dumb$/i) { 54 # we're running free of a terminal 55 $cfg->{'order'} = [ 'zenity', 'xdialog' ]; 56 } else { 57 # we're running in a terminal 58 $cfg->{'order'} = [ 'zenity', 'xdialog', 'cdialog', 'whiptail' ]; 59 } 60 } 61 # verify and repair the order 62 $cfg->{'order'} = ((ref($cfg->{'order'}) eq "ARRAY") ? $cfg->{'order'} : 63 ($cfg->{'order'}) ? [ $cfg->{'order'} ] : 64 [ 'cdialog', 'whiptail' ]); 65 66 $self->_debug("ENV->UI_DIALOGS: ".($ENV{'UI_DIALOGS'}||'NULL'),2); 67 $cfg->{'order'} = [ split(/\:/,$ENV{'UI_DIALOGS'}) ] if $ENV{'UI_DIALOGS'}; 68 69 $self->_debug("ENV->UI_DIALOG: ".($ENV{'UI_DIALOG'}||'NULL'),2); 70 unshift(@{$cfg->{'order'}},$ENV{'UI_DIALOG'}) if $ENV{'UI_DIALOG'}; 71 72 $cfg->{'trust-input'} = 73 ( exists $cfg->{'trust-input'} 74 && $cfg->{'trust-input'}==1 75 ) ? 1 : 0; 76 77 my @opts = (); 78 foreach my $opt (keys(%$cfg)) { push(@opts,$opt,$cfg->{$opt}); } 79 80 $self->_debug("order: @{$cfg->{'order'}}",2); 81 82 if (ref($cfg->{'order'}) eq "ARRAY") { 83 foreach my $try (@{$cfg->{'order'}}) { 84 if ($try =~ /^zenity$/i) { 85 $self->_debug("trying zenity",2); 86 if (eval "require UI::Dialog::Backend::Zenity; 1" && $self->_has_variant('zenity')) { 87 require UI::Dialog::Backend::Zenity; 88 $self->{'_ui_dialog'} = new UI::Dialog::Backend::Zenity (@opts); 89 $self->_debug("using zenity",2); 90 last; 91 } else { next; } 92 } elsif ($try =~ /^(?:xdialog|X)$/i) { 93 $self->_debug("trying xdialog",2); 94 if (eval "require UI::Dialog::Backend::XDialog; 1" && $self->_has_variant('Xdialog')) { 95 require UI::Dialog::Backend::XDialog; 96 $self->{'_ui_dialog'} = new UI::Dialog::Backend::XDialog (@opts,'XDIALOG_HIGH_DIALOG_COMPAT',1); 97 $self->_debug("using xdialog",2); 98 last; 99 } else { next; } 100 } elsif ($try =~ /^(?:dialog|cdialog)$/i) { 101 $self->_debug("trying cdialog",2); 102 if (eval "require UI::Dialog::Backend::CDialog; 1" && $self->_has_variant('dialog')) { 103 require UI::Dialog::Backend::CDialog; 104 $self->{'_ui_dialog'} = new UI::Dialog::Backend::CDialog (@opts); 105 $self->_debug("using cdialog",2); 106 last; 107 } else { next; } 108 } elsif ($try =~ /^whiptail$/i) { 109 $self->_debug("trying whiptail",2); 110 if (eval "require UI::Dialog::Backend::Whiptail; 1" && $self->_has_variant('whiptail')) { 111 require UI::Dialog::Backend::Whiptail; 112 $self->{'_ui_dialog'} = new UI::Dialog::Backend::Whiptail (@opts); 113 $self->_debug("using whiptail",2); 114 last; 115 } else { next; } 116 } else { 117 # we don't know what they're asking for... try UI::Dialog... 118 if (eval "require UI::Dialog; 1") { 119 require UI::Dialog; 120 $self->{'_ui_dialog'} = new UI::Dialog (@opts); 121 $self->_debug(ref($self)." unknown backend: '".$try."', using UI::Dialog instead.",2); 122 last; 123 } else { next; } 124 } 125 } 126 } else { 127 carp("Failed to load any suitable dialog variant backend."); 128 } 129 130 ref($self->{'_ui_dialog'}) or croak("unable to load suitable backend."); 131 return($self); 132} 133 134#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 135#: Private Methods 136#: 137 138#: purely internal usage 139sub _debug { 140 my $self = $_[0]; 141 my $mesg = $_[1] || 'null error message given!'; 142 my $rate = $_[2] || 1; 143 return() unless $self->{'debug'} and $self->{'debug'} >= $rate; 144 chomp($mesg); 145 print STDERR "Debug: ".$mesg."\n"; 146} 147 148sub _has_variant { 149 my $self = $_[0]; 150 my $variant = $_[1]; 151 $self->{'PATHS'} = ((ref($self->{'PATHS'}) eq "ARRAY") ? $self->{'PATHS'} : 152 ($self->{'PATHS'}) ? [ $self->{'PATHS'} ] : 153 [ '/bin', '/usr/bin', '/usr/local/bin', '/opt/bin' ]); 154 foreach my $PATH (@{$self->{'PATHS'}}) { 155 return($PATH . '/' . $variant) 156 unless not -x $PATH . '/' . $variant; 157 } 158 return(0); 159} 160 161#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: 162#: Public Methods 163#: 164 165#: dialog variant state methods: 166sub state { return(shift()->{'_ui_dialog'}->state(@_)); } 167sub ra { return(shift()->{'_ui_dialog'}->ra(@_)); } 168sub rs { return(shift()->{'_ui_dialog'}->rs(@_)); } 169sub rv { return(shift()->{'_ui_dialog'}->rv(@_)); } 170 171#: Frills 172#: all backends support nautilus scripts. 173sub nautilus { return(shift()->{'_ui_dialog'}->nautilus(@_)); } 174#: same with osd_cat (aka: xosd). 175sub xosd { return(shift()->{'_ui_dialog'}->xosd(@_)); } 176#: Beep & Clear may have no affect when using GUI backends 177sub beep { return(shift()->{'_ui_dialog'}->beep(@_)); } 178sub clear { return(shift()->{'_ui_dialog'}->clear(@_)); } 179 180#: widget methods: 181sub yesno { return(shift()->{'_ui_dialog'}->yesno(@_)); } 182sub msgbox { return(shift()->{'_ui_dialog'}->msgbox(@_)); } 183sub inputbox { return(shift()->{'_ui_dialog'}->inputbox(@_)); } 184sub password { return(shift()->{'_ui_dialog'}->password(@_)); } 185sub textbox { return(shift()->{'_ui_dialog'}->textbox(@_)); } 186sub menu { return(shift()->{'_ui_dialog'}->menu(@_)); } 187sub checklist { return(shift()->{'_ui_dialog'}->checklist(@_)); } 188sub radiolist { return(shift()->{'_ui_dialog'}->radiolist(@_)); } 189sub fselect { return(shift()->{'_ui_dialog'}->fselect(@_)); } 190sub dselect { return(shift()->{'_ui_dialog'}->dselect(@_)); } 191 192# gauge methods 193sub gauge_start { return(shift()->{'_ui_dialog'}->gauge_start(@_)); } 194sub gauge_stop { return(shift()->{'_ui_dialog'}->gauge_stop(@_)); } 195sub gauge_inc { return(shift()->{'_ui_dialog'}->gauge_inc(@_)); } 196sub gauge_dec { return(shift()->{'_ui_dialog'}->gauge_dec(@_)); } 197sub gauge_set { return(shift()->{'_ui_dialog'}->gauge_set(@_)); } 198sub gauge_text { return(shift()->{'_ui_dialog'}->gauge_text(@_)); } 199 200 2011; 202