package interactive_http; # $Id$ use diagnostics; use strict; use vars qw(@ISA); @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, ">$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 => $script_name, -method => 'post'); print "
$e->{label} | \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 " |