r15553 - in /branches/upstream/perlconsole/current: CHANGES Makefile.PL lib/PerlConsole.pm lib/PerlConsole/Console.pm lib/PerlConsole/Preferences.pm perlconsole testfile
sukria at users.alioth.debian.org
sukria at users.alioth.debian.org
Sun Feb 24 23:05:32 UTC 2008
Author: sukria
Date: Sun Feb 24 23:05:31 2008
New Revision: 15553
URL: http://svn.debian.org/wsvn/?sc=1&rev=15553
Log:
[svn-upgrade] Integrating new upstream version, perlconsole (0.4)
Added:
branches/upstream/perlconsole/current/testfile
Modified:
branches/upstream/perlconsole/current/CHANGES
branches/upstream/perlconsole/current/Makefile.PL
branches/upstream/perlconsole/current/lib/PerlConsole.pm
branches/upstream/perlconsole/current/lib/PerlConsole/Console.pm
branches/upstream/perlconsole/current/lib/PerlConsole/Preferences.pm
branches/upstream/perlconsole/current/perlconsole
Modified: branches/upstream/perlconsole/current/CHANGES
URL: http://svn.debian.org/wsvn/branches/upstream/perlconsole/current/CHANGES?rev=15553&op=diff
==============================================================================
--- branches/upstream/perlconsole/current/CHANGES (original)
+++ branches/upstream/perlconsole/current/CHANGES Sun Feb 24 23:05:31 2008
@@ -6,7 +6,6 @@
* History saved in ~/.perlconsole_history
* Support for a ~/.perlconsolerc (every line in that file
will be evaluated at launch time)
- * the rcfile can be overrided by --rcfile=<FILE> on the command line
* Added a real namespace to the console, each variable declared
with "my" are persistent in the session.
* The console runs in strict mode.
Modified: branches/upstream/perlconsole/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/perlconsole/current/Makefile.PL?rev=15553&op=diff
==============================================================================
--- branches/upstream/perlconsole/current/Makefile.PL (original)
+++ branches/upstream/perlconsole/current/Makefile.PL Sun Feb 24 23:05:31 2008
@@ -6,8 +6,8 @@
VERSION_FROM => 'lib/PerlConsole.pm',
EXE_FILES => ['perlconsole'],
PREREQ_PM => {
- 'Term::ReadLine' => 0,
- 'Module::Refresh' => 0,
- 'Getopt::Long' => 0,
+ 'Term::ReadLine' => 0,
+ 'B::Keywords' => 0,
+ 'Module::Refresh' => 0,
'Lexical::Persistence' => 0},
);
Modified: branches/upstream/perlconsole/current/lib/PerlConsole.pm
URL: http://svn.debian.org/wsvn/branches/upstream/perlconsole/current/lib/PerlConsole.pm?rev=15553&op=diff
==============================================================================
--- branches/upstream/perlconsole/current/lib/PerlConsole.pm (original)
+++ branches/upstream/perlconsole/current/lib/PerlConsole.pm Sun Feb 24 23:05:31 2008
@@ -1,3 +1,3 @@
package PerlConsole;
-$VERSION = '0.3';
+$VERSION = '0.4';
Modified: branches/upstream/perlconsole/current/lib/PerlConsole/Console.pm
URL: http://svn.debian.org/wsvn/branches/upstream/perlconsole/current/lib/PerlConsole/Console.pm?rev=15553&op=diff
==============================================================================
--- branches/upstream/perlconsole/current/lib/PerlConsole/Console.pm (original)
+++ branches/upstream/perlconsole/current/lib/PerlConsole/Console.pm Sun Feb 24 23:05:31 2008
@@ -14,51 +14,29 @@
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 = qw(
-chomp chop chr crypt hex index lc lcfirst length oct ord pack qq reverse
-rindex sprintf substr tr uc ucfirst pos quotemeta split study
-qr abs atan2 cos exp hex int log oct rand sin sqrt srand pop push shift
-splice unshift grep join map qw/STRING/ reverse sort unpack delete each exists
-keys values binmode close closedir dbmclose dbmopen die eof fileno flock format
-getc print printf read readdir rewinddir seek seekdir select syscall sysread
-sysseek syswrite tell telldir truncate warn write pack read syscall sysread
-syswrite unpack vec chdir chmod chown chroot fcntl glob ioctl link lstat
-mkdir open opendir readlink rename rmdir stat symlink umask unlink utime caller
-continue die do dump eval exit goto last next redo return sub wantarray caller
-import local my package use defined dump eval formline local my reset scalar
-undef wantarray alarm exec fork getpgrp getppid getpriority kill pipe
-qx setpgrp setpriority sleep system times wait waitpid do import no
-package require use bless dbmclose dbmopen package ref tie tied untie use
-accept bind connect getpeername getsockname getsockopt listen recv send
-setsockopt shutdown socket socketpair msgctl msgget msgrcv msgsnd semctl semget
-semop shmctl shmget shmread shmwrite endprotoent endservent gethostbyaddr
-gethostbyname gethostent getnetbyaddr getnetbyname getnetent getprotobyname
-getprotobynumber getprotoent getservbyname getservbyport getservent sethostent
-setnetent setprotoent setservent gmtime localtime time times abs bless chomp
-chr exists formline glob import lc lcfirst map my no prototype qx qw readline
-readpipe ref sub sysopen tie tied uc ucfirst untie use);
+my @perl_keywords = @B::Keywords::Functions;
##############################################################
# Constructor
##############################################################
-
sub new($@)
{
my ($class, $version) = @_;
- # the console's data structure, with the Readline terminal inside
+ # the console's data structure
my $self = {
- version => $version,
- prefs => new PerlConsole::Preferences,
- terminal => new Term::ReadLine("Perl Console"),
- lexical_environment => Lexical::Persistence->new,
- rcfile => $ENV{HOME}.'/.perlconsolerc',
- prompt => "Perl> ", # the prompt
- modules => {}, # all the loaded module in the session
- logs => [], # a stack of log messages
- errors => [], # a stack of errors
+ 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);
@@ -82,6 +60,17 @@
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($$)
@@ -112,6 +101,13 @@
}
}
+sub is_completion
+{
+ my ($self, $item) = @_;
+ my $attribs = $self->{'terminal'}->Attribs;
+ return grep /^${item}$/, @{$attribs->{completion_word}};
+}
+
sub getInput
{
my ($self) = @_;
@@ -163,15 +159,22 @@
sub message
{
my ($self, $string) = @_;
- chomp $string;
- print "$string\n";
+ 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);
+ my ($sec, $min, $hour,
+ $mday, $mon, $year,
+ $wday, $yday, $isdst) = localtime(time);
$mon++;
$year += 1900;
$mon = sprintf("%02d", $mon);
@@ -225,32 +228,33 @@
return $val;
}
-# and specialized preferences
+# set the output and take care to load the appropriate module
+# for the output
sub setOutput($$)
{
my ($self, $output) = @_;
- if ($output eq "yaml") {
- unless ($self->load("YAML")) {
- $self->error("unable to load module YAML, cannot use 'yaml' 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;
}
}
- elsif ($output eq "dumper") {
- unless ($self->load("Data::Dumper")) {
- $self->error("unable to load module Data::Dumper, cannot use 'dumper' output");
- return 0;
- }
- }
- elsif ($output eq "dump") {
- unless ($self->load("Data::Dump")) {
- $self->error("unable to load module Data::Dump, cannot use 'dump' 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
@@ -272,14 +276,16 @@
# 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);
- # Refresh the loaded modules in @INC that have changed
- Module::Refresh->refresh;
-
- # looks like it's time to evaluates some code ;)
- $self->evaluate($code);
}
# this reads and interprets the contents of an rc file (~/.perlconsolerc)
@@ -289,13 +295,21 @@
{
my ($self) = @_;
my $file = $self->{'rcfile'};
+ $self->addLog("loading rcfile: $file");
if ( -r $file) {
- open(RC, "<", "$file") || return;
- while(<RC>) {
- $self->interpret($_);
- }
- close RC;
+ if (open(RC, "<", "$file")) {
+ while(<RC>) {
+ $self->interpret($_);
+ }
+ close RC;
+ }
+ else {
+ $self->error("unable to read rcfile $file : $!");
+ }
+ }
+ else {
+ $self->error("rcfile $file is not readable");
}
}
@@ -310,7 +324,7 @@
$self->{'tags'}{$package} = {};
}
- # look for aloready loaded modules/tags
+ # look for already loaded modules/tags
if (defined $tag) {
return 1 if defined $self->{'tags'}{$package}{$tag};
}
@@ -352,7 +366,17 @@
my ($self, $module) = @_;
my $namespace;
eval '$namespace = \%'.$module.'::';
- $self->addCompletion([keys %$namespace]);
+ if ($@) {
+ $self->error($@);
+ }
+ $self->addLog("loading namespace of $module");
+
+ foreach my $token (keys %$namespace) {
+ # only put methods found that begins with a letter
+ if ($token =~ /^([a-zA-Z]\S+)$/) {
+ $self->addCompletion([$1]);
+ }
+ }
}
# This function reads the command line and looks for something that is worth
@@ -360,10 +384,10 @@
sub learn($$)
{
my ($self, $code) = @_;
-
- # actually, only remembering variable names for the moment.
- if ($code =~ /[\$\@\%](\S+)\s*=/) {
- $self->addCompletion([$1]);
+ my $env = $self->{lexical_environment}->get_context('_');
+ foreach my $var (keys %$env) {
+ $self->addCompletion([substr($var, 1)])
+ unless $self->is_completion(substr($var, 1));
}
}
@@ -402,16 +426,16 @@
sub evaluate($$)
{
my ($self, $code) = @_;
- my $output = $self->getPreference('output');
# compile the code to a coderef where each variables of the lexical
# environment are declared
$code = $self->compile($code);
- return unless defined $code;
+ return undef unless defined $code;
# wrap the compiled code with Lexical::Persitence
# in order to catch each variable in the lexenv
$code = $self->{lexical_environment}->wrap($code);
+ return undef unless defined $code && (ref($code) eq 'CODE');
# now evaluate the coderef pointed by the sub lexenv->wrap
# built for us
@@ -420,26 +444,66 @@
# an error occured?
if ($@) {
$self->error("Runtime error: $@");
- }
+ return undef;
+ }
+ return \@result;
+}
+
+# This function is dedicated to print the result in the good way
+# It takes the resulting array of the code evaluated and converts it
+# to the wanted output
+sub print_result
+{
+ my ($self, $ra_result) = @_;
+ return unless defined $ra_result and (ref($ra_result) eq 'ARRAY');
+ my @result = @{$ra_result};
+ $self->message($self->get_output(@result));
+}
+
+
+# the outputs
+sub get_output($@)
+{
+ my ($self, @result) = @_;
+ my $output = $self->getPreference('output');
- # no error, so lets output the result
- else {
- my $str = "";
- if (@result) {
-
- # default output is scalar
- $str = @result;
-
- # if only one value returned, use this scalar
- $str = $result[0] if @result == 1;
-
- # uses external output modes if needed
- eval '$str = YAML::Dump(@result)' if $output eq "yaml";
- eval '$str = Data::Dumper::Dumper(@result)' if $output eq "dumper";
- eval '$str = Data::Dump::dump(@result)' if $output eq "dump";
- }
- $self->message($str);
- }
+ # default output is scalar
+ my $str = (@result == 1) ? $result[0] : @result;
+
+ # YAML output
+ if ($output eq 'yaml') {
+ eval '$str = YAML::Dump(@result)';
+ }
+
+ # Data::Dumper output
+ elsif ($output eq 'dumper') {
+ eval '$str = Data::Dumper::Dumper(@result)';
+ }
+
+ # Data::Dump output
+ elsif ($output eq 'dump') {
+ eval '$str = Data::Dump::dump(@result)';
+ }
+
+ # Data::Dump::Streamer output
+ elsif ($output eq 'dds') {
+ my $to_dump = (@result > 1) ? \@result : $result[0];
+ if (ref($to_dump)) {
+ eval 'my $dds = new Data::Dump::Streamer; '.
+ '$dds->Freezer(sub { return "$_[0]"; }); '.
+ '$dds->Data($to_dump); '.
+ '$str = $dds->Out;';
+ }
+ else {
+ return $to_dump;
+ }
+ }
+
+ if ($@) {
+ $self->error("Unable to get formated output: $@");
+ return "";
+ }
+ return $str;
}
# This looks for a use statement in the string and if so, try to
@@ -459,6 +523,9 @@
}
if (defined $module) {
+ # drop the possible trailing ";"
+ $module =~ s/\s*;\s*$//;
+
if (!$self->load($module, $tag)) {
my $error = $@;
chomp $error;
@@ -487,11 +554,7 @@
return 0;
}
-sub parse_options
-{
- my ($self) = @_;
- GetOptions('rcfile=s' => \$self->{rcfile});
-}
+
# END
1;
Modified: branches/upstream/perlconsole/current/lib/PerlConsole/Preferences.pm
URL: http://svn.debian.org/wsvn/branches/upstream/perlconsole/current/lib/PerlConsole/Preferences.pm?rev=15553&op=diff
==============================================================================
--- branches/upstream/perlconsole/current/lib/PerlConsole/Preferences.pm (original)
+++ branches/upstream/perlconsole/current/lib/PerlConsole/Preferences.pm Sun Feb 24 23:05:31 2008
@@ -13,7 +13,7 @@
{
my $self = {
_valid_values => {
- output => ['scalar', 'dumper', 'yaml', 'dump'],
+ output => ['scalar', 'dumper', 'yaml', 'dump', 'dds'],
},
_values => {
output => "scalar"
Modified: branches/upstream/perlconsole/current/perlconsole
URL: http://svn.debian.org/wsvn/branches/upstream/perlconsole/current/perlconsole?rev=15553&op=diff
==============================================================================
--- branches/upstream/perlconsole/current/perlconsole (original)
+++ branches/upstream/perlconsole/current/perlconsole Sun Feb 24 23:05:31 2008
@@ -20,6 +20,35 @@
# with all the namespaces loaded during your session.
# This is the main script of the program.
+# strict mode
+use strict;
+use warnings;
+
+# libs
+use PerlConsole;
+use PerlConsole::Console;
+
+# Init our console
+my $console = PerlConsole::Console->new($PerlConsole::VERSION);
+
+# look for option in the commandline
+$console->parse_options();
+
+# display the header message
+$console->header();
+
+# source the rcfile first
+$console->source_rcfile();
+
+# Main REPL, prompting and waiting for code to evaluate
+while (defined (my $code = $console->getInput())) {
+ $console->interpret($code);
+}
+
+# End, quitting.
+$console->clean_exit(0);
+
+__END__
=pod
=head1 NAME
@@ -39,10 +68,6 @@
loaded during your session. It allows you to load a module in your session and
test a function exported by it.
-=head1 OPTIONS
-
-B<--rcfile>=<FILE> : change the file parsed at startup (see RCFILE).
-
=head1 COMMANDS
It's possible to interact with the console with internal commands. The
@@ -61,7 +86,7 @@
=head1 RCFILE
PerlConsole will look for a rcfile located in your home directory called:
-~/.perlconsolerc (or wherever you pointed to with "--rcifle").
+~/.perlconsolerc
Every line in that file will be evaluated as if they were issued in the console.
You can then load there your favorite modules, or even define your preferences.
@@ -89,35 +114,4 @@
Perl Console was writen by Alexis Sukrieh <sukria at sukria.net>.
-This manpage was written by Alexis Sukrieh for the Debian system but may be
-used for others.
-
=cut
-
-# strict mode
-use strict;
-use warnings;
-
-# libs
-use PerlConsole;
-use PerlConsole::Console;
-
-# Init our console
-my $console = PerlConsole::Console->new($PerlConsole::VERSION);
-
-# look for option in the commandline
-$console->parse_options();
-
-# source the rcfile first
-$console->source_rcfile();
-
-# display the header message
-$console->header();
-
-# Main loop, prompting and waiting for code to evaluate
-while (defined (my $code = $console->getInput())) {
- $console->interpret($code);
-}
-
-# End, quitting.
-$console->clean_exit(0);
Added: branches/upstream/perlconsole/current/testfile
URL: http://svn.debian.org/wsvn/branches/upstream/perlconsole/current/testfile?rev=15553&op=file
==============================================================================
(empty)
More information about the Pkg-perl-cvs-commits
mailing list