view release on metacpan or  search on metacpan

lib/PerlConsole/Console.pm  view on Meta::CPAN

package PerlConsole::Console;

# This class implements all the stuff needed to communicate with 
# the console.
# Either for displaying message in the console (error and verbose stuff)
# or for launcing command, or even changing the console's context.

# dependencies
use strict;
use warnings;
use Term::ReadLine;
use PerlConsole::Preferences;
use PerlConsole::Commands;
use Module::Refresh;
use Lexical::Persistence;
use Getopt::Long;
use B::Keywords qw(@Functions);

# These are all the built-in keywords of Perl
my @perl_keywords = @B::Keywords::Functions;

##############################################################
# Constructor
##############################################################
sub new($@)
{
    my ($class, $version) = @_;

    # the console's data structure
    my $self = {
        version             => $version,
        prefs               => new PerlConsole::Preferences,
        terminal            => new Term::ReadLine("Perl Console"),
        lexical_environment => new Lexical::Persistence,
        rcfile              => $ENV{HOME}.'/.perlconsolerc',
        prompt              => "Perl> ",
        modules             => {},
        logs                => [],
        errors              => [],
    };
    bless ($self, $class);

    # set the readline history if a Gnu terminal
    if ($self->{'terminal'}->ReadLine eq "Term::ReadLine::Gnu") {
        $SIG{'INT'} = sub { $self->clean_exit(0) };
        $self->{'terminal'}->ReadHistory($ENV{HOME} . "/.perlconsole_history");
    }

    # init the completion list with Perl internals...
    $self->addCompletion([@perl_keywords]);

    # ... and with PerlConsole's ones 
    $self->addCompletion([$self->{'prefs'}->getPreferences]);
    foreach my $pref ($self->{'prefs'}->getPreferences) {
        $self->addCompletion($self->{'prefs'}->getValidValues($pref));
    }
    # FIXME : we'll have to rewrite the commands stuff in a better way
    $self->addCompletion([qw(:quit :set :help)]);
    # the console's ready!
    return $self;
}

# This is where we define all the options supported
# on the command-line
sub parse_options
{
    my ($self) = @_;
    GetOptions('rcfile=s' => \$self->{rcfile});
    
    # cleanup of the ~ shortcut for $ENV{HOME}
    my $home = $ENV{HOME};
    $self->{rcfile} =~ s/^~/${home}/;
}

# method for exiting properly and flushing the history
sub clean_exit($$)
{
    my ($self, $status) = @_;
    if ($self->{'terminal'}->ReadLine eq "Term::ReadLine::Gnu") {
        $self->{'terminal'}->WriteHistory($ENV{HOME} . "/.perlconsole_history");
    }
    exit $status;
}

##############################################################
# Terminal
##############################################################

sub addCompletion($$)
{
    my ($self, $ra_list) = @_;
    my $attribs = $self->{'terminal'}->Attribs;
    $attribs->{completion_entry_function} = $attribs->{list_completion_function};
    if (! defined $attribs->{completion_word}) {
        $attribs->{completion_word} = $ra_list;
    }
    else {
        foreach my $elem (@{$ra_list}) {
            push @{$attribs->{completion_word}}, $elem;
        }
    }
}

sub is_completion
{
    my ($self, $item) = @_;
    my $attribs = $self->{'terminal'}->Attribs;
    return grep /^${item}$/, @{$attribs->{completion_word}};
}

sub getInput
{
    my ($self) = @_;
    return $self->{'terminal'}->readline($self->{'prompt'});
}

lib/PerlConsole/Console.pm  view on Meta::CPAN

sub message
{
    my ($self, $string) = @_;
    if (! defined $string) {
        print "undef\n";
    }
    else {
        chomp $string;
        print "$string\n";
    }
}

# time 
sub getTime($)
{
    my ($self) = @_;
    my ($sec, $min, $hour, 
        $mday, $mon, $year, 
        $wday, $yday, $isdst) = localtime(time);
    $mon++;
    $year += 1900;
    $mon = sprintf("%02d", $mon);
    $mday = sprintf("%02d", $mday);
    return "$year-$mon-$mday $hour:$mon:$sec";
}

# push a log message on the top of the stack
sub addLog($$)
{
    my ($self, $log) = @_;
    push @{$self->{'logs'}}, "[".$self->getTime."] $log";
}

# get the last log message and remove it
sub getLog($)
{
    my ($self) = @_;
    my $log = $self->{'logs'}[$#{$self->{'logs'}}];
    pop @{$self->{'logs'}};
    return $log;
}

# Return the list of all unread log message and empty it
sub getLogs
{
    my ($self) = @_;
    my $logs = $self->{'logs'};
    $self->{'logs'} = [];
    return $logs;
}

##############################################################
# Preferences
##############################################################

# accessors for the encapsulated preference object
sub setPreference($$$)
{
    my ($self, $pref, $value) = @_;
    my $prefs = $self->{'prefs'};
    $self->addLog("setPreference: $pref = $value");
    return $prefs->set($pref, $value);
}

sub getPreference($$)
{
    my ($self, $pref) = @_;
    my $prefs = $self->{'prefs'};
    my $val = $prefs->get($pref);
    return $val;
}

# set the output and take care to load the appropriate module
# for the output
sub setOutput($$)
{
    my ($self, $output) = @_;
    my $rh_output_modules = {
        'yaml'   => 'YAML',
        'dumper' => 'Data::Dumper',
        'dump'   => 'Data::Dump',
        'dds'    => 'Data::Dump::Streamer',
    };
    
    if (exists $rh_output_modules->{$output}) {
        my $module = $rh_output_modules->{$output};
        unless ($self->load($module)) {
            $self->error("Unable to load module \"$module\", ".
                "cannot use output mode \"$output\"");
            return 0;
        }
    }
    
    unless ($self->setPreference("output", $output)) {
        $self->error("unable to set preference output to \"$output\"");
        return 0;
    }

    return 1;
}

# this interprets a string, it calls the appropriate internal 
# function to deal with the provided string
sub interpret($$)
{
    my ($self, $code) = @_;

    # cleanup a bit the input string
    chomp $code;
    return unless length $code;

    # look for the exit command.
    $self->clean_exit(0) if $code =~ /(:quit|exit)/i;

    # look for console's internal language
    return if $self->command($code);

    # look for a module to import
    return if $self->useModule($code);

    # Refresh the loaded modules in @INC that have changed
    Module::Refresh->refresh;

    # looks like it's time to evaluates some code ;)
    $self->print_result($self->evaluate($code));
    print "\n";
    
    # look for something to save in the completion list
    $self->learn($code);