1package UI::Dialog::Screen::Druid; 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 constant { TRUE => 1, FALSE => 0 }; 23 24BEGIN { 25 use vars qw($VERSION); 26 $VERSION = '1.21'; 27} 28 29use UI::Dialog; 30 31# Example Usage 32# 33# my $druid = new UI::Dialog::Screen::Druid 34# ( dialog => $DIALOG, 35# title => 'druid walkthrough' 36# ); 37# $druid->add_yesno_step('bool0',"Boolean 0"); 38# $druid->add_yesno_step('bool1',"Boolean 1"); 39# my (%answers) = $druid->perform(); 40# 41 42sub new { 43 my ($class, %args) = @_; 44 unless (exists $args{dialog}) { 45 $args{dialog} = new UI::Dialog 46 ( 47 title => (defined $args{title}) ? $args{title} : '', 48 backtitle => (defined $args{backtitle}) ? $args{backtitle} : '', 49 height => (defined $args{height}) ? $args{height} : 20, 50 width => (defined $args{width}) ? $args{width} : 65, 51 listheight => (defined $args{listheight}) ? $args{listheight} : 5, 52 order => (defined $args{order}) ? $args{order} : undef, 53 PATH => (defined $args{PATH}) ? $args{PATH} : undef, 54 beepbefore => (defined $args{beepbefore}) ? $args{beepbefore} : undef, 55 beepafter => (defined $args{beepafter}) ? $args{beepafter} : undef, 56 ); 57 } 58 $args{performance} = [] unless exists $args{performance}; 59 return bless { %args }, $class; 60} 61 62#: not used yet, not sure keys being forced unique isn't too rigid 63# 64sub __verify_unique_tag { 65 my ($self,$tag) = @_; 66 if (grep {m!^\Q$tag\E$!} keys %{$self->{performance}}) { 67 return FALSE; # exists already, not unique tag 68 } 69 # doesn't exist, is unique tag 70 return TRUE; 71} 72 73#: $druid->add_input_step( "key", "Label text", "Default text"); 74#: Add a text-input step to the performance 75# 76sub add_input_step { 77 my ($self,$tag,$text,$default) = @_; 78 push( @{$self->{performance}}, 79 { type=>"input", 80 tag=>$tag, 81 text=>$text, 82 default=>defined $default ? $default : '', 83 } 84 ); 85} 86 87#: $druid->add_password_step( "key", "Label text" ); 88#: Add a password step to the performance 89# 90sub add_password_step { 91 my ($self,$tag,$text) = @_; 92 push( @{$self->{performance}}, 93 { type=>"password", 94 tag=>$tag, 95 text=>$text 96 } 97 ); 98} 99 100#: $druid->add_menu_step( "key", "Label text", [qw|opt1 opt2 op3|] ); 101#: Add a menu select step to the performance 102# 103sub add_menu_step { 104 my ($self,$tag,$text,$options) = @_; 105 push( @{$self->{performance}}, 106 { type=>"menu", 107 tag=>$tag, 108 text=>$text, 109 options=>$options 110 } 111 ); 112} 113 114#: $druid->add_yesno_step( "key", "Label text" ); 115#: Add a yesno step to the performance 116# 117sub add_yesno_step { 118 my ($self,$tag,$text) = @_; 119 push( @{$self->{performance}}, 120 { type=>"yesno", 121 tag=>$tag, 122 text=>$text 123 } 124 ); 125} 126 127#: my (%answers) = $druid->perform(); 128#: Show the performance! Walk the user to the druid's step :) 129# 130sub perform { 131 my ($self) = @_; 132 my $key = undef; 133 my %answers = (); 134 foreach my $step ( @{$self->{performance}} ) { 135 $key = $step->{tag}; 136 my $r = undef; 137 # yesno questions 138 if ($step->{type} eq "yesno") { 139 $r = $self->{dialog}->yesno 140 ( title => $step->{tag}, 141 text => $step->{text} 142 ); 143 goto PERFORM_STEP_FAILURE 144 if $self->{dialog}->state() eq "ESC"; 145 } 146 # text-input questions 147 elsif ($step->{type} eq "input") { 148 my $default = defined $step->{default} ? $step->{default} : ''; 149 foreach my $key (keys %answers) { 150 my $val = $answers{$key}; 151 if ($default =~ m!\{\{\Q${key}\E\}\}!mg) { 152 $default =~ s!\{\{\Q${key}\E\}\}!${val}!g; 153 } 154 } 155 foreach my $step (@{$self->{performance}}) { 156 if (exists $step->{default}) { 157 my $key = $step->{tag}; 158 my $val = $step->{default}; 159 if ($default =~ m!\{\{\Q${key}\E\}\}!mg) { 160 $default =~ s!\{\{\Q${key}\E\}\}!${val}!g; 161 } 162 } 163 } 164 $r = $self->{dialog}->inputbox 165 ( title => $step->{tag}, 166 text => $step->{text}, 167 entry => $default 168 ); 169 goto PERFORM_STEP_FAILURE 170 if $self->{dialog}->state() ne "OK"; 171 } 172 # password questions 173 elsif ($step->{type} eq "password") { 174 $r = $self->{dialog}->password 175 ( title => $step->{tag}, 176 text => $step->{text} 177 ); 178 goto PERFORM_STEP_FAILURE 179 if $self->{dialog}->state() ne "OK"; 180 } 181 # menu questions 182 elsif ($step->{type} eq "menu") { 183 my @list = (); 184 my $count = 0; 185 foreach (@{$step->{options}}) { 186 $count++; 187 push(@list,$count,$_); 188 } 189 $r = $self->{dialog}->menu 190 ( title => $step->{tag}, 191 text => $step->{text}, 192 list => \@list 193 ); 194 goto PERFORM_STEP_FAILURE 195 if $self->{dialog}->state() ne "OK"; 196 $r = $step->{options}[$r-1]; 197 } 198 $answers{$key} = $r; 199 } 200 return wantarray ? %answers : \%answers; 201 PERFORM_STEP_FAILURE: 202 my %aborted = (aborted=>1,key=>$key); 203 return wantarray ? %aborted : \%aborted; 204} 205 206 2071; # END OF UI::Dialog::Screen::Druid 208