<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package interactive_http; # $Id: interactive_http.pm,v 1.4 2001/08/18 17:52:21 prigaux Exp $





@ISA = qw(interactive);

use CGI;
use interactive;
use common;
use log;

my $script_name = $ENV{INTERACTIVE_HTTP};
my $no_header;
my $uid;
my $pipe_r = "/tmp/interactive_http_r";
my $pipe_w = "/tmp/interactive_http_w";

sub open_stdout {
    open STDOUT, "&gt;$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 =&gt; $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-&gt;new;
    cont_stdout("Exit");
    print "It's done, thanks for playing", $q-&gt;end_html;
    close STDOUT;
    unlink $pipe_r, $pipe_w;
}
sub exit() { end; exit($_[1]) }
END { end() }

sub ask_fromW {
    my ($o, $common, $l, $l2) = @_;

  redisplay:
    my $uid = new_uid();
    my $q = CGI-&gt;new;
    $q-&gt;param(state =&gt; 'next_step');
    $q-&gt;param(uid =&gt; $uid);
    cont_stdout($common-&gt;{title});

#    print $q-&gt;img({ -src =&gt; "/icons/$o-&gt;{icon}" }) if $o-&gt;{icon};
    print @{$common-&gt;{messages}};
    print $q-&gt;start_form(-name =&gt; 'form', -action =&gt; $script_name, -method =&gt; 'post');

    print "&lt;table&gt;\n";

    map_index {
	my $e = $_;

	print "&lt;tr&gt;&lt;td&gt;$e-&gt;{label}&lt;/td&gt;&lt;td&gt;\n";

	$e-&gt;{type} = 'list' if $e-&gt;{type} =~ /(icon|tree)list/;

	
	$e-&gt;{type} = $e-&gt;{not_edit} ? 'list' : 'entry' if $e-&gt;{type} eq 'combo';

	if ($e-&gt;{type} eq 'bool') {
	    print $q-&gt;checkbox(-name =&gt; "w$::i", -checked =&gt; ${$e-&gt;{val}} &amp;&amp; 'on', -label =&gt; $e-&gt;{text} || " ");
	} elsif ($e-&gt;{type} eq 'button') {
	    print "nobuttonyet";
	} elsif ($e-&gt;{type} =~ /list/) {
	    my %t; 
	    $t{$_} = may_apply($e-&gt;{format}, $_) foreach @{$e-&gt;{list}};

	    print $q-&gt;scrolling_list(-name =&gt; "w$::i",
				     -values =&gt; $e-&gt;{list},
				     -default =&gt; [ ${$e-&gt;{val}} ],
				     -size =&gt; 5, -multiple =&gt; '', -labels =&gt; \%t);
	} else {
	    print $e-&gt;{hidden} ?
	      $q-&gt;password_field(-name =&gt; "w$::i", -default =&gt; ${$e-&gt;{val}}) :
	      $q-&gt;textfield     (-name =&gt; "w$::i", -default =&gt; ${$e-&gt;{val}});
	}

	print "&lt;/td&gt;&lt;/tr&gt;\n";
    } @$l;

    print "&lt;/table&gt;\n";
    print $q-&gt;p();
    print $q-&gt;submit(-name =&gt; 'ok_submit', -value =&gt; $common-&gt;{ok} || _("Ok"));
    print $q-&gt;submit(-name =&gt; 'cancel_submit', -value =&gt; $common-&gt;{cancel}) if $common-&gt;{cancel};
    print $q-&gt;hidden('state'), $q-&gt;hidden('uid');
    print $q-&gt;end_form, $q-&gt;end_html;

    close STDOUT; # page terminated

    while (1) {	
	local *F;
	open F, "&lt;$pipe_r" or die;
	$q = CGI-&gt;new(\*F);
	$q-&gt;param('force_exit_dead_prog') and $o-&gt;exit;
	last if $q-&gt;param('uid') == $uid;

	open_stdout(); # re-open for writing
	cont_stdout(_("Error"));
	print $q-&gt;h1(_("Error")), $q-&gt;p("Sorry, you can't go back");
	goto redisplay;
    }
    map_index {
	my $e = $_;
	my $v = $q-&gt;param("w$::i");
	if ($e-&gt;{type} eq 'bool') {
	    $v = $v eq 'on';
	}
	${$e-&gt;{val}} = $v;
    } @$l;

    open_stdout(); # re-open for writing
    $q-&gt;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;
</pre></body></html>