home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / boot / i386 / root / usr / lib / YaST2 / servers_non_y2 / ag_tty < prev    next >
Encoding:
Text File  |  2006-11-29  |  3.8 KB  |  180 lines
  1. #!/usr/bin/perl -w
  2. #
  3. # $Id: ag_tty 25985 2005-10-24 16:23:37Z lslezak $
  4. # Author: Martin Vidner <mvidner@suse.cz>
  5. #         Stanislav Visnovsky <visnov@suse.cz>
  6. #
  7.  
  8. # An agent for /dev/tty using Perl readline library
  9.  
  10. use ycp;
  11. use strict;
  12. use Term::ReadLine;
  13.  
  14. use Encode;
  15.  
  16. # query the current encoding
  17. use I18N::Langinfo qw(langinfo CODESET);
  18. my $codeset = langinfo(CODESET());
  19.  
  20. sub ReadString($$) {
  21.     my ($term,$prompt) = @_;
  22.  
  23.     # the 1 prevents returning strings as integers/booleans
  24.     $_ = $term->readline($prompt);
  25.     if( defined ($_) )
  26.     {
  27.     ycp::Return ($_, 1);
  28.     }
  29.     else
  30.     {
  31.     ycp::Return (undef);
  32.     }
  33. }
  34.  
  35. sub ReadStringNoHistory($$)
  36. {
  37.     my ($term,$prompt) = @_;
  38.     # get current minimun line size for history, disable history
  39.     my $min_line = $term->MinLine(undef);
  40.  
  41.     # read input
  42.     ReadString($term, $prompt);
  43.  
  44.     # reenable history - set previous state
  45.     $term->MinLine($min_line);
  46. }
  47.  
  48.  
  49. sub ReadStringNoEcho($$)
  50. {
  51.     my ($term,$prompt) = @_;
  52.  
  53.     # disable echo
  54.     system("/bin/stty -F /dev/tty -echo");
  55.  
  56.     # read input
  57.     ReadStringNoHistory($term, $prompt);
  58.  
  59.     # reenable echo
  60.     system("/bin/stty -F /dev/tty echo");
  61.  
  62.     # new line
  63.     my $OUT = $term->OUT || \*STDOUT;
  64.     print $OUT "\n";
  65. }
  66.  
  67. #
  68. # MAIN cycle
  69. #
  70.  
  71. # read the agent arguments
  72. $_ = <STDIN>;
  73.  
  74. # no input at all - simply exit
  75. # exit if ! defined $_;
  76. # reply to the client (this actually gets eaten by the ScriptingAgent)
  77. ycp::Return (undef);
  78.  
  79.   my $term = Term::ReadLine->new( 'Simple Readline interface');
  80.   my $prompt = "YaST2> ";
  81.   my $OUT = $term->OUT || \*STDOUT;
  82.   
  83.  $term->ornaments(0);
  84.  
  85. while ( <STDIN> )
  86. {
  87.     my ($command, $path, $argument) = ycp::ParseCommand ($_);
  88.     
  89.     if ($command eq "Write")
  90.     {
  91.     if( $path eq "." )
  92.     {
  93.         # recode from utf8 (broken YaST)
  94.         # it sends almost UTF-8 (but encodes some chars as octals), so Perl
  95.         # does not like it as UTF-8. Let's force the conversion
  96.         my $octets = encode( "iso-8859-1", $argument );
  97.         Encode::from_to($octets, "utf-8", $codeset);
  98.         
  99.         print $OUT  $octets ,"\n";
  100.         ycp::Return ( "true" );
  101.     }
  102.     elsif ( $path eq ".nocr" )
  103.     {
  104.         my $octets = encode( "iso-8859-1", $argument );
  105.         Encode::from_to($octets, "utf-8", $codeset);
  106.         
  107.         print $OUT  $octets;
  108.         ycp::Return ( "true" );
  109.     }
  110.     elsif ( $path eq ".prompt" )
  111.     {
  112.         $prompt = $argument;
  113.         ycp::Return( "true" );
  114.     }
  115.     elsif ( $path eq ".stderr" )
  116.     {
  117.         # recode from utf8 (broken YaST)
  118.         # it sends almost UTF-8 (but encodes some chars as octals), so Perl
  119.         # does not like it as UTF-8. Let's force the conversion
  120.         my $octets = encode( "iso-8859-1", $argument );
  121.         Encode::from_to($octets, "utf-8", $codeset);
  122.         
  123.         print STDERR  $octets ,"\n";
  124.         ycp::Return ( "true" );
  125.     }
  126.     elsif ( $path eq ".stderr_nocr" )
  127.     {
  128.         # recode from utf8 (broken YaST)
  129.         # it sends almost UTF-8 (but encodes some chars as octals), so Perl
  130.         # does not like it as UTF-8. Let's force the conversion
  131.         my $octets = encode( "iso-8859-1", $argument );
  132.         Encode::from_to($octets, "utf-8", $codeset);
  133.         
  134.         print STDERR  $octets;
  135.         ycp::Return ( "true" );
  136.     }
  137.     else 
  138.     {
  139.         y2error ("Unrecognized path! '$path'");
  140.         ycp::Return (undef);
  141.     }
  142.     }
  143.  
  144.     elsif ($command eq "Read")
  145.     {
  146.     if ($path eq ".")
  147.     {
  148.         ReadString($term, $prompt);
  149.     }
  150.     elsif ($path eq ".nohistory")
  151.     {
  152.         ReadStringNoHistory($term, $prompt);
  153.     }
  154.     elsif ($path eq ".noecho")
  155.     # read, but don't add the input into history and don't show it
  156.     # should be used for reading a password
  157.     {
  158.         ReadStringNoEcho($term, $prompt);
  159.     }
  160.     else
  161.     {
  162.         y2error ("Unrecognized path! '$path'");
  163.         ycp::Return (undef);
  164.     }
  165.     }
  166.  
  167.     elsif ($command eq "result")
  168.     {
  169.     exit;
  170.     }
  171.  
  172.     # Unknown command
  173.     else
  174.     {
  175.     y2error ("Unknown instruction $command or argument: ", ref ($argument));
  176.     ycp::Return (undef);
  177.     }
  178.     print "\n";
  179. }
  180.