diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/interactive.pm | 4 | ||||
| -rw-r--r-- | perl-install/interactive_http.pm | 158 |
2 files changed, 162 insertions, 0 deletions
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index 1815ab21e..16bf2ede6 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -58,6 +58,10 @@ sub new($) { sub vnew { my ($type, $su, $icon) = @_; $su = $su eq "su"; + if ($ENV{INTERACTIVE_HTTP}) { + require interactive_http; + return interactive_http->new; + } require c; if ($ENV{DISPLAY} && system('/usr/X11R6/bin/xtest') == 0) { if ($su) { diff --git a/perl-install/interactive_http.pm b/perl-install/interactive_http.pm new file mode 100644 index 000000000..2bf8ab616 --- /dev/null +++ b/perl-install/interactive_http.pm @@ -0,0 +1,158 @@ +package interactive_http; # $Id$ + +use diagnostics; +use strict; +use vars qw(@ISA); + +@ISA = qw(interactive); + +use CGI; +use interactive; +use common; +use log; + +my $no_header; +my $uid; +my $pipe_r = "/tmp/interactive_http_r"; +my $pipe_w = "/tmp/interactive_http_w"; + +sub open_stdout { + open STDOUT, ">$pipe_w" or die; + $| = 1; + print CGI::header(); + $no_header = 1; +} + +# cont_stdout must be called after open_stdout and before the first print +sub cont_stdout { + my ($title) = @_; + print CGI::start_html(-title => $title) if $no_header; + $no_header = 0; +} + +sub new_uid { + my ($s, $ms) = gettimeofday(); + $s * 256 + $ms % 256; +} + +sub new() { + open_stdout(); + bless {}, $_[0]; +} + +sub end() { + -e $pipe_r or return; # don't run this twice + my $q = CGI->new; + cont_stdout("Exit"); + print "It's done, thanks for playing ($@) ($?)", $q->end_html; + close STDOUT; + unlink $pipe_r, $pipe_w; +} +sub exit() { end; exit($_[1]) } +END { end() } + +sub ask_from_entries_refW { + my ($o, $common, $l, $l2) = @_; + + redisplay: + my $uid = new_uid(); + my $q = CGI->new; + $q->param(state => 'next_step'); + $q->param(uid => $uid); + cont_stdout($common->{title}); + +# print $q->img({ -src => "/icons/$o->{icon}" }) if $o->{icon}; + print @{$common->{messages}}; + print $q->start_form(-name => 'form', -action => '/cgi-bin/interactive_http', -method => 'get'); + + print "<table>\n"; + + map_index { + my $e = $_; + + print "<tr><td>$e->{label}</td><td>\n"; + + $e->{type} = 'list' if $e->{type} =~ /(icon|tree)list/; + + #- combo doesn't exist, fallback to a sensible default + $e->{type} = $e->{not_edit} ? 'list' : 'entry' if $e->{type} eq 'combo'; + + if ($e->{type} eq 'bool') { + print $q->checkbox(-name => "w$::i", -checked => ${$e->{val}} && 'on', -label => $e->{text} || " "); + } elsif ($e->{type} eq 'button') { + print "nobuttonyet"; + } elsif ($e->{type} =~ /list/) { + my %t; + $t{$_} = may_apply($e->{format}, $_) foreach @{$e->{list}}; + + print $q->scrolling_list(-name => "w$::i", + -values => $e->{list}, + -default => [ ${$e->{val}} ], + -size => 5, -multiple => '', -labels => \%t); + } else { + print $e->{hidden} ? + $q->password_field(-name => "w$::i", -default => ${$e->{val}}) : + $q->textfield (-name => "w$::i", -default => ${$e->{val}}); + } + + print "</td></tr>\n"; + } @$l; + + print "</table>\n"; + print $q->p(); + print $q->submit(-name => 'ok_submit', -value => $common->{ok} || _("Ok")); + print $q->submit(-name => 'cancel_submit', -value => $common->{cancel}) if $common->{cancel}; + print $q->hidden('state'), $q->hidden('uid'); + print $q->end_form, $q->end_html; + + close STDOUT; # page terminated + + while (1) { + local *F; + open F, "<$pipe_r" or die; + $q = CGI->new(\*F); + $q->param('force_exit_dead_prog') and $o->exit; + last if $q->param('uid') == $uid; + + open_stdout(); # re-open for writing + cont_stdout(_("Error")); + print $q->h1(_("Error")), $q->p("Sorry, you can't go back"); + goto redisplay; + } + map_index { + my $e = $_; + my $v = $q->param("w$::i"); + if ($e->{type} eq 'bool') { + $v = $v eq 'on'; + } + ${$e->{val}} = $v; + } @$l; + + open_stdout(); # re-open for writing + $q->param('ok_submit'); +} + +sub p { + print "\n" . CGI::br($_) foreach @_; +} + +sub wait_messageW { + my ($o, $title, $messages) = @_; + cont_stdout(); + print "\n" . CGI::p(); + p(@$messages); +} + +sub wait_message_nextW { + my ($o, $messages, $w) = @_; + p(@$messages); +} +sub wait_message_endW { + my ($o, $w) = @_; + p(_("Done")); + print "\n" . CGI::p(); +} + + + +1; |