diff options
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm')
| -rw-r--r-- | beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm | 137 |
1 files changed, 0 insertions, 137 deletions
diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm deleted file mode 100644 index bb2caff..0000000 --- a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm +++ /dev/null @@ -1,137 +0,0 @@ -#!/usr/bin/perl -w -# This file was preprocessed, do not edit! - - -package Debconf::FrontEnd::Web; -use IO::Socket; -use IO::Select; -use CGI; -use strict; -use Debconf::Gettext; -use base qw(Debconf::FrontEnd); - - - -sub init { - my $this=shift; - - $this->SUPER::init(@_); - - $this->port(8001) unless defined $this->port; - $this->formid(0); - $this->interactive(1); - $this->capb('backup'); - $this->need_tty(0); - - $this->server(IO::Socket::INET->new( - LocalPort => $this->port, - Proto => 'tcp', - Listen => 1, - Reuse => 1, - LocalAddr => '127.0.0.1', - )) || die "Can't bind to ".$this->port.": $!"; - - print STDERR sprintf(gettext("Note: Debconf is running in web mode. Go to http://localhost:%i/"),$this->port)."\n"; -} - - -sub client { - my $this=shift; - - $this->{client}=shift if @_; - return $this->{client} if $this->{client}; - - my $select=IO::Select->new($this->server); - 1 while ! $select->can_read(1); - my $client=$this->server->accept; - my $commands=''; - while (<$client>) { - last if $_ eq "\r\n"; - $commands.=$_; - } - $this->commands($commands); - $this->{client}=$client; -} - - -sub closeclient { - my $this=shift; - - close $this->client; - $this->client(''); -} - - -sub showclient { - my $this=shift; - my $page=shift; - - my $client=$this->client; - print $client $page; -} - - -sub go { - my $this=shift; - - $this->backup(''); - - my $httpheader="HTTP/1.0 200 Ok\nContent-type: text/html\n\n"; - my $form=''; - my $id=0; - my %idtoelt; - foreach my $elt (@{$this->elements}) { - $idtoelt{$id}=$elt; - $elt->id($id++); - my $html=$elt->show; - if ($html ne '') { - $form.=$html."<hr>\n"; - } - } - return 1 if $form eq ''; - - my $formid=$this->formid(1 + $this->formid); - - $form="<html>\n<title>".$this->title."</title>\n<body>\n". - "<form><input type=hidden name=formid value=$formid>\n". - $form."<p>\n"; - - if ($this->capb_backup) { - $form.="<input type=submit value=".gettext("Back")." name=back>\n"; - } - $form.="<input type=submit value=".gettext("Next").">\n"; - $form.="</form>\n</body>\n</html>\n"; - - my $query; - do { - $this->showclient($httpheader . $form); - - $this->closeclient; - $this->client; - - my @get=grep { /^GET / } split(/\r\n/, $this->commands); - my $get=shift @get; - my ($qs)=$get=~m/^GET\s+.*?\?(.*?)(?:\s+.*)?$/; - - $query=CGI->new($qs); - } until ($query->param('formid') eq $formid); - - if ($this->capb_backup && $query->param('back') ne '') { - return ''; - } - - foreach my $id ($query->param) { - next unless $idtoelt{$id}; - - $idtoelt{$id}->value($query->param($id)); - delete $idtoelt{$id}; - } - foreach my $elt (values %idtoelt) { - $elt->value(''); - } - - return 1; -} - - -1 |