home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Debconf / FrontEnd / Readline.pm < prev    next >
Encoding:
Perl POD Document  |  2006-07-24  |  3.4 KB  |  165 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::FrontEnd::Readline;
  6. use strict;
  7. use Term::ReadLine;
  8. use Debconf::Gettext;
  9. use base qw(Debconf::FrontEnd::Teletype);
  10.  
  11.  
  12. sub init {
  13.     my $this=shift;
  14.  
  15.     $this->SUPER::init(@_);
  16.  
  17.     open(TESTTY, "/dev/tty") || die gettext("This frontend requires a controlling tty.")."\n";
  18.     close TESTTY;
  19.  
  20.     $Term::ReadLine::termcap_nowarn = 1; # Turn off stupid termcap warning.
  21.     $this->readline(Term::ReadLine->new('debconf'));
  22.     $this->readline->ornaments(1);
  23.  
  24.     if (Term::ReadLine->ReadLine =~ /::Gnu$/) {
  25.         if ($ENV{TERM} =~ /emacs/i) {
  26.             die gettext("Term::ReadLine::GNU is incompatable with emacs shell buffers.")."\n";
  27.         }
  28.         
  29.         $this->readline->add_defun('previous-question',    
  30.             sub {
  31.                 if ($this->capb_backup) {
  32.                     $this->_skip(1);
  33.                     $this->_direction(-1);
  34.                     $this->readline->stuff_char(ord "\n");
  35.                 }
  36.                 else {
  37.                     $this->readline->ding;
  38.                 }
  39.             }, ord "\cu");
  40.         $this->readline->add_defun('next-question',
  41.             sub {
  42.                 if ($this->capb_backup) {
  43.                     $this->readline->stuff_char(ord "\n");
  44.                 }
  45.             }, ord "\cv");
  46.         $this->readline->parse_and_bind('"\e[5~": previous-question');
  47.         $this->readline->parse_and_bind('"\e[6~": next-question');
  48.         $this->capb('backup');
  49.     }
  50.     
  51.     if (Term::ReadLine->ReadLine =~ /::Stub$/) {
  52.         $this->promptdefault(1);
  53.     }
  54. }
  55.  
  56.  
  57. sub elementtype {
  58.     return 'Teletype';
  59. }
  60.  
  61.  
  62. sub go {
  63.     my $this=shift;
  64.  
  65.     foreach my $element (grep ! $_->visible, @{$this->elements}) {
  66.         my $value=$element->show;
  67.         return if $this->backup && $this->capb_backup;
  68.         $element->question->value($value);
  69.     }
  70.  
  71.     my @elements=grep $_->visible, @{$this->elements};
  72.     unless (@elements) {
  73.         $this->_didbackup('');
  74.         return 1;
  75.     }
  76.  
  77.     my $current=$this->_didbackup ? $#elements : 0;
  78.  
  79.     $this->_direction(1);
  80.     for (; $current > -1 && $current < @elements; $current += $this->_direction) {
  81.         my $value=$elements[$current]->show;
  82.     }
  83.  
  84.     if ($current < 0) {
  85.         $this->_didbackup(1);
  86.         return;
  87.     }
  88.     else {
  89.         $this->_didbackup('');
  90.         return 1;
  91.     }
  92. }
  93.  
  94.  
  95. sub prompt {
  96.     my $this=shift;
  97.     my %params=@_;
  98.     my $prompt=$params{prompt}." ";
  99.     my $default=$params{default};
  100.     my $noshowdefault=$params{noshowdefault};
  101.     my $completions=$params{completions};
  102.  
  103.     if ($completions) {
  104.         my @matches;
  105.         $this->readline->Attribs->{completion_entry_function} = sub {
  106.             my $text=shift;
  107.             my $state=shift;
  108.             
  109.             if ($state == 0) {
  110.                 @matches=();
  111.                 foreach (@{$completions}) {
  112.                     push @matches, $_ if /^\Q$text\E/i;
  113.                 }
  114.             }
  115.  
  116.             return pop @matches;
  117.         };
  118.     }
  119.     else {
  120.         $this->readline->Attribs->{completion_entry_function} = undef;
  121.     }
  122.  
  123.     if (exists $params{completion_append_character}) {
  124.         $this->readline->Attribs->{completion_append_character}=$params{completion_append_character};
  125.     }
  126.     else {
  127.         $this->readline->Attribs->{completion_append_character}='';
  128.     }
  129.     
  130.     $this->linecount(0);
  131.     my $ret;
  132.     $this->_skip(0);
  133.     if (! $noshowdefault) {
  134.         $ret=$this->readline->readline($prompt, $default);
  135.     }
  136.     else {
  137.         $ret=$this->readline->readline($prompt);
  138.     }
  139.     $this->display_nowrap("\n");
  140.     return if $this->_skip;
  141.     $this->_direction(1);
  142.     $this->readline->addhistory($ret);
  143.     return $ret;
  144. }
  145.  
  146.  
  147. sub prompt_password {
  148.     my $this=shift;
  149.     my %params=@_;
  150.  
  151.     if (Term::ReadLine->ReadLine =~ /::Perl$/) {
  152.         return $this->SUPER::prompt_password(%params);
  153.     }
  154.     
  155.     delete $params{default};
  156.     system('stty -echo 2>/dev/null');
  157.     my $ret=$this->prompt(@_, noshowdefault => 1, completions => []);
  158.     system('stty sane 2>/dev/null');
  159.     print "\n";
  160.     return $ret;
  161. }
  162.  
  163.  
  164. 1
  165.