Fehlende Dateien für die Konsole.
authorSven Schöling <s.schoeling@linet-services.de>
Fri, 23 Jul 2010 12:16:22 +0000 (14:16 +0200)
committerSven Schöling <s.schoeling@linet-services.de>
Fri, 23 Jul 2010 12:16:22 +0000 (14:16 +0200)
config/console.conf.default [new file with mode: 0644]
modules/override/Devel/REPL/Plugin/AutoloadModules.pm [new file with mode: 0644]
modules/override/Devel/REPL/Plugin/PermanentHistory.pm [new file with mode: 0644]
modules/override/Term/ReadLine/Perl/Bind.pm [new file with mode: 0644]
users/.gitignore

diff --git a/config/console.conf.default b/config/console.conf.default
new file mode 100644 (file)
index 0000000..da291db
--- /dev/null
@@ -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 (file)
index 0000000..e36ee96
--- /dev/null
@@ -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 (file)
index 0000000..3a46b56
--- /dev/null
@@ -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 (file)
index 0000000..2587f6d
--- /dev/null
@@ -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';
+
index d288769..bf6e892 100644 (file)
@@ -2,3 +2,4 @@
 .fonts.cache*
 *_finanzamt.ini
 xvfb_display
+console_history