diff options
| author | Manuel Traut <manut@mecka.net> | 2011-04-29 09:09:27 +0200 |
|---|---|---|
| committer | Manuel Traut <manut@mecka.net> | 2011-04-29 09:09:27 +0200 |
| commit | 5238ad5a0c4a9e1c8cd036f5de4055e39bd71297 (patch) | |
| tree | 4407c087b9fb5432b1dc11e70b52dacfa0b99feb /beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd | |
| parent | 60ead65c41afba7e6aa4bbcf507a1d52f7a8fe9f (diff) | |
added debootstrap stuff
Signed-off-by: Manuel Traut <manut@mecka.net>
Diffstat (limited to 'beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd')
13 files changed, 1806 insertions, 0 deletions
diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Dialog.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Dialog.pm new file mode 100644 index 0000000..61ac411 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Dialog.pm @@ -0,0 +1,317 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Dialog; +use strict; +use Debconf::Gettext; +use Debconf::Priority; +use Debconf::TmpFile; +use Debconf::Log qw(:all); +use Debconf::Encoding qw(wrap $columns width); +use IPC::Open3; +use POSIX; +use Fcntl; +use base qw(Debconf::FrontEnd::ScreenSize); + + +sub init { + my $this=shift; + + $this->SUPER::init(@_); + + delete $ENV{POSIXLY_CORRECT} if exists $ENV{POSIXLY_CORRECT}; + delete $ENV{POSIX_ME_HARDER} if exists $ENV{POSIX_ME_HARDER}; + + if (! exists $ENV{TERM} || ! defined $ENV{TERM} || $ENV{TERM} eq '') { + die gettext("TERM is not set, so the dialog frontend is not usable.")."\n"; + } + elsif ($ENV{TERM} =~ /emacs/i) { + die gettext("Dialog frontend is incompatible with emacs shell buffers")."\n"; + } + elsif ($ENV{TERM} eq 'dumb' || $ENV{TERM} eq 'unknown') { + die gettext("Dialog frontend will not work on a dumb terminal, an emacs shell buffer, or without a controlling terminal.")."\n"; + } + + $this->interactive(1); + $this->capb('backup'); + + if (-x "/usr/bin/whiptail" && + (! defined $ENV{DEBCONF_FORCE_DIALOG} || ! -x "/usr/bin/dialog") && + (! defined $ENV{DEBCONF_FORCE_XDIALOG} || ! -x "/usr/bin/Xdialog")) { + $this->program('whiptail'); + $this->dashsep('--'); + $this->borderwidth(5); + $this->borderheight(6); + $this->spacer(1); + $this->titlespacer(10); + $this->columnspacer(3); + $this->selectspacer(13); + $this->hasoutputfd(1); + } + elsif (-x "/usr/bin/dialog" && + (! defined $ENV{DEBCONF_FORCE_XDIALOG} || ! -x "/usr/bin/Xdialog")) { + $this->program('dialog'); + $this->dashsep(''); # dialog does not need (or support) + $this->borderwidth(7); + $this->borderheight(6); + $this->spacer(0); + $this->titlespacer(4); + $this->columnspacer(2); + $this->selectspacer(0); + $this->hasoutputfd(1); + } + elsif (-x "/usr/bin/Xdialog" && defined $ENV{DISPLAY}) { + $this->program("Xdialog"); + $this->borderwidth(7); + $this->borderheight(20); + $this->spacer(0); + $this->titlespacer(10); + $this->selectspacer(0); + $this->columnspacer(2); + $this->screenheight(200); + } + else { + die gettext("No usable dialog-like program is installed, so the dialog based frontend cannot be used."); + } + + if ($this->screenheight < 13 || $this->screenwidth < 31) { + die gettext("Dialog frontend requires a screen at least 13 lines tall and 31 columns wide.")."\n"; + } +} + + +sub sizetext { + my $this=shift; + my $text=shift; + + $columns = $this->screenwidth - $this->borderwidth - $this->columnspacer; + $text=wrap('', '', $text); + my @lines=split(/\n/, $text); + + my $window_columns=width($this->title) + $this->titlespacer; + map { + my $w=width($_); + $window_columns = $w if $w > $window_columns; + } @lines; + + return $text, $#lines + 1 + $this->borderheight, + $window_columns + $this->borderwidth; +} + + +sub hide_escape { + my $line = $_; + + $line =~ s/\\n/\\\xe2\x81\xa0n/g; + return $line; +} + + +sub showtext { + my $this=shift; + my $question=shift; + my $intext=shift; + + my $lines = $this->screenheight; + my ($text, $height, $width)=$this->sizetext($intext); + + my @lines = split(/\n/, $text); + my $num; + my @args=('--msgbox', join("\n", @lines)); + if ($lines - 4 - $this->borderheight <= $#lines) { + $num=$lines - 4 - $this->borderheight; + if ($this->program eq 'whiptail') { + push @args, '--scrolltext'; + } + else { + my $fh=Debconf::TmpFile::open(); + print $fh join("\n", map &hide_escape, @lines); + close $fh; + @args=("--textbox", Debconf::TmpFile::filename()); + } + } + else { + $num=$#lines + 1; + } + $this->showdialog($question, @args, $num + $this->borderheight, $width); + if ($args[0] eq '--textbox') { + Debconf::TmpFile::cleanup(); + } +} + + +sub makeprompt { + my $this=shift; + my $question=shift; + my $freelines=$this->screenheight - $this->borderheight + 1; + $freelines += shift if @_; + + my ($text, $lines, $columns)=$this->sizetext( + $question->extended_description."\n\n". + $question->description + ); + + if ($lines > $freelines) { + $this->showtext($question, $question->extended_description); + ($text, $lines, $columns)=$this->sizetext($question->description); + } + + return ($text, $lines, $columns); +} + +sub startdialog { + my $this=shift; + my $question=shift; + my $wantinputfd=shift; + + debug debug => "preparing to run dialog. Params are:" , + join(",", $this->program, @_); + + use vars qw{*SAVEOUT *SAVEIN}; + open(SAVEOUT, ">&STDOUT") || die $!; + $this->dialog_saveout(\*SAVEOUT); + if ($wantinputfd) { + $this->dialog_savein(undef); + } else { + open(SAVEIN, "<&STDIN") || die $!; + $this->dialog_savein(\*SAVEIN); + } + + $this->dialog_savew($^W); + $^W=0; + + unless ($this->capb_backup || grep { $_ eq '--defaultno' } @_) { + if ($this->program ne 'Xdialog') { + unshift @_, '--nocancel'; + } + else { + unshift @_, '--no-cancel'; + } + } + + if ($this->program eq 'Xdialog' && $_[0] eq '--passwordbox') { + $_[0]='--password --inputbox' + } + + use vars qw{*OUTPUT_RDR *OUTPUT_WTR}; + if ($this->hasoutputfd) { + pipe(OUTPUT_RDR, OUTPUT_WTR) || die "pipe: $!"; + my $flags=fcntl(\*OUTPUT_WTR, F_GETFD, 0); + fcntl(\*OUTPUT_WTR, F_SETFD, $flags & ~FD_CLOEXEC); + $this->dialog_output_rdr(\*OUTPUT_RDR); + unshift @_, "--output-fd", fileno(\*OUTPUT_WTR); + } + + my $backtitle=''; + if (defined $this->info) { + $backtitle = $this->info->description; + } else { + $backtitle = gettext("Package configuration"); + } + + use vars qw{*INPUT_RDR *INPUT_WTR}; + if ($wantinputfd) { + pipe(INPUT_RDR, INPUT_WTR) || die "pipe: $!"; + autoflush INPUT_WTR 1; + my $flags=fcntl(\*INPUT_RDR, F_GETFD, 0); + fcntl(\*INPUT_RDR, F_SETFD, $flags & ~FD_CLOEXEC); + $this->dialog_input_wtr(\*INPUT_WTR); + } else { + $this->dialog_input_wtr(undef); + } + + use vars qw{*ERRFH}; + my $pid = open3($wantinputfd ? '<&INPUT_RDR' : '<&STDIN', '>&STDOUT', + \*ERRFH, $this->program, + '--backtitle', $backtitle, + '--title', $this->title, @_); + $this->dialog_errfh(\*ERRFH); + $this->dialog_pid($pid); + close OUTPUT_WTR if $this->hasoutputfd; +} + +sub waitdialog { + my $this=shift; + + my $input_wtr=$this->dialog_input_wtr; + if ($input_wtr) { + close $input_wtr; + } + my $output_rdr=$this->dialog_output_rdr; + my $errfh=$this->dialog_errfh; + my $output=''; + if ($this->hasoutputfd) { + while (<$output_rdr>) { + $output.=$_; + } + my $error=0; + while (<$errfh>) { + print STDERR $_; + $error++; + } + if ($error) { + die sprintf("debconf: %s output the above errors, giving up!", $this->program)."\n"; + } + } + else { + while (<$errfh>) { # ugh + $output.=$_; + } + } + chomp $output; + + waitpid($this->dialog_pid, 0); + $^W=$this->dialog_savew; + + if (defined $this->dialog_savein) { + open(STDIN, '<&', $this->dialog_savein) || die $!; + } + open(STDOUT, '>&', $this->dialog_saveout) || die $!; + + my $ret=$? >> 8; + if ($ret == 255 || ($ret == 1 && join(' ', @_) !~ m/--yesno\s/)) { + $this->backup(1); + return undef; + } + + if (wantarray) { + return $ret, $output; + } + else { + return $output; + } +} + + +sub showdialog { + my $this=shift; + my $question=shift; + + @_=map &hide_escape, @_; + + if (defined $this->progress_bar) { + $this->progress_bar->stop; + } + + $this->startdialog($question, 0, @_); + my (@ret, $ret); + if (wantarray) { + @ret=$this->waitdialog(@_); + } else { + $ret=$this->waitdialog(@_); + } + + if (defined $this->progress_bar) { + $this->progress_bar->start; + } + + if (wantarray) { + return @ret; + } else { + return $ret; + } +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Editor.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Editor.pm new file mode 100644 index 0000000..489db6c --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Editor.pm @@ -0,0 +1,102 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Editor; +use strict; +use Debconf::Encoding q(wrap); +use Debconf::TmpFile; +use Debconf::Gettext; +use base qw(Debconf::FrontEnd::ScreenSize); + +my $fh; + + +sub init { + my $this=shift; + + $this->SUPER::init(@_); + $this->interactive(1); +} + + +sub comment { + my $this=shift; + my $comment=shift; + + print $fh wrap('# ','# ',$comment); + $this->filecontents(1); +} + + +sub divider { + my $this=shift; + + print $fh ("\n".('#' x ($this->screenwidth - 1))."\n"); +} + + +sub item { + my $this=shift; + my $name=shift; + my $value=shift; + + print $fh "$name=\"$value\"\n\n"; + $this->filecontents(1); +} + + +sub go { + my $this=shift; + my @elements=@{$this->elements}; + return 1 unless @elements; + + $fh = Debconf::TmpFile::open('.sh'); + + $this->comment(gettext("You are using the editor-based debconf frontend to configure your system. See the end of this document for detailed instructions.")); + $this->divider; + print $fh ("\n"); + + $this->filecontents(''); + foreach my $element (@elements) { + $element->show; + } + + if (! $this->filecontents) { + Debconf::TmpFile::cleanup(); + return 1; + } + + $this->divider; + $this->comment(gettext("The editor-based debconf frontend presents you with one or more text files to edit. This is one such text file. If you are familiar with standard unix configuration files, this file will look familiar to you -- it contains comments interspersed with configuration items. Edit the file, changing any items as necessary, and then save it and exit. At that point, debconf will read the edited file, and use the values you entered to configure the system.")); + print $fh ("\n"); + close $fh; + + my $editor=$ENV{EDITOR} || $ENV{VISUAL} || '/usr/bin/editor'; + system "$editor ".Debconf::TmpFile->filename; + + my %eltname=map { $_->question->name => $_ } @elements; + open (IN, "<".Debconf::TmpFile::filename()); + while (<IN>) { + next if /^\s*#/; + + if (/(.*?)="(.*)"/ && $eltname{$1}) { + $eltname{$1}->value($2); + } + } + close IN; + + Debconf::TmpFile::cleanup(); + + return 1; +} + + +sub screenwidth { + my $this=shift; + + $Debconf::Encoding::columns=$this->SUPER::screenwidth(@_); +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Gnome.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Gnome.pm new file mode 100644 index 0000000..bb08af0 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Gnome.pm @@ -0,0 +1,180 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Gnome; +use strict; +use utf8; +use Debconf::Gettext; +use Debconf::Config; +use Debconf::Encoding qw(to_Unicode); +use base qw{Debconf::FrontEnd}; + +eval q{ + use Gtk2; + use Gnome2; +}; +die "Unable to load Gnome -- is libgnome2-perl installed?\n" if $@; + + +our @ARGV_for_gnome=('--sm-disable'); + +sub create_druid_page { + my $this=shift; + + $this->druid_page(Gnome2::DruidPageStandard->new); + $this->druid_page->set_logo($this->logo); + $this->druid_page->signal_connect("back", sub { + $this->goback(1); + Gtk2->main_quit; + return 1; + }); + $this->druid_page->signal_connect("next", sub { + $this->goback(0); + Gtk2->main_quit; + return 1; + }); + $this->druid_page->signal_connect("cancel", sub { exit 1 }); + $this->druid_page->show; + $this->druid->append_page($this->druid_page); + $this->druid->set_page($this->druid_page); +} + +sub init { + my $this=shift; + + if (fork) { + wait(); # for child + if ($? != 0) { + die "DISPLAY problem?\n"; + } + } + else { + @ARGV=@ARGV_for_gnome; # temporary change at first + Gnome2::Program->init('GNOME Debconf', '2.0'); + exit(0); # success + } + + my @gnome_sucks=@ARGV; + @ARGV=@ARGV_for_gnome; + Gnome2::Program->init('GNOME Debconf', '2.0'); + @ARGV=@gnome_sucks; + + $this->SUPER::init(@_); + $this->interactive(1); + $this->capb('backup'); + $this->need_tty(0); + + $this->win(Gtk2::Window->new("toplevel")); + $this->win->set_position("center"); + $this->win->set_default_size(600, 400); + my $hostname = `hostname`; + chomp $hostname; + $this->win->set_title(to_Unicode(sprintf(gettext("Debconf on %s"), $hostname))); + $this->win->signal_connect("delete_event", sub { exit 1 }); + + my $distribution=''; + if (system('type lsb_release >/dev/null 2>&1') == 0) { + $distribution=lc(`lsb_release -is`); + chomp $distribution; + } elsif (-e '/etc/debian_version') { + $distribution='debian'; + } + + my $logo="/usr/share/pixmaps/$distribution-logo.png"; + if (-e $logo) { + $this->logo(Gtk2::Gdk::Pixbuf->new_from_file($logo)); + } + + $this->druid(Gnome2::Druid->new); + $this->druid->show; + $this->win->add($this->druid); + + $this->create_druid_page (); +} + + +sub go { + my $this=shift; + my @elements=@{$this->elements}; + + my $interactive=''; + foreach my $element (@elements) { + next unless $element->hbox; + + $interactive=1; + $this->druid_page->vbox->pack_start($element->hbox, $element->fill, $element->expand, 0); + } + + if ($interactive) { + $this->druid_page->set_title(to_Unicode($this->title)); + if ($this->capb_backup) { + $this->druid->set_buttons_sensitive(1, 1, 1, 1); + } + else { + $this->druid->set_buttons_sensitive(0, 1, 1, 1); + } + $this->win->show; + Gtk2->main; + $this->create_druid_page (); + } + + foreach my $element (@elements) { + $element->show; + } + + return '' if $this->goback; + return 1; +} + +sub progress_start { + my $this=shift; + $this->SUPER::progress_start(@_); + + my $element=$this->progress_bar; + $this->druid_page->vbox->pack_start($element->hbox, $element->fill, $element->expand, 0); + $this->druid_page->set_title(to_Unicode($this->title)); + $this->druid->set_buttons_sensitive(0, 0, 1, 1); + $this->win->show; + + while (Gtk2->events_pending) { + Gtk2->main_iteration; + } +} + +sub progress_set { + my $this=shift; + + my $ret=$this->SUPER::progress_set(@_); + + while (Gtk2->events_pending) { + Gtk2->main_iteration; + } + + return $ret; +} + +sub progress_info { + my $this=shift; + my $ret=$this->SUPER::progress_info(@_); + + while (Gtk2->events_pending) { + Gtk2->main_iteration; + } + + return $ret; +} + +sub progress_stop { + my $this=shift; + $this->SUPER::progress_stop(@_); + + while (Gtk2->events_pending) { + Gtk2->main_iteration; + } + + $this->create_druid_page(); +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde.pm new file mode 100644 index 0000000..5483568 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde.pm @@ -0,0 +1,212 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Kde; +use strict; +use utf8; +use Debconf::Gettext; +use Debconf::Config; +BEGIN { + eval { require QtCore4 }; + die "Unable to load QtCore -- is libqtcore4-perl installed?\n" if $@; + eval { require QtGui4 }; + die "Unable to load QtGui -- is libqtgui4-perl installed?\n" if $@; +} +use Debconf::FrontEnd::Kde::Wizard; +use Debconf::Log ':all'; +use base qw{Debconf::FrontEnd}; +use Debconf::Encoding qw(to_Unicode); + + + +our @ARGV_KDE=(); + +sub init { + my $this=shift; + + $this->SUPER::init(@_); + $this->interactive(1); + $this->cancelled(0); + $this->createdelements([]); + $this->dupelements([]); + $this->capb('backup'); + $this->need_tty(0); + + if (fork) { + wait(); # for child + if ($? != 0) { + die "DISPLAY problem?\n"; + } + } + else { + $this->qtapp(Qt::Application(\@ARGV_KDE)); + exit(0); # success + } + + $this->window_initted(0); + $this->kde_initted(0); +} + +sub init_kde { + my $this=shift; + + return if $this->kde_initted; + + debug frontend => "QTF: initializing app"; + $this->qtapp(Qt::Application(\@ARGV_KDE)); + $this->kde_initted(1); +} + +sub init_window { + my $this=shift; + $this->init_kde(); + return if $this->window_initted; + $this->{vbox} = Qt::VBoxLayout; + + debug frontend => "QTF: initializing wizard"; + $this->win(Debconf::FrontEnd::Kde::Wizard(undef,undef, $this)); + debug frontend => "QTF: setting size"; + $this->win->resize(620, 430); + my $hostname = `hostname`; + chomp $hostname; + $this->hostname($hostname); + debug frontend => "QTF: setting title"; + $this->win->setTitle(to_Unicode(sprintf(gettext("Debconf on %s"), $this->hostname))); + debug frontend => "QTF: initializing main widget"; + $this->{toplayout} = Qt::HBoxLayout(); + $this->win->setMainFrameLayout($this->toplayout); + $this->win->setTitle(to_Unicode(sprintf(gettext("Debconf on %s"), $this->hostname))); + $this->window_initted(1); +} + + +sub go { + my $this=shift; + my @elements=@{$this->elements}; + + + $this->init_window; + + + my $interactive=''; + debug frontend => "QTF: -- START ------------------"; + foreach my $element (@elements) { + next unless $element->can("create"); + + $element->create($this->frame); + $interactive=1; + debug frontend => "QTF: ADD: " . $element->question->description; + $this->{vbox}->addWidget($element->top); + } + + if ($interactive) { + foreach my $element (@elements) { + next unless $element->top; + debug frontend => "QTF: SHOW: " . $element->question->description; + $element->top->show; + } + my $scroll = Qt::ScrollArea($this->win); + my $widget = Qt::Widget($scroll); + $widget->setLayout($this->{vbox}); + $scroll->setWidget($widget); + $this->toplayout->addWidget($scroll); + + + if ($this->capb_backup) { + $this->win->setBackEnabled(1); + } + else { + $this->win->setBackEnabled(0); + } + $this->win->setNextEnabled(1); + + $this->win->show; + debug frontend => "QTF: -- ENTER EVENTLOOP --------"; + $this->qtapp->exec; + $this->qtapp->exit; + debug frontend => "QTF: -- LEFT EVENTLOOP --------"; + + $this->win->destroy(); + $this->window_initted(0); + + + } else { + foreach my $element (@elements) { + $element->show; + } + } + + debug frontend => "QTF: -- END --------------------"; + if ($this->cancelled) { + exit 1; + } + return '' if $this->goback; + return 1; +} + +sub progress_start { + my $this=shift; + $this->init_window; + $this->SUPER::progress_start(@_); + + my $element=$this->progress_bar; + $this->{vbox}->addWidget($element->top); + $element->top->show; + my $scroll = Qt::ScrollArea($this->win); + my $widget = Qt::Widget($scroll); + $widget->setLayout($this->{vbox}); + $scroll->setWidget($widget); + $this->toplayout->addWidget($scroll); + $this->win->setBackEnabled(0); + $this->win->setNextEnabled(0); + $this->win->show; + $this->qtapp->processEvents; +} + +sub progress_set { + my $this=shift; + my $ret=$this->SUPER::progress_set(@_); + + $this->qtapp->processEvents; + + return $ret; +} + +sub progress_info { + my $this=shift; + my $ret=$this->SUPER::progress_info(@_); + + $this->qtapp->processEvents; + + return $ret; +} + +sub progress_stop { + my $this=shift; + my $element=$this->progress_bar; + $this->SUPER::progress_stop(@_); + + $this->qtapp->processEvents; + + $this->win->setAttribute(Qt::WA_DeleteOnClose()); + $this->win->close; + $this->window_initted(0); + + if ($this->cancelled) { + exit 1; + } +} + + +sub shutdown { + my $this = shift; + if ($this->kde_initted) { + if($this->win) { + $this->win->destroy; + } + } +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Ui_DebconfWizard.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Ui_DebconfWizard.pm new file mode 100644 index 0000000..c8caf71 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Ui_DebconfWizard.pm @@ -0,0 +1,154 @@ + + +package Debconf::FrontEnd::Kde::Ui_DebconfWizard; + +use strict; +use warnings; +use utf8; +use QtCore4; + +sub vboxLayout { + return shift->{vboxLayout}; +} + +sub title { + return shift->{title}; +} + +sub line1 { + return shift->{line1}; +} + +sub mainFrame { + return shift->{mainFrame}; +} + +sub hboxLayout { + return shift->{hboxLayout}; +} + +sub bHelp { + return shift->{bHelp}; +} + +sub spacer1 { + return shift->{spacer1}; +} + +sub bBack { + return shift->{bBack}; +} + +sub bNext { + return shift->{bNext}; +} + +sub bCancel { + return shift->{bCancel}; +} + + +sub setupUi { + my ( $class, $debconfWizard ) = @_; + my $self = bless {}, $class; + if ( !defined $debconfWizard->objectName() ) { + $debconfWizard->setObjectName( 'debconfWizard' ); + } + $debconfWizard->resize( 660, 460 ); + my $vboxLayout = Qt::VBoxLayout( $debconfWizard ); + $self->{vboxLayout} = $vboxLayout; + $vboxLayout->setSpacing( 6 ); + $vboxLayout->setMargin( 11 ); + $vboxLayout->setObjectName( 'vboxLayout' ); + my $title = Qt::Label( $debconfWizard ); + $self->{title} = $title; + $title->setObjectName( 'title' ); + my $sizePolicy = Qt::SizePolicy( Qt::SizePolicy::Preferred(), Qt::SizePolicy::Fixed() ); + $self->{$sizePolicy} = $sizePolicy; + $sizePolicy->setHorizontalStretch( 0 ); + $sizePolicy->setVerticalStretch( 0 ); + $sizePolicy->setHeightForWidth( $title->sizePolicy()->hasHeightForWidth() ); + $title->setSizePolicy( $sizePolicy ); + $title->setWordWrap( 0 ); + + $vboxLayout->addWidget( $title ); + + my $line1 = Qt::Frame( $debconfWizard ); + $self->{line1} = $line1; + $line1->setObjectName( 'line1' ); + $sizePolicy->setHeightForWidth( $line1->sizePolicy()->hasHeightForWidth() ); + $line1->setSizePolicy( $sizePolicy ); + $line1->setFrameShape( Qt::Frame::HLine() ); + $line1->setFrameShadow( Qt::Frame::Sunken() ); + + $vboxLayout->addWidget( $line1 ); + + my $mainFrame = Qt::Widget( $debconfWizard ); + $self->{mainFrame} = $mainFrame; + $mainFrame->setObjectName( 'mainFrame' ); + + $vboxLayout->addWidget( $mainFrame ); + + my $hboxLayout = Qt::HBoxLayout( ); + $self->{hboxLayout} = $hboxLayout; + $hboxLayout->setSpacing( 6 ); + $hboxLayout->setObjectName( 'hboxLayout' ); + my $bHelp = Qt::PushButton( $debconfWizard ); + $self->{bHelp} = $bHelp; + $bHelp->setObjectName( 'bHelp' ); + + $hboxLayout->addWidget( $bHelp ); + + my $spacer1 = Qt::SpacerItem( 161, 20, Qt::SizePolicy::Expanding(), Qt::SizePolicy::Minimum() ); + + $hboxLayout->addItem( $spacer1 ); + + my $bBack = Qt::PushButton( $debconfWizard ); + $self->{bBack} = $bBack; + $bBack->setObjectName( 'bBack' ); + + $hboxLayout->addWidget( $bBack ); + + my $bNext = Qt::PushButton( $debconfWizard ); + $self->{bNext} = $bNext; + $bNext->setObjectName( 'bNext' ); + + $hboxLayout->addWidget( $bNext ); + + my $bCancel = Qt::PushButton( $debconfWizard ); + $self->{bCancel} = $bCancel; + $bCancel->setObjectName( 'bCancel' ); + + $hboxLayout->addWidget( $bCancel ); + + + $vboxLayout->addLayout( $hboxLayout ); + + + $self->retranslateUi( $debconfWizard ); + + Qt::MetaObject->connectSlotsByName( $debconfWizard ); + return $self; +} # setupUi + +sub setup_ui { + my ( $debconfWizard ) = @_; + return setupUi( $debconfWizard ); +} + +sub retranslateUi { + my ( $self, $debconfWizard ) = @_; + $debconfWizard->setWindowTitle( Qt::Application::translate( 'DebconfWizard', 'Debconf', undef, Qt::Application::UnicodeUTF8() ) ); + $self->title()->setText( Qt::Application::translate( 'DebconfWizard', 'title', undef, Qt::Application::UnicodeUTF8() ) ); + $self->bHelp()->setText( Qt::Application::translate( 'DebconfWizard', 'Help', undef, Qt::Application::UnicodeUTF8() ) ); + $self->bBack()->setText( Qt::Application::translate( 'DebconfWizard', '< Back', undef, Qt::Application::UnicodeUTF8() ) ); + $self->bNext()->setText( Qt::Application::translate( 'DebconfWizard', 'Next >', undef, Qt::Application::UnicodeUTF8() ) ); + $self->bCancel()->setText( Qt::Application::translate( 'DebconfWizard', 'Cancel', undef, Qt::Application::UnicodeUTF8() ) ); +} # retranslateUi + +sub retranslate_ui { + my ( $debconfWizard ) = @_; + retranslateUi( $debconfWizard ); +} + +1;
\ No newline at end of file diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Wizard.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Wizard.pm new file mode 100644 index 0000000..fc1030b --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Kde/Wizard.pm @@ -0,0 +1,80 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Kde::Wizard; +use strict; +use utf8; +use Debconf::Log ':all'; +use QtCore4; +use QtGui4; +use QtCore4::isa qw(Qt::Widget Debconf::FrontEnd::Kde::Ui_DebconfWizard); +use QtCore4::slots 'goNext' => [], 'goBack' => [], 'goBye' => []; +use Debconf::FrontEnd::Kde::Ui_DebconfWizard; + +use Data::Dumper; +sub NEW { + + my ( $class, $parent ) = @_; + $class->SUPER::NEW($parent ); + this->{frontend} = $_[3]; + + my $ui = this->{ui} = $class->setupUi(this); + + my $bNext = $ui->{bNext}; + my $bBack = $ui->{bBack}; + my $bCancel = $ui->{bCancel}; + this->setObjectName("Wizard"); + this->connect($bNext, SIGNAL 'clicked ()', SLOT 'goNext ()'); + this->connect($bBack, SIGNAL 'clicked ()', SLOT 'goBack ()'); + this->connect($bCancel, SIGNAL 'clicked ()', SLOT 'goBye ()'); + + this->{ui}->mainFrame->setObjectName("mainFrame");; +} + + +sub setTitle { + this->{ui}->{title}->setText($_[0]); +} + + +sub setNextEnabled { + this->{ui}->{bNext}->setEnabled(shift); +} + + +sub setBackEnabled { + this->{ui}->{bBack}->setEnabled(shift); +} + + +sub goNext { + debug frontend => "QTF: -- LEAVE EVENTLOOP --------"; + this->{frontend}->goback(0); + this->{frontend}->win->close; +} + + +sub goBack { + debug frontend => "QTF: -- LEAVE EVENTLOOP --------"; + this->{frontend}->goback(1); + this->{frontend}->win->close; +} + +sub setMainFrameLayout { + debug frontend => "QTF: -- SET MAIN LAYOUT --------"; + if(this->{ui}->mainFrame->layout) { + this->{ui}->mainFrame->layout->DESTROY; + } + this->{ui}->mainFrame->setLayout(shift); +} + + +sub goBye { + debug developer => "QTF: -- LEAVE EVENTLOOP --------"; + this->{frontend}->cancelled(1); + this->{frontend}->win->close; +} + + +1; diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm new file mode 100644 index 0000000..dfca0eb --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Noninteractive.pm @@ -0,0 +1,20 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Noninteractive; +use strict; +use base qw(Debconf::FrontEnd); + + + +sub init { + my $this=shift; + + $this->SUPER::init(@_); + + $this->need_tty(0); +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Passthrough.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Passthrough.pm new file mode 100644 index 0000000..96a3f0b --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Passthrough.pm @@ -0,0 +1,287 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Passthrough; +use strict; +use Carp; +use IO::Socket; +use IO::Handle; +use Debconf::FrontEnd; +use Debconf::Element; +use Debconf::Element::Select; +use Debconf::Element::Multiselect; +use Debconf::Log qw(:all); +use Debconf::Encoding; +use base qw(Debconf::FrontEnd); + +my ($READFD, $WRITEFD, $SOCKET); +if (defined $ENV{DEBCONF_PIPE}) { + $SOCKET = $ENV{DEBCONF_PIPE}; +} elsif (defined $ENV{DEBCONF_READFD} && defined $ENV{DEBCONF_WRITEFD}) { + $READFD = $ENV{DEBCONF_READFD}; + $WRITEFD = $ENV{DEBCONF_WRITEFD}; +} else { + die "Neither DEBCONF_PIPE nor DEBCONF_READFD and DEBCONF_WRITEFD were set\n"; +} + + +sub init { + my $this=shift; + + if (defined $SOCKET) { + $this->{readfh} = $this->{writefh} = IO::Socket::UNIX->new( + Type => SOCK_STREAM, + Peer => $SOCKET + ) || croak "Cannot connect to $SOCKET: $!"; + } else { + $this->{readfh} = IO::Handle->new_from_fd(int($READFD), "r") || croak "Failed to open fd $READFD: $!"; + $this->{writefh} = IO::Handle->new_from_fd(int($WRITEFD), "w") || croak "Failed to open fd $WRITEFD: $!"; + } + + binmode $this->{readfh}, ":utf8"; + binmode $this->{writefh}, ":utf8"; + + $this->{readfh}->autoflush(1); + $this->{writefh}->autoflush(1); + + $this->elements([]); + $this->interactive(1); + $this->need_tty(0); +} + + +sub talk { + my $this=shift; + my $command=join(' ', map { Debconf::Encoding::to_Unicode($_) } @_); + my $reply; + + my $readfh = $this->{readfh} || croak "Broken pipe"; + my $writefh = $this->{writefh} || croak "Broken pipe"; + + debug developer => "----> $command"; + print $writefh $command."\n"; + $writefh->flush; + $reply = <$readfh>; + chomp($reply); + debug developer => "<---- $reply"; + my ($tag, $val) = split(' ', $reply, 2); + $val = '' unless defined $val; + $val = Debconf::Encoding::convert("UTF-8", $val); + + return ($tag, $val) if wantarray; + return $tag; +} + + +sub makeelement +{ + my $this=shift; + my $question=shift; + + my $type=$question->type; + if ($type eq "select" || $type eq "multiselect") { + $type=ucfirst($type); + return "Debconf::Element::$type"->new(question => $question); + } else { + return Debconf::Element->new(question => $question); + } +} + + +sub capb_backup +{ + my $this=shift; + my $val = shift; + + $this->{capb_backup} = $val; + $this->talk('CAPB', 'backup') if $val; +} + + +sub capb +{ + my $this=shift; + my $ret; + return $this->{capb} if exists $this->{capb}; + + ($ret, $this->{capb}) = $this->talk('CAPB'); + return $this->{capb} if $ret eq '0'; +} + + +sub title +{ + my $this = shift; + return $this->{title} unless @_; + my $title = shift; + + $this->{title} = $title; + $this->talk('TITLE', $title); +} + + +sub settitle +{ + my $this = shift; + my $question = shift; + + $this->{title} = $question->description; + + my $tag = $question->template->template; + my $type = $question->template->type; + my $desc = $question->description; + my $extdesc = $question->extended_description; + + $this->talk('DATA', $tag, 'type', $type); + + if ($desc) { + $desc =~ s/\n/\\n/g; + $this->talk('DATA', $tag, 'description', $desc); + } + + if ($extdesc) { + $extdesc =~ s/\n/\\n/g; + $this->talk('DATA', $tag, 'extended_description', $extdesc); + } + + $this->talk('SETTITLE', $tag); +} + + +sub go { + my $this = shift; + + my @elements=grep $_->visible, @{$this->elements}; + foreach my $element (@elements) { + my $question = $element->question; + my $tag = $question->template->template; + my $type = $question->template->type; + my $desc = $question->description; + my $extdesc = $question->extended_description; + my $default; + if ($type eq 'select') { + $default = $element->translate_default; + } elsif ($type eq 'multiselect') { + $default = join ', ', $element->translate_default; + } else { + $default = $question->value; + } + + $this->talk('DATA', $tag, 'type', $type); + + if ($desc) { + $desc =~ s/\n/\\n/g; + $this->talk('DATA', $tag, 'description', $desc); + } + + if ($extdesc) { + $extdesc =~ s/\n/\\n/g; + $this->talk('DATA', $tag, 'extended_description', + $extdesc); + } + + if ($type eq "select" || $type eq "multiselect") { + my $choices = $question->choices; + $choices =~ s/\n/\\n/g if ($choices); + $this->talk('DATA', $tag, 'choices', $choices); + } + + $this->talk('SET', $tag, $default) if $default ne ''; + + my @vars=$Debconf::Db::config->variables($question->{name}); + for my $var (@vars) { + my $val=$Debconf::Db::config->getvariable($question->{name}, $var); + $val='' unless defined $val; + $this->talk('SUBST', $tag, $var, $val); + } + + $this->talk('INPUT', $question->priority, $tag); + } + + if (@elements && (scalar($this->talk('GO')) eq "30") && $this->{capb_backup}) { + return; + } + + foreach my $element (@{$this->elements}) { + if ($element->visible) { + my $tag = $element->question->template->template; + my $type = $element->question->template->type; + + my ($ret, $val)=$this->talk('GET', $tag); + if ($ret eq "0") { + if ($type eq 'select') { + $element->value($element->translate_to_C($val)); + } elsif ($type eq 'multiselect') { + $element->value(join(', ', map { $element->translate_to_C($_) } split(', ', $val))); + } else { + $element->value($val); + } + debug developer => "Got \"$val\" for $tag"; + } + } else { + $element->show; + } + } + + return 1; +} + + +sub progress_data { + my $this=shift; + my $question=shift; + + my $tag=$question->template->template; + my $type=$question->template->type; + my $desc=$question->description; + my $extdesc=$question->extended_description; + + $this->talk('DATA', $tag, 'type', $type); + + if ($desc) { + $desc =~ s/\n/\\n/g; + $this->talk('DATA', $tag, 'description', $desc); + } + + if ($extdesc) { + $extdesc =~ s/\n/\\n/g; + $this->talk('DATA', $tag, 'extended_description', $extdesc); + } +} + +sub progress_start { + my $this=shift; + + $this->progress_data($_[2]); + return $this->talk('PROGRESS', 'START', $_[0], $_[1], $_[2]->template->template); +} + +sub progress_set { + my $this=shift; + + return (scalar($this->talk('PROGRESS', 'SET', $_[0])) ne "30"); +} + +sub progress_step { + my $this=shift; + + return (scalar($this->talk('PROGRESS', 'STEP', $_[0])) ne "30"); +} + +sub progress_info { + my $this=shift; + + $this->progress_data($_[0]); + return (scalar($this->talk('PROGRESS', 'INFO', $_[0]->template->template)) ne "30"); +} + +sub progress_stop { + my $this=shift; + + return $this->talk('PROGRESS', 'STOP'); +} + + +1 + diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Readline.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Readline.pm new file mode 100644 index 0000000..44ab74e --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Readline.pm @@ -0,0 +1,164 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Readline; +use strict; +use Term::ReadLine; +use Debconf::Gettext; +use base qw(Debconf::FrontEnd::Teletype); + + +sub init { + my $this=shift; + + $this->SUPER::init(@_); + + open(TESTTY, "/dev/tty") || die gettext("This frontend requires a controlling tty.")."\n"; + close TESTTY; + + $Term::ReadLine::termcap_nowarn = 1; # Turn off stupid termcap warning. + $this->readline(Term::ReadLine->new('debconf')); + $this->readline->ornaments(1); + + if (Term::ReadLine->ReadLine =~ /::Gnu$/) { + if (exists $ENV{TERM} && $ENV{TERM} =~ /emacs/i) { + die gettext("Term::ReadLine::GNU is incompatable with emacs shell buffers.")."\n"; + } + + $this->readline->add_defun('previous-question', + sub { + if ($this->capb_backup) { + $this->_skip(1); + $this->_direction(-1); + $this->readline->stuff_char(ord "\n"); + } + else { + $this->readline->ding; + } + }, ord "\cu"); + $this->readline->add_defun('next-question', + sub { + if ($this->capb_backup) { + $this->readline->stuff_char(ord "\n"); + } + }, ord "\cv"); + $this->readline->parse_and_bind('"\e[5~": previous-question'); + $this->readline->parse_and_bind('"\e[6~": next-question'); + $this->capb('backup'); + } + + if (Term::ReadLine->ReadLine =~ /::Stub$/) { + $this->promptdefault(1); + } +} + + +sub elementtype { + return 'Teletype'; +} + + +sub go { + my $this=shift; + + foreach my $element (grep ! $_->visible, @{$this->elements}) { + my $value=$element->show; + return if $this->backup && $this->capb_backup; + $element->question->value($value); + } + + my @elements=grep $_->visible, @{$this->elements}; + unless (@elements) { + $this->_didbackup(''); + return 1; + } + + my $current=$this->_didbackup ? $#elements : 0; + + $this->_direction(1); + for (; $current > -1 && $current < @elements; $current += $this->_direction) { + my $value=$elements[$current]->show; + } + + if ($current < 0) { + $this->_didbackup(1); + return; + } + else { + $this->_didbackup(''); + return 1; + } +} + + +sub prompt { + my $this=shift; + my %params=@_; + my $prompt=$params{prompt}." "; + my $default=$params{default}; + my $noshowdefault=$params{noshowdefault}; + my $completions=$params{completions}; + + if ($completions) { + my @matches; + $this->readline->Attribs->{completion_entry_function} = sub { + my $text=shift; + my $state=shift; + + if ($state == 0) { + @matches=(); + foreach (@{$completions}) { + push @matches, $_ if /^\Q$text\E/i; + } + } + + return pop @matches; + }; + } + else { + $this->readline->Attribs->{completion_entry_function} = undef; + } + + if (exists $params{completion_append_character}) { + $this->readline->Attribs->{completion_append_character}=$params{completion_append_character}; + } + else { + $this->readline->Attribs->{completion_append_character}=''; + } + + $this->linecount(0); + my $ret; + $this->_skip(0); + if (! $noshowdefault) { + $ret=$this->readline->readline($prompt, $default); + } + else { + $ret=$this->readline->readline($prompt); + } + $this->display_nowrap("\n"); + return if $this->_skip; + $this->_direction(1); + $this->readline->addhistory($ret); + return $ret; +} + + +sub prompt_password { + my $this=shift; + my %params=@_; + + if (Term::ReadLine->ReadLine =~ /::Perl$/) { + return $this->SUPER::prompt_password(%params); + } + + delete $params{default}; + system('stty -echo 2>/dev/null'); + my $ret=$this->prompt(@_, noshowdefault => 1, completions => []); + system('stty sane 2>/dev/null'); + print "\n"; + return $ret; +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/ScreenSize.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/ScreenSize.pm new file mode 100644 index 0000000..4bef3a7 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/ScreenSize.pm @@ -0,0 +1,54 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::ScreenSize; +use strict; +use Debconf::Gettext; +use base qw(Debconf::FrontEnd); + + +sub init { + my $this=shift; + + $this->SUPER::init(@_); + + $this->resize; # Get current screen size. + $SIG{WINCH}=sub { + if (defined $this) { + $this->resize; + } + }; +} + + +sub resize { + my $this=shift; + + if (exists $ENV{LINES}) { + $this->screenheight($ENV{'LINES'}); + $this->screenheight_guessed(0); + } + else { + my ($rows)=`stty -a 2>/dev/null` =~ m/rows (\d+)/s; + if ($rows) { + $this->screenheight($rows); + $this->screenheight_guessed(0); + } + else { + $this->screenheight(25); + $this->screenheight_guessed(1); + } + } + + if (exists $ENV{COLUMNS}) { + $this->screenwidth($ENV{'COLUMNS'}); + } + else { + my ($cols)=`stty -a 2>/dev/null` =~ m/columns (\d+)/s; + $this->screenwidth($cols || 80); + } +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Teletype.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Teletype.pm new file mode 100644 index 0000000..9684411 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Teletype.pm @@ -0,0 +1,89 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Teletype; +use strict; +use Debconf::Encoding qw(width wrap); +use Debconf::Gettext; +use Debconf::Config; +use base qw(Debconf::FrontEnd::ScreenSize); + + +sub init { + my $this=shift; + + $this->SUPER::init(@_); + $this->interactive(1); + $this->linecount(0); +} + + +sub display { + my $this=shift; + my $text=shift; + + $Debconf::Encoding::columns=$this->screenwidth; + $this->display_nowrap(wrap('','',$text)); +} + + +sub display_nowrap { + my $this=shift; + my $text=shift; + + return if Debconf::Config->terse eq 'true'; + + my @lines=split(/\n/, $text); + push @lines, "" if $text=~/\n$/; + + my $title=$this->title; + if (length $title) { + unshift @lines, $title, ('-' x width $title), ''; + $this->title(''); + } + + foreach (@lines) { + if (! $this->screenheight_guessed && + $this->linecount($this->linecount+1) > $this->screenheight - 2) { + my $resp=$this->prompt( + prompt => '['.gettext("More").']', + default => '', + completions => [], + ); + if (defined $resp && $resp eq 'q') { + last; + } + } + print "$_\n"; + } +} + + +sub prompt { + my $this=shift; + my %params=@_; + + $this->linecount(0); + local $|=1; + print "$params{prompt} "; + my $ret=<STDIN>; + chomp $ret if defined $ret; + $this->display_nowrap("\n"); + return $ret; +} + + +sub prompt_password { + my $this=shift; + my %params=@_; + + delete $params{default}; + system('stty -echo 2>/dev/null'); + my $ret=$this->Debconf::FrontEnd::Teletype::prompt(%params); + system('stty sane 2>/dev/null'); + return $ret; +} + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Text.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Text.pm new file mode 100644 index 0000000..fe25981 --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Text.pm @@ -0,0 +1,10 @@ +#!/usr/bin/perl -w +# This file was preprocessed, do not edit! + + +package Debconf::FrontEnd::Text; +use strict; +use base qw(Debconf::FrontEnd::Readline); + + +1 diff --git a/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm new file mode 100644 index 0000000..bb2caff --- /dev/null +++ b/beagle/debian-rfs/usr/share/perl5/Debconf/FrontEnd/Web.pm @@ -0,0 +1,137 @@ +#!/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 |
