home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / interactive_stdio.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  2.0 KB  |  97 lines
  1. package interactive_stdio;
  2.  
  3.  
  4.  
  5.  
  6.  
  7. @ISA = qw(interactive);
  8.  
  9. use interactive;
  10. use common qw(:common);
  11.  
  12. $| = 1;
  13.  
  14. sub readln {
  15.     my $l = <STDIN>;
  16.     chomp $l;
  17.     $l;
  18. }
  19.  
  20. sub check_it {
  21.     my ($i, $n) = @_;
  22.     $i =~ /^\s*\d+\s*$/ && 1 <= $i && $i <= $n
  23. }
  24.  
  25. sub ask_from_listW {
  26.     my ($o, $title_, $messages, $list, $def) = @_;
  27.     my ($title, @okcancel) = ref $title_ ? @$title_ : ($title_, _("Ok"), _("Cancel"));
  28.     print map { "$_\n" } @$messages;
  29.     my $i;
  30.  
  31.     if (@$list < 10 && sum(map { length $_ } @$list) < 50) {
  32.     my @l;
  33.     do {
  34.         if (defined $i) {
  35.         @l ? print _("Ambiguity (%s), be more precise\n", join(", ", @l)) :
  36.              print _("Bad choice, try again\n");
  37.         }
  38.         @$list == 1 ? print @$list :
  39.                       print join("/", @$list), _(" ? (default %s) ", $def);
  40.         $i = readln() || $def;
  41.         @l = grep { /^$i/ } @$list;
  42.     } until (@l == 1);
  43.     $l[0];
  44.     } else {
  45.     my $n = 0; foreach (@$list) {
  46.         $n++;
  47.         $def eq $_ and $def = $n;
  48.         print "$n: $_\n";
  49.     }
  50.     do {
  51.         defined $i and print _("Bad choice, try again\n");
  52.         print _("Your choice? (default %s) ", $def);
  53.         $i = readln() || $def;
  54.     } until (check_it($i, $n));
  55.     $list->[$i - 1];
  56.     }
  57. }
  58.  
  59. sub ask_many_from_list_refW {
  60.     my ($o, $title, $messages, $list, $val) = @_;
  61.     my @defaults;
  62.     print map { "$_\n" } @$messages;
  63.     my $n = 0; foreach (@$list) {
  64.     $n++;
  65.     print "$n: $_\n";
  66.     push @defaults, $n if ${$val->[$n - 1]};
  67.     }
  68.     my $i;
  69.     TRY_AGAIN:
  70.     defined $i and print _("Bad choice, try again\n");
  71.     print _("Your choice? (default %s  enter `none' for none) ", join(',', @defaults));
  72.     $i = readln();
  73.     my @t = split ',', $i;
  74.     if ($i =~ /^none$/i) {
  75.     @t = ();
  76.     } else {
  77.     foreach (@t) { check_it($_, $n) or goto TRY_AGAIN }
  78.     }
  79.  
  80.     $$_ = 0 foreach @$val;
  81.     ${$val->[$_ - 1]} = 1 foreach @t;
  82.     $val;
  83. }
  84.  
  85. sub wait_messageW {
  86.     my ($o, $title, $message) = @_;
  87.     print join "\n", @$message;
  88. }
  89. sub wait_message_nextW { 
  90.     my $m = join "\n", @{$_[1]};
  91.     print "\r$m", ' ' x (60 - length $m);
  92. }
  93. sub wait_message_endW { print "\nDone\n" }
  94.  
  95. 1;
  96.  
  97.