Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / CommandTerm / Rl.pm

package CommandTerm::Rl;

require 5.004;
use strict;
use Term::ReadLine;
use Term::ANSIColor;
use FileHandle;
use POSIX;
use CommandTerm;

use vars qw(
 @ISA
 %DerivedConfig
 $TABDLY
);

@ISA = qw(CommandTerm);

BEGIN {
 %DerivedConfig = (
    'dataFace'            => 'clear',
    'statusFace'          => 'green',
    'errorFace'           => 'red',
 ); 
 $TABDLY = 0x00001800;
}

sub New {
 my ($class, $name, $cfgfile, $app_config) = @_;
 my $self = {};

 bless $self, $class;

 $self->InitSignalHandlers;

 $self->Init($name, $cfgfile, $app_config, \%DerivedConfig);

 $self->{'Termios'}                    = undef;
 $self->{'OrigTermios'}                = undef;
 $self->{'ReadFD'}                     = '';
 $self->{'WriteFD'}                    = '';
 $self->{'ReadCallbacks'}              = {};
 $self->{'WriteCallbacks'}             = {};
 $self->{'GotInterrupt'}               = 0;

 $self->InitTerminal;
 $self->InitReadLine;

 return $self;
}

sub MainLoop {
 my ($self) = @_;

 my ($fileno, $fd_read, $fd_write);

 while( 1 ) {

   if( $self->GotInterrupt ) {
     $self->HandleInterrupt;
     $self->GotInterrupt(0);
   }

   if( $self->UpdatePrompt ) {
     $self->CloseRedirection;
     $self->fileevent(
              *STDIN, 
              'readable' => sub{ $self->ReadLine->callback_read_char; } 
           );
     $self->ReadLine->CallbackHandlerInstall(
              $self->GetPrompt,
              sub { $self->ProcessLine(@_); }
           );
     $self->UpdatePrompt(0);
   }

   next if select($fd_read = $self->ReadFD, $fd_write = $self->WriteFD, undef, 1.0) < 0;

   foreach $fileno (keys %{ $self->ReadCallbacks }) {
     &{ $self->{'ReadCallbacks'}{$fileno} } if vec($fd_read, $fileno, 1);
   }

   foreach $fileno (keys %{ $self->WriteCallbacks }) {
     &{ $self->{'WriteCallbacks'}{$fileno} } if vec($fd_write, $fileno, 1);
   }

 }
}

sub Print {
 my ($self, $how, @what) = @_;
 my $what = join '', @what;
 
 my $LOGFILE = $self->LogFH;
 my $ReDirFH = $self->ReDirFH;
 
 print $LOGFILE $what if defined($LOGFILE);

 if( $ReDirFH ) {
   print { $ReDirFH } $what;
 } elsif( $ENV{'TERM'} and $ENV{'TERM'} ne 'vt100' ) {
   print colored($what, $how);
 } else {
   print $what;
 }
}   
   
sub Title {
 my ($self, $titlestr) = @_;
 
 print STDOUT "\e]2;$titlestr\cg";
}
 
sub Icon {
 my ($self, $iconstr) = @_;
 
 print STDOUT "\e]1;$iconstr\cg";
}
 
sub clear {
 my ($self) = @_;

 $self->ReadLine->CallbackHandlerInstall('', sub {});
 $self->ReadLine->call_function('clear-screen');
 $self->Attribs->{'erase_empty_line'} = 1;
 $self->ReadLine->stuff_char(ord("\n"));
 $self->ReadLine->callback_read_char;
 $self->Attribs->{'erase_empty_line'} = 0;
}

sub InitSignalHandlers {
 my ($self) = @_;

 $self->SUPER::InitSignalHandlers;
 $SIG{'INT'}  = sub { $self->GotInterrupt(1); };
}

