File Coverage

blib/lib/UI/Dialog/GNOME.pm
Criterion Covered Total %
statement 50 76 65.7
branch 14 32 43.7
condition 11 28 39.2
subroutine 8 9 88.8
pod 2 2 100.0
total 85 147 57.8


line stmt bran cond sub pod time code
1             package UI::Dialog::GNOME;
2             ###############################################################################
3             # Copyright (C) 2004-2016 Kevin C. Krinke
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             ###############################################################################
19 1     1   12851 use 5.006;
  1         2  
20 1     1   4 use strict;
  1         1  
  1         15  
21 1     1   2 use warnings;
  1         2  
  1         19  
22 1     1   3 use Carp;
  1         1  
  1         64  
23 1     1   329 use UI::Dialog;
  1         2  
  1         28  
24              
25             BEGIN {
26 1     1   3 use vars qw( $VERSION @ISA );
  1         1  
  1         43  
27 1     1   6 @ISA = qw( UI::Dialog );
28 1         488 $VERSION = '1.21';
29             }
30              
31             #::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
32             #: Constructor Method
33             #:
34              
35             sub new {
36 1     1 1 433 my $proto = shift();
37 1   33     6 my $class = ref($proto) || $proto;
38 1   50     4 my $cfg = {@_} || {};
39 1         2 my $self = {};
40 1         1 bless($self, $class);
41              
42 1   50     11 $self->{'debug'} = $cfg->{'debug'} || 0;
43              
44             #: Dynamic path discovery...
45 1         2 my $CFG_PATH = $cfg->{'PATH'};
46 1 50       4 if ($CFG_PATH) {
    50          
47 0 0       0 if (ref($CFG_PATH) eq "ARRAY") { $self->{'PATHS'} = $CFG_PATH; }
  0 0       0  
    0          
48 0         0 elsif ($CFG_PATH =~ m!:!) { $self->{'PATHS'} = [ split(/:/,$CFG_PATH) ]; }
49 0         0 elsif (-d $CFG_PATH) { $self->{'PATHS'} = [ $CFG_PATH ]; }
50 1         6 } elsif ($ENV{'PATH'}) { $self->{'PATHS'} = [ split(/:/,$ENV{'PATH'}) ]; }
51 0         0 else { $self->{'PATHS'} = ''; }
52              
53 1   50     6 $cfg->{'order'} ||= [ 'zenity', 'xdialog', 'gdialog' ];
54              
55 1   50     9 $self->_debug("ENV->UI_DIALOGS: ".($ENV{'UI_DIALOGS'}||'NULL'),2);
56 1 50       2 $cfg->{'order'} = [ split(/\:/,$ENV{'UI_DIALOGS'}) ] if $ENV{'UI_DIALOGS'};
57              
58 1   50     9 $self->_debug("ENV->UI_DIALOG: ".($ENV{'UI_DIALOG'}||'NULL'),2);
59 1 50       3 unshift(@{$cfg->{'order'}},$ENV{'UI_DIALOG'}) if $ENV{'UI_DIALOG'};
  0         0  
60              
61             $cfg->{'trust-input'} =
62             ( exists $cfg->{'trust-input'}
63 1 50 33     4 && $cfg->{'trust-input'}==1
64             ) ? 1 : 0;
65              
66 1         2 my @opts = ();
67 1         20 foreach my $opt (keys(%$cfg)) { push(@opts,$opt,$cfg->{$opt}); }
  3         5  
68              
69 1         2 foreach my $try (@{$cfg->{'order'}}) {
  1         2  
70 3 100       21 if ($try =~ /^zenity$/i) {
    100          
    50          
71 1         2 $self->_debug("trying zenity",2);
72 1 50 33     53 if (eval "require UI::Dialog::Backend::Zenity; 1" && $self->_has_variant('zenity')) {
73 0         0 require UI::Dialog::Backend::Zenity;
74 0         0 $self->{'_ui_dialog'} = new UI::Dialog::Backend::Zenity (@opts);
75 0         0 $self->_debug("using zenity",2);
76 0         0 last;
77 1         5 } else { next; }
78             } elsif ($try =~ /^(?:gdialog|gdialog\.real)$/i) {
79 1         4 $self->_debug("trying gdialog",2);
80 1 50 33     50 if (eval "require UI::Dialog::Backend::GDialog; 1" && ($self->_has_variant('gdialog.real') ||
      33        
81             $self->_has_variant('gdialog'))) {
82 0         0 require UI::Dialog::Backend::GDialog;
83 0         0 $self->{'_ui_dialog'} = new UI::Dialog::Backend::GDialog (@opts);
84 0         0 $self->_debug("using gdialog",2);
85 0         0 last;
86 1         4 } else { next; }
87             } elsif ($try =~ /^(?:xdialog|X)$/i) {
88 1         4 $self->_debug("trying xdialog",2);
89 1 50 33     47 if (eval "require UI::Dialog::Backend::XDialog; 1" && $self->_has_variant('Xdialog')) {
90 0         0 require UI::Dialog::Backend::XDialog;
91 0         0 $self->{'_ui_dialog'} = new UI::Dialog::Backend::XDialog (@opts,'XDIALOG_HIGH_DIALOG_COMPAT',1);
92 0         0 $self->_debug("using xdialog",2);
93 0         0 last;
94 1         4 } else { next; }
95             } else {
96             # we don't know what they're asking for... try UI::Dialog...
97 0 0       0 if (eval "require UI::Dialog; 1") {
98 0         0 require UI::Dialog;
99 0         0 $self->{'_ui_dialog'} = new UI::Dialog (@opts);
100 0         0 $self->_debug(ref($self)." unknown backend: '".$try."', using UI::Dialog instead.",2);
101 0         0 last;
102 0         0 } else { next; }
103             }
104             }
105              
106 1 50       185 ref($self->{'_ui_dialog'}) or croak("unable to load suitable backend.");
107              
108 0           return($self);
109             }
110              
111 0     0 1   sub editbox { return(shift()->{'_ui_dialog'}->editbox(@_)); }
112              
113             1;