From 1223749262d20d86a1478fac3dff7a97fcc18d75 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Sven=20Sch=C3=B6ling?= Date: Fri, 23 Jul 2010 14:16:22 +0200 Subject: [PATCH] =?utf8?q?Fehlende=20Dateien=20f=C3=BCr=20die=20Konsole.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- config/console.conf.default | 13 ++ .../Devel/REPL/Plugin/AutoloadModules.pm | 29 ++++ .../Devel/REPL/Plugin/PermanentHistory.pm | 39 +++++ modules/override/Term/ReadLine/Perl/Bind.pm | 153 ++++++++++++++++++ users/.gitignore | 1 + 5 files changed, 235 insertions(+) create mode 100644 config/console.conf.default create mode 100644 modules/override/Devel/REPL/Plugin/AutoloadModules.pm create mode 100644 modules/override/Devel/REPL/Plugin/PermanentHistory.pm create mode 100644 modules/override/Term/ReadLine/Perl/Bind.pm diff --git a/config/console.conf.default b/config/console.conf.default new file mode 100644 index 000000000..da291db5d --- /dev/null +++ b/config/console.conf.default @@ -0,0 +1,13 @@ +[Console] + +# autologin to use if none is given +login = demo + +# autorun lines will be executed after autologin. +# be warned that loading huge libraries will noticably lengthen startup time. +#autorun = use SL::Module +# = use SL::Other::Module + +# location of history file for permanent history +history_file = users/console_history + diff --git a/modules/override/Devel/REPL/Plugin/AutoloadModules.pm b/modules/override/Devel/REPL/Plugin/AutoloadModules.pm new file mode 100644 index 000000000..e36ee9654 --- /dev/null +++ b/modules/override/Devel/REPL/Plugin/AutoloadModules.pm @@ -0,0 +1,29 @@ +package Devel::REPL::Plugin::AutoloadModules; + +use Moose::Role; +use namespace::clean -except => [ 'meta' ]; +use Data::Dumper; + +has 'autoloaded' => ( is => 'rw', isa => 'HashRef', default => sub { {} } ); + +my $re = qr/Runtime error: Can.t locate object method "\w+" via package "\w+" \(perhaps you forgot to load "(\w+)"\?\)/; +around 'execute' => sub { + my $orig = shift; + my $self = shift; + + my @re = $self->$orig(@_); # original call + + return @re unless defined $re[0] && $re[0] =~ /$re/; # if there is no "perhaps you forgot" error, just return + my $module = $1; # save the missing package name + + return @re if $self->autoloaded->{$module}; # if we tried to load it before, give up and return the error + + $self->autoloaded->{$module} = 1; # make sure we don't try this again + $self->eval("use SL::$module"); # try to load the missing module + + @re = $self->$orig(@_); # try again + + return @re; +}; + +1; diff --git a/modules/override/Devel/REPL/Plugin/PermanentHistory.pm b/modules/override/Devel/REPL/Plugin/PermanentHistory.pm new file mode 100644 index 000000000..3a46b56cf --- /dev/null +++ b/modules/override/Devel/REPL/Plugin/PermanentHistory.pm @@ -0,0 +1,39 @@ +package Devel::REPL::Plugin::PermanentHistory; + +use Moose::Role; +use namespace::clean -except => [ 'meta' ]; +use File::Slurp; +use Data::Dumper; + +has 'history_file' => ( is => 'rw' ); + +sub load_history { + my $self = shift; + my $file = shift; + + $self->history_file( $file ); + + return unless $self->history_file && -f $self->history_file; + + my @history = + map { chomp; $_ } + read_file($self->history_file); +# print Dumper(\@history); + $self->history( \@history ); + $self->term->addhistory($_) for @history; +} + +before 'DESTROY' => sub { + my $self = shift; + + return unless $self->history_file; + + write_file $self->history_file, + map { $_, $/ } + grep $_, + grep { !/^quit\b/ } + @{ $self->history }; +}; + +1; + diff --git a/modules/override/Term/ReadLine/Perl/Bind.pm b/modules/override/Term/ReadLine/Perl/Bind.pm new file mode 100644 index 000000000..2587f6dcf --- /dev/null +++ b/modules/override/Term/ReadLine/Perl/Bind.pm @@ -0,0 +1,153 @@ +package Term::ReadLine::Perl::Bind; +### From http://www.perlmonks.org/?node_id=751611 +### Posted by repellant (http://www.perlmonks.org/?node_id=665462) + +### Set readline bindkeys for common terminals + +use warnings; +use strict; + +BEGIN { + require Exporter; + *import = \&Exporter::import; # just inherit import() only + + our $VERSION = 1.001; + our @EXPORT_OK = qw(rl_bind_action $action2key $key2codes); +} + +use Term::ReadLine; + +# http://cpansearch.perl.org/src/ILYAZ/Term-ReadLine-Perl-1.0302/ReadLine +my $got_rl_perl; + +BEGIN { + $got_rl_perl = eval { + require Term::ReadLine::Perl; + require Term::ReadLine::readline; + }; +} + +# bindkey actions for terminals +our $action2key = { + Complete => "Tab", + PossibleCompletions => "C-d", + QuotedInsert => "C-v", + + ToggleInsertMode => "Insert", + DeleteChar => "Del", + UpcaseWord => "PageUp", + DownCaseWord => "PageDown", + BeginningOfLine => "Home", + EndOfLine => "End", + + ReverseSearchHistory => "C-Up", + ForwardSearchHistory => "C-Down", + ForwardWord => "C-Right", + BackwardWord => "C-Left", + + HistorySearchBackward => "S-Up", + HistorySearchForward => "S-Down", + KillWord => "S-Right", + BackwardKillWord => "S-Left", + + Yank => "A-Down", # paste + KillLine => "A-Right", + BackwardKillLine => "A-Left", +}; + +our $key2codes = { + "Tab" => [ "TAB", ], + "C-d" => [ "C-d", ], + "C-v" => [ "C-v", ], + + "Insert" => [ qq("\e[2~"), qq("\e[2z"), qq("\e[L"), ], + "Del" => [ qq("\e[3~"), ], + "PageUp" => [ qq("\e[5~"), qq("\e[5z"), qq("\e[I"), ], + "PageDown" => [ qq("\e[6~"), qq("\e[6z"), qq("\e[G"), ], + "Home" => [ qq("\e[7~"), qq("\e[1~"), qq("\e[H"), ], + "End" => [ qq("\e[8~"), qq("\e[4~"), qq("\e[F"), ], + + "C-Up" => [ qq("\eOa"), qq("\eOA"), qq("\e[1;5A"), ], + "C-Down" => [ qq("\eOb"), qq("\eOB"), qq("\e[1;5B"), ], + "C-Right" => [ qq("\eOc"), qq("\eOC"), qq("\e[1;5C"), ], + "C-Left" => [ qq("\eOd"), qq("\eOD"), qq("\e[1;5D"), ], + + "S-Up" => [ qq("\e[a"), qq("\e[1;2A"), ], + "S-Down" => [ qq("\e[b"), qq("\e[1;2B"), ], + "S-Right" => [ qq("\e[c"), qq("\e[1;2C"), ], + "S-Left" => [ qq("\e[d"), qq("\e[1;2D"), ], + + "A-Down" => [ qq("\e\e[B"), qq("\e[1;3B"), ], + "A-Right" => [ qq("\e\e[C"), qq("\e[1;3C"), ], + "A-Left" => [ qq("\e\e[D"), qq("\e[1;3D"), ], +}; + +# warn if any keycode is clobbered +our $debug = 0; + +# check ref type +sub _is_array { ref($_[0]) && eval { @{ $_[0] } or 1 } } +sub _is_hash { ref($_[0]) && eval { %{ $_[0] } or 1 } } + +# set bindkey actions for each terminal +my %code2action; + +sub rl_bind_action { + if ($got_rl_perl) + { + my $a2k = shift(); + return () unless _is_hash($a2k); + + while (my ($action, $bindkey) = each %{ $a2k }) + { + # use default keycodes if none provided + my @keycodes = @_ ? @_ : $key2codes; + + for my $k2c (@keycodes) + { + next unless _is_hash($k2c); + + my $codes = $k2c->{$bindkey}; + next unless defined($codes); + $codes = [ $codes ] unless _is_array($codes); + + for my $code (@{ $codes }) + { + if ($debug && $code2action{$code}) + { + my $hexcode = $code; + $hexcode =~ s/^"(.*)"$/$1/; + $hexcode = join(" ", map { uc } unpack("(H2)*", $hexcode)); + + warn <<"EOT"; +rl_bind_action(): re-binding keycode [ $hexcode ] from '$code2action{$code}' to '$action' +EOT + } + + readline::rl_bind($code, $action); + $code2action{$code} = $action; + } + } + } + } + else + { + warn <<"EOT"; +rl_bind_action(): Term::ReadLine::Perl is not available. No bindkeys were set. +EOT + } + + return $got_rl_perl; +} + +# default bind +rl_bind_action($action2key); + +# bind Delete key for 'xterm' +if ($got_rl_perl && defined($ENV{TERM}) && $ENV{TERM} =~ /xterm/) +{ + rl_bind_action($action2key, +{ "Del" => qq("\x7F") }); +} + +'Term::ReadLine::Perl::Bind'; + diff --git a/users/.gitignore b/users/.gitignore index d288769da..bf6e892a6 100644 --- a/users/.gitignore +++ b/users/.gitignore @@ -2,3 +2,4 @@ .fonts.cache* *_finanzamt.ini xvfb_display +console_history -- 2.20.1