home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debconf / FrontEnd / Dialog.pm next >
Encoding:
Perl POD Document  |  2006-07-24  |  7.0 KB  |  308 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::FrontEnd::Dialog;
  6. use strict;
  7. use Debconf::Gettext;
  8. use Debconf::Priority;
  9. use Debconf::TmpFile;
  10. use Debconf::Log qw(:all);
  11. use Debconf::Encoding qw(wrap $columns width);
  12. use IPC::Open3;
  13. use POSIX;
  14. use Fcntl;
  15. use base qw(Debconf::FrontEnd::ScreenSize);
  16.  
  17.  
  18. sub init {
  19.     my $this=shift;
  20.  
  21.     $this->SUPER::init(@_);
  22.  
  23.     delete $ENV{POSIXLY_CORRECT} if exists $ENV{POSIXLY_CORRECT};
  24.     delete $ENV{POSIX_ME_HARDER} if exists $ENV{POSIX_ME_HARDER};
  25.     
  26.     if (! exists $ENV{TERM} || ! defined $ENV{TERM} || $ENV{TERM} eq '') { 
  27.         die gettext("TERM is not set, so the dialog frontend is not usable.")."\n";
  28.     }
  29.     elsif ($ENV{TERM} =~ /emacs/i) {
  30.         die gettext("Dialog frontend is incompatible with emacs shell buffers")."\n";
  31.     }
  32.     elsif ($ENV{TERM} eq 'dumb' || $ENV{TERM} eq 'unknown') {
  33.         die gettext("Dialog frontend will not work on a dumb terminal, an emacs shell buffer, or without a controlling terminal.")."\n";
  34.     }
  35.     
  36.     $this->interactive(1);
  37.     $this->capb('backup');
  38.  
  39.     if (-x "/usr/bin/whiptail" && 
  40.         (! defined $ENV{DEBCONF_FORCE_DIALOG} || ! -x "/usr/bin/dialog") &&
  41.         (! defined $ENV{DEBCONF_FORCE_XDIALOG} || ! -x "/usr/bin/Xdialog")) {
  42.         $this->program('whiptail');
  43.         $this->dashsep('--');
  44.         $this->borderwidth(5);
  45.         $this->borderheight(6);
  46.         $this->spacer(1);
  47.         $this->titlespacer(10);
  48.         $this->columnspacer(3);
  49.         $this->selectspacer(9);
  50.         $this->hasoutputfd(1);
  51.     }
  52.     elsif (-x "/usr/bin/dialog" &&
  53.            (! defined $ENV{DEBCONF_FORCE_XDIALOG} || ! -x "/usr/bin/Xdialog")) {
  54.         $this->program('dialog');
  55.         $this->dashsep(''); # dialog does not need (or support) 
  56.         $this->borderwidth(7);
  57.         $this->borderheight(6);
  58.         $this->spacer(0);
  59.         $this->titlespacer(4);
  60.         $this->columnspacer(2);
  61.         $this->selectspacer(0);
  62.         $this->hasoutputfd(1);
  63.     }
  64.     elsif (-x "/usr/bin/Xdialog" && defined $ENV{DISPLAY}) {
  65.         $this->program("Xdialog");
  66.         $this->borderwidth(7);
  67.         $this->borderheight(20);
  68.         $this->spacer(0);
  69.         $this->titlespacer(10);
  70.         $this->selectspacer(0);
  71.         $this->columnspacer(2);
  72.         $this->screenheight(200);
  73.     }
  74.     else {
  75.         die gettext("No usable dialog-like program is installed, so the dialog based frontend cannot be used.");
  76.     }
  77.  
  78.     if ($this->screenheight < 13 || $this->screenwidth < 31) {
  79.         die gettext("Dialog frontend requires a screen at least 13 lines tall and 31 columns wide.")."\n";
  80.     }
  81. }
  82.  
  83.  
  84. sub sizetext {
  85.     my $this=shift;
  86.     my $text=shift;
  87.     
  88.     $columns = $this->screenwidth - $this->borderwidth - $this->columnspacer;
  89.     $text=wrap('', '', $text);
  90.     my @lines=split(/\n/, $text);
  91.     
  92.     my $window_columns=width($this->title) + $this->titlespacer;
  93.     map {
  94.         my $w=width($_);
  95.         $window_columns = $w if $w > $window_columns;
  96.     } @lines;
  97.     
  98.     return $text, $#lines + 1 + $this->borderheight,
  99.            $window_columns + $this->borderwidth;
  100. }
  101.  
  102.  
  103. sub showtext {
  104.     my $this=shift;
  105.     my $question=shift;
  106.     my $intext=shift;
  107.  
  108.     my $lines = $this->screenheight;
  109.     my ($text, $height, $width)=$this->sizetext($intext);
  110.  
  111.     my @lines = split(/\n/, $text);
  112.     my $num;
  113.     my @args=('--msgbox', join("\n", @lines));
  114.     if ($lines - 4 - $this->borderheight <= $#lines) {
  115.         $num=$lines - 4 - $this->borderheight;
  116.         if ($this->program eq 'whiptail') {
  117.             push @args, '--scrolltext';
  118.         }
  119.         else {
  120.             my $fh=Debconf::TmpFile::open();
  121.             print $fh join("\n", @lines);
  122.             close $fh;
  123.             @args=("--textbox", Debconf::TmpFile::filename());
  124.         }
  125.     }
  126.     else {
  127.         $num=$#lines + 1;
  128.     }
  129.     $this->showdialog($question, @args, $num + $this->borderheight, $width);
  130.     if ($args[0] eq '--textbox') {
  131.         Debconf::TmpFile::cleanup();
  132.     }
  133. }
  134.  
  135.  
  136. sub makeprompt {
  137.     my $this=shift;
  138.     my $question=shift;
  139.     my $freelines=$this->screenheight - $this->borderheight + 1;
  140.     $freelines += shift if @_;
  141.  
  142.     my ($text, $lines, $columns)=$this->sizetext(
  143.         $question->extended_description."\n\n".
  144.         $question->description
  145.     );
  146.     
  147.     if ($lines > $freelines) {
  148.         $this->showtext($question, $question->extended_description);
  149.         ($text, $lines, $columns)=$this->sizetext($question->description);
  150.     }
  151.     
  152.     return ($text, $lines, $columns);
  153. }
  154.  
  155. sub startdialog {
  156.     my $this=shift;
  157.     my $question=shift;
  158.     my $wantinputfd=shift;
  159.     
  160.     debug debug => "preparing to run dialog. Params are:" ,
  161.         join(",", $this->program, @_);
  162.  
  163.     use vars qw{*SAVEOUT *SAVEIN};
  164.     open(SAVEOUT, ">&STDOUT") || die $!;
  165.     $this->dialog_saveout(\*SAVEOUT);
  166.     if ($wantinputfd) {
  167.         $this->dialog_savein(undef);
  168.     } else {
  169.         open(SAVEIN, "<&STDIN") || die $!;
  170.         $this->dialog_savein(\*SAVEIN);
  171.     }
  172.  
  173.     $this->dialog_savew($^W);
  174.     $^W=0;
  175.     
  176.     unless ($this->capb_backup || grep { $_ eq '--defaultno' } @_) {
  177.         if ($this->program ne 'Xdialog') {
  178.             unshift @_, '--nocancel';
  179.         }
  180.         else {
  181.             unshift @_, '--no-cancel';
  182.         }
  183.     }
  184.  
  185.     if ($this->program eq 'Xdialog' && $_[0] eq '--passwordbox') {
  186.         $_[0]='--password --inputbox'
  187.     }
  188.     
  189.     use vars qw{*OUTPUT_RDR *OUTPUT_WTR};
  190.     if ($this->hasoutputfd) {
  191.         pipe(OUTPUT_RDR, OUTPUT_WTR) || die "pipe: $!";
  192.         my $flags=fcntl(\*OUTPUT_WTR, F_GETFD, 0);
  193.         fcntl(\*OUTPUT_WTR, F_SETFD, $flags & ~FD_CLOEXEC);
  194.         $this->dialog_output_rdr(\*OUTPUT_RDR);
  195.         unshift @_, "--output-fd", fileno(\*OUTPUT_WTR);
  196.     }
  197.     
  198.     my $backtitle='';
  199.     if (defined $this->info) {
  200.         $backtitle = $this->info->description;
  201.     } else {
  202.         $backtitle = gettext("Ubuntu Configuration");
  203.     }
  204.  
  205.     use vars qw{*INPUT_RDR *INPUT_WTR};
  206.     if ($wantinputfd) {
  207.         pipe(INPUT_RDR, INPUT_WTR) || die "pipe: $!";
  208.         autoflush INPUT_WTR 1;
  209.         my $flags=fcntl(\*INPUT_RDR, F_GETFD, 0);
  210.         fcntl(\*INPUT_RDR, F_SETFD, $flags & ~FD_CLOEXEC);
  211.         $this->dialog_input_wtr(\*INPUT_WTR);
  212.     } else {
  213.         $this->dialog_input_wtr(undef);
  214.     }
  215.  
  216.     use vars qw{*ERRFH};
  217.     my $pid = open3($wantinputfd ? '<&INPUT_RDR' : '<&STDIN', '>&STDOUT',
  218.         \*ERRFH, $this->program,
  219.         '--backtitle', $backtitle,
  220.         '--title', $this->title, @_);
  221.     $this->dialog_errfh(\*ERRFH);
  222.     $this->dialog_pid($pid);
  223.     close OUTPUT_WTR if $this->hasoutputfd;
  224. }
  225.  
  226. sub waitdialog {
  227.     my $this=shift;
  228.  
  229.     my $input_wtr=$this->dialog_input_wtr;
  230.     if ($input_wtr) {
  231.         close $input_wtr;
  232.     }
  233.     my $output_rdr=$this->dialog_output_rdr;
  234.     my $errfh=$this->dialog_errfh;
  235.     my $output='';
  236.     if ($this->hasoutputfd) {
  237.         while (<$output_rdr>) {
  238.             $output.=$_;
  239.         }
  240.         my $error=0;
  241.         while (<$errfh>) {
  242.             print STDERR $_;
  243.             $error++;
  244.         }
  245.         if ($error) {
  246.             die sprintf("debconf: %s output to the above errors, giving up!", $this->program)."\n";
  247.         }
  248.     }
  249.     else {
  250.         while (<$errfh>) { # ugh
  251.             $output.=$_;
  252.         }
  253.     }
  254.     chomp $output;
  255.  
  256.     waitpid($this->dialog_pid, 0);
  257.     $^W=$this->dialog_savew;
  258.  
  259.     if (defined $this->dialog_savein) {
  260.         open(STDIN, '<&', $this->dialog_savein) || die $!;
  261.     }
  262.     open(STDOUT, '>&', $this->dialog_saveout) || die $!;
  263.  
  264.     my $ret=$? >> 8;
  265.     if ($ret == 255 || ($ret == 1 && join(' ', @_) !~ m/--yesno\s/)) {
  266.         $this->backup(1);
  267.         return undef;
  268.     }
  269.  
  270.     if (wantarray) {
  271.         return $ret, $output;
  272.     }
  273.     else {
  274.         return $output;
  275.     }
  276. }
  277.  
  278.  
  279. sub showdialog {
  280.     my $this=shift;
  281.     my $question=shift;
  282.  
  283.     if (defined $this->progress_bar) {
  284.         $this->progress_bar->stop;
  285.     }
  286.  
  287.     $this->startdialog($question, 0, @_);
  288.     my (@ret, $ret);
  289.     if (wantarray) {
  290.         @ret=$this->waitdialog(@_);
  291.     } else {
  292.         $ret=$this->waitdialog(@_);
  293.     }
  294.  
  295.     if (defined $this->progress_bar) {
  296.         $this->progress_bar->start;
  297.     }
  298.  
  299.     if (wantarray) {
  300.         return @ret;
  301.     } else {
  302.         return $ret;
  303.     }
  304. }
  305.  
  306.  
  307. 1
  308.