home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / interactive.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  3.8 KB  |  196 lines
  1. package interactive;
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.  
  9. use common qw(:common :functional);
  10.  
  11.  
  12.  
  13.  
  14.  
  15.  
  16.  
  17.  
  18.  
  19.  
  20.  
  21.  
  22.  
  23.  
  24.  
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35. sub new($) {
  36.     my ($type) = @_;
  37.  
  38.     bless {}, ref $type || $type;
  39. }
  40.  
  41. sub vnew {
  42.     my ($type, $su) = @_;
  43.     $su = $su eq "su";
  44.     require c;
  45.     if ($ENV{DISPLAY} && c::Xtest($ENV{DISPLAY})) {
  46.     if ($su) {
  47.         $ENV{PATH} = "/sbin:/usr/sbin:$ENV{PATH}";
  48.         $> and exec "kdesu", "-c", "$0 @ARGV";        
  49.     }
  50.     require interactive_gtk;
  51.     interactive_gtk->new;
  52.     } else {
  53.     if ($su && $>) {
  54.         die "you must be root to run this program";
  55.     }
  56.     require 'log.pm';
  57.     undef *log::l;
  58.     *log::l = sub {}; # otherwise, it will bother us :(
  59.     require interactive_newt;
  60.     interactive_newt->new;
  61.     }
  62. }
  63.  
  64. sub suspend {}
  65. sub resume {}
  66. sub end {}
  67. sub exit { exit($_[0]) }
  68.  
  69.  
  70.  
  71.  
  72. sub ask_warn($$$) {
  73.     my ($o, $title, $message) = @_;
  74.     ask_from_list2($o, $title, $message, [ _("Ok") ]);
  75. }
  76.  
  77. sub ask_yesorno($$$;$) {
  78.     my ($o, $title, $message, $def) = @_;
  79.     ask_from_list2_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "Yes" : "No") eq "Yes";
  80. }
  81.  
  82. sub ask_okcancel($$$;$) {
  83.     my ($o, $title, $message, $def) = @_;
  84.     ask_from_list2_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Ok" : "Cancel") eq "Ok";
  85. }
  86.  
  87. sub ask_from_list_ {
  88.     my ($o, $title, $message, $l, $def) = @_;
  89.     @$l == 0 and die '';
  90.     @$l == 1 and return $l->[0];
  91.     goto &ask_from_list2_;
  92. }
  93.  
  94. sub ask_from_list {
  95.     my ($o, $title, $message, $l, $def) = @_;
  96.     @$l == 0 and die '';
  97.     @$l == 1 and return $l->[0];
  98.     goto &ask_from_list2;
  99. }
  100.  
  101. sub ask_from_list2_($$$$;$) {
  102.     my ($o, $title, $message, $l, $def) = @_;
  103.     untranslate(
  104.        ask_from_list($o, $title, $message, [ map { translate($_) } @$l ], translate($def)),
  105.        @$l);
  106. }
  107.  
  108. sub ask_from_list2($$$$;$) {
  109.     my ($o, $title, $message, $l, $def) = @_;
  110.  
  111.     @$l > 10 and $l = [ sort @$l ];
  112.  
  113.     $o->ask_from_listW($title, [ deref($message) ], $l, $def || $l->[0]);
  114. }
  115. sub ask_many_from_list_ref($$$$;$) {
  116.     my ($o, $title, $message, $l, $val) = @_;
  117.     return 1 if @$l == 0;
  118.     $o->ask_many_from_list_refW($title, [ deref($message) ], $l, $val);
  119. }
  120. sub ask_many_from_list($$$$;$) {
  121.     my ($o, $title, $message, $l, $def) = @_;
  122.  
  123.     my $val = [ map { my $i = $_; \$i } @$def ];
  124.  
  125.     $o->ask_many_from_list_ref($title, $message, $l, $val) ?
  126.       [ map { $$_ } @$val ] : undef;
  127. }
  128.  
  129. sub ask_from_entry {
  130.     my ($o, $title, $message, $label, $def, %callback) = @_;
  131.  
  132.     first ($o->ask_from_entries($title, [ deref($message) ], [ $label ], [ $def ], %callback));
  133. }
  134.  
  135. sub ask_from_entries($$$$;$%) {
  136.     my ($o, $title, $message, $l, $def, %callback) = @_;
  137.  
  138.     my $val = [ map { my $i = $_; \$i } @{$def || [('') x @$l]} ];
  139.  
  140.     $o->ask_from_entries_ref($title, $message, $l, $val, %callback) ?
  141.       map { $$_ } @$val :
  142.       undef;
  143. }
  144.  
  145. sub ask_from_entries_refH($$$;$%) {
  146.     my ($o, $title, $message, $h, %callback) = @_;
  147.  
  148.     ask_from_entries_ref($o, $title, $message, 
  149.              [ grep_index { even($::i) } @$h ],
  150.              [ grep_index {  odd($::i) } @$h ], 
  151.              %callback);    
  152. }
  153.  
  154.  
  155.  
  156.  
  157. sub ask_from_entries_ref($$$$;$%) {
  158.     my ($o, $title, $message, $l, $val, %callback) = @_;
  159.  
  160.     return unless @$l;
  161.  
  162.     $title = [ deref($title) ];
  163.     $title->[2] ||= _("Cancel") unless $title->[1];
  164.     $title->[1] ||= _("Ok");
  165.  
  166.     my $val_hash = [ map {
  167.     if ((ref $_) eq "SCALAR") {
  168.         { val => $_ }
  169.     } else {
  170.         ($_->{list} && (@{$_->{list}} > 1)) ?
  171.           { %$_, type => "list"} : $_;
  172.     }
  173.     } @$val ];
  174.  
  175.     $o->ask_from_entries_refW($title, [ deref($message) ], $l, $val_hash, %callback)
  176.  
  177. }
  178. sub wait_message($$$;$) {
  179.     my ($o, $title, $message, $temp) = @_;
  180.  
  181.     my $w = $o->wait_messageW($title, [ _("Please wait"), deref($message) ]);
  182.     push @tempory::objects, $w if $temp;
  183.     my $b = before_leaving { $o->wait_message_endW($w) };
  184.  
  185.     
  186.     common::add_f4before_leaving(sub { $o->wait_message_nextW([ deref($_[1]) ], $w) }, $b, 'set');
  187.     $b;
  188. }
  189.  
  190. sub kill {}
  191.  
  192.  
  193.  
  194.  
  195. 1;
  196.