home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debconf / FrontEnd / Web.pm < prev   
Encoding:
Perl POD Document  |  2006-07-24  |  2.5 KB  |  137 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::FrontEnd::Web;
  6. use IO::Socket;
  7. use IO::Select;
  8. use CGI;
  9. use strict;
  10. use Debconf::Gettext;
  11. use base qw(Debconf::FrontEnd);
  12.  
  13.  
  14.  
  15. sub init {
  16.     my $this=shift;
  17.  
  18.     $this->SUPER::init(@_);
  19.     
  20.     $this->port(8001) unless defined $this->port;
  21.     $this->formid(0);
  22.     $this->interactive(1);
  23.     $this->capb('backup');
  24.  
  25.     $this->server(IO::Socket::INET->new(
  26.         LocalPort => $this->port,
  27.         Proto => 'tcp',
  28.         Listen => 1,
  29.         Reuse => 1,
  30.         LocalAddr => '127.0.0.1',
  31.     )) || die "Can't bind to ".$this->port.": $!";
  32.  
  33.     print STDERR sprintf(gettext("Note: Debconf is running in web mode. Go to http://localhost:%i/"),$this->port)."\n";
  34. }
  35.  
  36.  
  37. sub client {
  38.     my $this=shift;
  39.     
  40.     $this->{client}=shift if @_;
  41.     return $this->{client} if $this->{client};
  42.  
  43.     my $select=IO::Select->new($this->server);
  44.     1 while ! $select->can_read(1);
  45.     my $client=$this->server->accept;
  46.     my $commands='';
  47.     while (<$client>) {
  48.         last if $_ eq "\r\n";
  49.         $commands.=$_;
  50.     }
  51.     $this->commands($commands);
  52.     $this->{client}=$client;
  53. }
  54.  
  55.  
  56. sub closeclient {
  57.     my $this=shift;
  58.     
  59.     close $this->client;
  60.     $this->client('');
  61. }
  62.  
  63.  
  64. sub showclient {
  65.     my $this=shift;
  66.     my $page=shift;
  67.  
  68.     my $client=$this->client;
  69.     print $client $page;
  70. }
  71.  
  72.  
  73. sub go {
  74.     my $this=shift;
  75.  
  76.     $this->backup('');
  77.  
  78.     my $httpheader="HTTP/1.0 200 Ok\nContent-type: text/html\n\n";
  79.     my $form='';
  80.     my $id=0;
  81.     my %idtoelt;
  82.     foreach my $elt (@{$this->elements}) {
  83.         $idtoelt{$id}=$elt;
  84.         $elt->id($id++);
  85.         my $html=$elt->show;
  86.         if ($html ne '') {
  87.             $form.=$html."<hr>\n";
  88.         }
  89.     }
  90.     return 1 if $form eq '';
  91.  
  92.     my $formid=$this->formid(1 + $this->formid);
  93.  
  94.     $form="<html>\n<title>".$this->title."</title>\n<body>\n".
  95.            "<form><input type=hidden name=formid value=$formid>\n".
  96.            $form."<p>\n";
  97.  
  98.     if ($this->capb_backup) {
  99.         $form.="<input type=submit value=".gettext("Back")." name=back>\n";
  100.     }
  101.     $form.="<input type=submit value=".gettext("Next").">\n";
  102.     $form.="</form>\n</body>\n</html>\n";
  103.  
  104.     my $query;
  105.     do {
  106.         $this->showclient($httpheader . $form);
  107.     
  108.         $this->closeclient;
  109.         $this->client;
  110.         
  111.         my @get=grep { /^GET / } split(/\r\n/, $this->commands);
  112.         my $get=shift @get;
  113.         my ($qs)=$get=~m/^GET\s+.*?\?(.*?)(?:\s+.*)?$/;
  114.     
  115.         $query=CGI->new($qs);
  116.     } until ($query->param('formid') eq $formid);
  117.  
  118.     if ($this->capb_backup && $query->param('back') ne '') {
  119.         return '';
  120.     }
  121.  
  122.     foreach my $id ($query->param) {
  123.         next unless $idtoelt{$id};
  124.         
  125.         $idtoelt{$id}->value($query->param($id));
  126.         delete $idtoelt{$id};
  127.     }
  128.     foreach my $elt (values %idtoelt) {
  129.         $elt->value('');
  130.     }
  131.     
  132.     return 1;
  133. }
  134.  
  135.  
  136. 1
  137.