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