sub InitTerminal {
 my ($self) = @_;

 STDOUT->autoflush(1);

 my $Termios     = POSIX::Termios->new;
 my $OrigTermios = POSIX::Termios->new;

 if( not $Termios->getattr(STDIN_FILENO) ) {
   $self->PrintError("Error in getattr for STDIN(", STDIN_FILENO, "): $!\n ");
   $self->PrintError("Weird terminal behavior may occur.\n");
   return;
 }

 $OrigTermios->getattr(STDIN_FILENO);

 $Termios->setlflag(($Termios->getlflag | ISIG) & ~ICANON);
 $Termios->setoflag($Termios->getoflag & ~$TABDLY);
 $Termios->setcc(VTIME, 1);
 $Termios->setcc(VINTR, 3);
 if( not $Termios->setattr(STDIN_FILENO, TCSANOW) ) {
   $self->PrintError("Error in setattr for STDIN(", STDIN_FILENO, "): $!\n ");
   $self->PrintError("Weird terminal behavior may occur.\n");
   $Termios = undef;
 }

 $self->Termios($Termios);
 $self->OrigTermios($OrigTermios);
}

sub InitReadLine {
 my ($self) = @_;

 $self->SUPER::InitReadLine;

 if( $ENV{'TERM'} and $ENV{'TERM'} eq 'vt100' ) {
   # turn off all ornaments if the terminal can't handle it
   $self->ReadLine->ornaments(0);
 } else {
   # else set prompt to bold
   $self->ReadLine->ornaments('md,me,,');
 }
}

sub TogglePrompt {
 my ($self) = @_;

 &{ $self->TogglePromptCallback };

 my $line = $self->Attribs->{'line_buffer'};

 # This bit of magic just erases the current line, prompt included.
 $self->ReadLine->CallbackHandlerInstall('', sub {});
 $self->Attribs->{'erase_empty_line'} = 1;
 $self->ReadLine->stuff_char(ord("\n"));
 $self->ReadLine->callback_read_char;
 $self->Attribs->{'erase_empty_line'} = 0;

 # Install a new prompt and restore the old line
 $self->ReadLine->CallbackHandlerInstall($self->GetPrompt, sub { $self->ProcessLine(@_); });
 $self->ReadLine->insert_text($line);
}

sub HandleInterrupt {
 my ($self) = @_;
 my $ReadLine = $self->ReadLine;
 my $Attribs  = $self->Attribs;

 if( $Attribs and $Attribs->{'end'} != 0 ) {
   $ReadLine->modifying;
   $ReadLine->delete_text;
   $Attribs->{'point'} = $Attribs->{'end'} = 0;
   $ReadLine->redisplay;
 } else {
   &{ $self->HandleInterruptCallback };
 }
}

sub DefaultInterruptCallback {
 my ($self) = @_;

 print STDOUT "\n";
 $self->UpdatePrompt(1);
}

sub fileevent {
 my ($self, $fh, $readwrite, $func) = @_;

 return unless defined($fh) and defined($readwrite);

 my $fileno = fileno($fh);

 if( $readwrite eq 'readable' ) {
   if( defined($func) and ref($func) eq 'CODE' ) {
     vec($self->{'ReadFD'}, $fileno, 1) = 1;
     $self->{'ReadCallbacks'}{$fileno} = $func;
   } else {
     vec($self->{'ReadFD'}, $fileno, 1) = 0;
     delete $self->{'ReadCallbacks'}{$fileno}
   }
 } elsif( $readwrite eq 'writable' ) {
   if( defined($func) and ref($func) eq 'CODE' ) {
     vec($self->{'WriteFD'}, $fileno, 1) = 1;
     $self->{'WriteCallbacks'}{$fileno} = $func;
   } else {
     vec($self->{'WriteFD'}, $fileno, 1) = 0;
     delete $self->{'WriteCallbacks'}{$fileno};
   }
 } else {
   $self->PrintError("Bad mode to fileevent: '$readwrite'\n");
 }
}

sub Shutdown {
 my ($self) = @_;

 $self->OrigTermios->setattr(STDIN_FILENO, TCSANOW) if $self->OrigTermios;
}

sub ProcessLine {
 my ($self, $line) = @_;
 my $ReadLine = $self->ReadLine;
 my $Attribs  = $self->Attribs;

 # User typed Ctrl-D
 unless( defined($line) ) {
   print STDOUT "\n";
   $self->quit;
 }

 $ReadLine->delete_text;
 $Attribs->{'point'} = $Attribs->{'end'} = 0;

 $self->UpdatePrompt(1);
 $self->fileevent(*STDIN, 'readable' => '');
 $ReadLine->callback_handler_remove;

 $self->SUPER::ProcessLine($line);
}

1;