summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/interactive.pm4
-rw-r--r--perl-install/interactive_http.pm158
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;