├── .gitignore ├── .travis.yml ├── Changes ├── bin └── reply ├── dist.ini └── lib ├── Reply.pm └── Reply ├── App.pm ├── Config.pm ├── Plugin.pm ├── Plugin ├── AutoRefresh.pm ├── Autocomplete │ ├── Commands.pm │ ├── Functions.pm │ ├── Globals.pm │ ├── Keywords.pm │ ├── Lexicals.pm │ ├── Methods.pm │ └── Packages.pm ├── CollapseStack.pm ├── Colors.pm ├── DataDump.pm ├── DataDumper.pm ├── DataPrinter.pm ├── Defaults.pm ├── Editor.pm ├── FancyPrompt.pm ├── Hints.pm ├── Interrupt.pm ├── LexicalPersistence.pm ├── LoadClass.pm ├── Nopaste.pm ├── Packages.pm ├── Pager.pm ├── ReadLine.pm ├── ResultCache.pm └── Timer.pm └── Util.pm /.gitignore: -------------------------------------------------------------------------------- 1 | cover_db 2 | META.* 3 | MYMETA.* 4 | Makefile 5 | blib 6 | inc 7 | pm_to_blib 8 | MANIFEST 9 | Makefile.old 10 | nytprof.out 11 | MANIFEST.bak 12 | *.sw[po] 13 | .DS_Store 14 | .build 15 | Reply-* 16 | *.bs 17 | *.o 18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: perl 3 | perl: 4 | - "5.22" 5 | - "5.20" 6 | - "5.18" 7 | - "5.16" 8 | - "5.14" 9 | install: 10 | - cpanm -q --notest Dist::Zilla || (cat /home/travis/.cpanm/build.log; false) 11 | - dzil authordeps --missing | cpanm -q --notest || (cat /home/travis/.cpanm/build.log; false) 12 | - dzil listdeps --author --missing | cpanm -q --notest || (cat /home/travis/.cpanm/build.log; false) 13 | script: 14 | - dzil test --all 15 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Reply 2 | 3 | {{$NEXT}} 4 | 5 | 0.42 2016-08-23 6 | - make tests pass again if Term::ReadKey is not installed (andk, #52) 7 | 8 | 0.41 2016-08-16 9 | - add #vars command to list currently in scope variable names (garu, #39) 10 | - add Reply::Plugin::Pager to page long results (y, #47) 11 | 12 | 0.40 2016-06-25 13 | - fix docs (y, #49) 14 | 15 | 0.39 2016-05-29 16 | - allow ~/ in the history_file option to ReadLine (y, #48) 17 | 18 | 0.38 2015-12-02 19 | - fix running reply without the Package plugin (2shortplanks, #45) 20 | 21 | 0.37 2014-11-18 22 | - internal refactoring for extensibility (sergeyromanov, #41) 23 | 24 | 0.36 2014-11-16 25 | - unshift onto @INC instead of pusing directories set with -l/-b/-I 26 | (ilmari, #40) 27 | 28 | 0.35 2014-07-04 29 | - allow executing snippets and files from the argument list (suggested by 30 | tobyink, #36) 31 | 32 | 0.34 2013-08-29 33 | - fix running reply without the ReadLine plugin (lestrrat, #26) 34 | 35 | 0.33 2013-08-16 36 | - Support Term::ReadLine::Caroline (tokuhirom, #24) 37 | 38 | 0.32 2013-07-18 39 | - Fix test failures if Carp::Always isn't installed (djerius, #21) 40 | - Clarify ReadLine documentation about the location of the history file 41 | (Kosuke Asami) 42 | 43 | 0.31 2013-07-18 44 | - fix a ReadLine bug introduced in the previous release (Kosuke Asami, 45 | #22) 46 | 47 | 0.30 2013-07-17 48 | - better support for Term::ReadLine::Perl5 (Kosuke Asami, #20) 49 | 50 | 0.29 2013-07-10 51 | - Make CollapseStack always run under Carp::Always (#13) 52 | - Fix lexical subs (#19) 53 | 54 | 0.28 2013-07-10 55 | - remove accidentally added dep on 'mro', which doesn't exist on 5.8 56 | 57 | 0.27 2013-07-10 58 | - Add completion plugin for #-commands (#18) 59 | - More completion edge case fixes 60 | - More internal refactorings 61 | 62 | 0.26 2013-07-08 63 | - Let Data::Printer handle coloring in the DataPrinter plugin. (Sawyer X) 64 | - Add a CollapseStack plugin, to make working with large stack traces 65 | easier. (sartak) 66 | 67 | 0.25 2013-07-05 68 | - The DataDump plugin now respects object stringification overloads by 69 | default. This behavior can be disabled by setting the 70 | 'respect_stringification' option to 0. 71 | 72 | 0.24 2013-07-04 73 | - use Devel::LexAlias to ensure that the lexical environment is persisted 74 | properly (gh #10) 75 | - a few internal refactorings 76 | 77 | 0.23 2013-07-03 78 | - use the correct #! line (reported by SREZIC, RT86669) 79 | 80 | 0.22 2013-07-02 81 | - few more completion edge cases 82 | 83 | 0.21 2013-07-01 84 | - check inheritance in method completions 85 | - fix a couple more completion edge cases 86 | 87 | 0.20 2013-06-28 88 | - completion for packages declared in the repl (Toby Inkster, gh-#7) 89 | - completion for functions (Toby Inkster, gh-#8) 90 | 91 | 0.19 2013-06-28 92 | - fix test failures (reported by brunobuss) 93 | 94 | 0.18 2013-06-27 95 | - tab completion support (with help from sartak) 96 | - lots of internal refactorings to make writing plugins easier 97 | 98 | 0.17 2013-06-27 99 | - support color on windows (aero) 100 | 101 | 0.16 2013-06-26 102 | - bump the Getopt::Long dep, for installing on older perls 103 | 104 | 0.15 2013-06-26 105 | - add default command of #q for exiting the repl 106 | 107 | 0.14 2013-06-26 108 | - add -l, -b, -I, and -M options (requested by Toby Inkster, RT86341) 109 | 110 | 0.13 2013-06-26 111 | - allow plugins to configure the current package to use through the 112 | 'package' parameter in the compile callback 113 | 114 | 0.12 2013-06-25 115 | - make the AutoRefresh plugin use the new track_require functionality 116 | in Class::Refresh (fixes a problem reported by Michael Reddick) 117 | 118 | 0.11 2013-06-24 119 | - report failure to load of plugins which use modules that fail to load 120 | (reported by Michael Reddick) 121 | 122 | 0.10 2013-06-24 123 | - don't pollute main::, since that's where the default configuration 124 | drops the user (reported by miyagawa) 125 | 126 | 0.09 2013-06-21 127 | - fix tests 128 | 129 | 0.08 2013-06-21 130 | - add AutoRefresh plugin (Michael Reddick) 131 | 132 | 0.07 2013-06-08 133 | - expose a 'step' method to run single iterations of the repl 134 | - plugins specified in the 'plugins' constructor parameter are now run 135 | after loading config rather than before (this should give them more 136 | control over what actually runs - if this is a problem, i might add 137 | separate options for "before config" and "after config") 138 | - config handling is split out into a separate Reply::Config class for 139 | better reuse of the config loading logic 140 | - DataDumper plugin now sets Terse and Sortkeys, since that produces 141 | output that looks better 142 | - plugins can now set multiple independent lexical environments, to allow 143 | them to override the actual logical environment without wiping out 144 | special vars set by other plugins 145 | 146 | 0.06 2013-06-08 147 | - add Timer plugin (Arthur Axel fREW Schmidt) 148 | - fix DataPrinter plugin when ~/.dataprinter has a custom value for 149 | 'alias' (Charles Bailey) 150 | 151 | 0.05 2013-06-04 152 | - avoid test failures from DataPrinter, since it's optional 153 | 154 | 0.04 2013-06-04 155 | - add a bit of option parsing to the reply script, to support choosing an 156 | alternate configuration file 157 | - Data::Printer plugin (creaktive) 158 | 159 | 0.03 2013-06-03 160 | - fix LexicalPersistence plugin (reported by tokuhirom) 161 | 162 | 0.02 2013-06-03 163 | - packaging and pod fixes 164 | 165 | 0.01 2013-06-03 166 | - Initial release 167 | -------------------------------------------------------------------------------- /bin/reply: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | # PODNAME: reply 5 | # ABSTRACT: read, eval, print, loop, yay! 6 | 7 | use Reply::App; 8 | 9 | =head1 SYNOPSIS 10 | 11 | reply [-lb] [-I dir] [-M mod] [--version] [--help] [--cfg file] 12 | 13 | =head1 DESCRIPTION 14 | 15 | This script runs the L shell. It looks for a configuration file in 16 | C<.replyrc> in your home directory, and will generate a basic configuration for 17 | you if that file does not exist. 18 | 19 | See the L documentation for more information about using and configuring 20 | this program. 21 | 22 | =head1 OPTIONS 23 | 24 | reply takes these command line options: 25 | 26 | =over 4 27 | 28 | =item -I lib 29 | 30 | Adds the given directory to C<@INC>. 31 | 32 | =item -l 33 | 34 | Equivalent to C<-I lib>. 35 | 36 | =item -b 37 | 38 | Equivalent to C<-I blib/lib -I blib/arch>. 39 | 40 | =item -M Carp::Always 41 | 42 | Loads the specified module before starting the repl. It is loaded within the 43 | repl, so things like exporting work properly. 44 | 45 | =item --cfg ~/.replyrc 46 | 47 | Specifies a different configuration file to use. C<~/.replyrc> is the default. 48 | 49 | =item --version 50 | 51 | Displays the program version. 52 | 53 | =item --help 54 | 55 | Displays usage information. 56 | 57 | =back 58 | 59 | =cut 60 | 61 | exit(Reply::App->new->run(@ARGV)); 62 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Reply 2 | author = Jesse Luehrs 3 | license = MIT 4 | copyright_holder = Jesse Luehrs 5 | 6 | [FileFinder::Filter / WeaverFiles] 7 | finder = :InstallModules 8 | finder = :ExecFiles 9 | skip = ^lib/Reply/Plugin/Defaults.pm$ 10 | skip = ^lib/Reply/Util.pm$ 11 | 12 | [@DOY] 13 | :version = 0.14 14 | dist = Reply 15 | repository = github 16 | Test::Compile_skip = ::(?:CollapseStack|Nopaste|DataDump|DataPrinter|Editor|AutoRefresh|Autocomplete::Keywords|Pager)$ 17 | PodWeaver_finder = WeaverFiles 18 | 19 | [MetaNoIndex] 20 | package = Reply::Plugin::Defaults 21 | package = Reply::Util 22 | 23 | [AutoPrereqs] 24 | skip = ^App::Nopaste$ 25 | skip = ^B::Keywords$ 26 | skip = ^Carp::Always$ 27 | skip = ^Class::Refresh$ 28 | skip = ^Data::Dump$ 29 | skip = ^Data::Printer$ 30 | skip = ^IO::Pager$ 31 | skip = ^mro$ 32 | skip = ^MRO::Compat$ 33 | skip = ^Proc::InvokeEditor$ 34 | skip = ^Term::ReadKey$ 35 | skip = ^Win32::Console::ANSI$ 36 | 37 | [Prereqs] 38 | Devel::LexAlias = 0 39 | 40 | [Prereqs / RuntimeRecommends] 41 | App::Nopaste = 0 42 | B::Keywords = 0 43 | Carp::Always = 0 44 | Class::Refresh = 0.05 45 | Data::Dump = 0 46 | Data::Printer = 0 47 | IO::Pager = 0 48 | Proc::InvokeEditor = 0 49 | Term::ReadKey = 0 50 | Term::ReadLine::Gnu = 0 51 | 52 | ; XXX it'd be nice if we could make this recommended instead of required 53 | [OSPrereqs / MSWin32] 54 | Win32::Console::ANSI = 0 55 | 56 | [PerlVersionPrereqs / 5.010] 57 | MRO::Compat = 0 58 | -------------------------------------------------------------------------------- /lib/Reply.pm: -------------------------------------------------------------------------------- 1 | package Reply; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: read, eval, print, loop, yay! 5 | 6 | use Module::Runtime qw(compose_module_name require_module); 7 | use Scalar::Util qw(blessed weaken); 8 | use Try::Tiny; 9 | 10 | use Reply::Config; 11 | 12 | =head1 SYNOPSIS 13 | 14 | use Reply; 15 | 16 | Reply->new(config => "$ENV{HOME}/.replyrc")->run; 17 | 18 | =head1 DESCRIPTION 19 | 20 | NOTE: This is an early release, and implementation details of this module are 21 | still very much in flux. Feedback is welcome! 22 | 23 | Reply is a lightweight, extensible REPL for Perl. It is plugin-based (see 24 | L), and through plugins supports many advanced features such as 25 | coloring and pretty printing, readline support, and pluggable commands. 26 | 27 | =head1 CONFIGURATION 28 | 29 | Configuration uses an INI-style format similar to the configuration format of 30 | L. Section names are used as the names of plugins, and any options 31 | within a section are passed as arguments to that plugin. Plugins are loaded in 32 | order as they are listed in the configuration file, which can affect the 33 | results in some cases where multiple plugins are hooking into a single callback 34 | (see L for more information). 35 | 36 | In addition to plugin configuration, there are some additional options 37 | recognized. These must be specified at the top of the file, before any section 38 | headers. 39 | 40 | =over 4 41 | 42 | =item script_file 43 | 44 | This contains a filename whose contents will be evaluated as perl code once the 45 | configuration is done being loaded. 46 | 47 | =item script_line> 48 | 49 | Any options that start with C will be sorted by their key and then 50 | each value will be evaluated individually once the configuration is done being 51 | loaded. 52 | 53 | NOTE: this is currently a hack due to the fact that L doesn't 54 | support multiple keys with the same name in a section. This may be fixed in the 55 | future to just allow specifying C multiple times. 56 | 57 | =back 58 | 59 | =cut 60 | 61 | =method new(%opts) 62 | 63 | Creates a new Reply instance. Valid options are: 64 | 65 | =over 4 66 | 67 | =item config 68 | 69 | Name of a configuration file to load. This should contain INI-style 70 | configuration for plugins as described above. 71 | 72 | =item plugins 73 | 74 | An arrayref of additional plugins to load. 75 | 76 | =back 77 | 78 | =cut 79 | 80 | sub new { 81 | my $class = shift; 82 | my %opts = @_; 83 | 84 | my $self = bless {}, $class; 85 | 86 | $self->{plugins} = []; 87 | $self->{_default_plugin} = $self->_instantiate_plugin('Defaults'); 88 | 89 | if (defined $opts{config}) { 90 | if (!ref($opts{config})) { 91 | $opts{config} = Reply::Config->new(file => $opts{config}); 92 | } 93 | $self->_load_config($opts{config}); 94 | } 95 | 96 | $self->_load_plugin($_) for @{ $opts{plugins} || [] }; 97 | 98 | return $self; 99 | } 100 | 101 | =method run 102 | 103 | Runs the repl. Will continue looping until the C callback returns 104 | undef (typically when the user presses C), or the C callback 105 | returns false (by default, the C<#q> command quits the repl in this way). 106 | 107 | =cut 108 | 109 | sub run { 110 | my $self = shift; 111 | 112 | while (1) { 113 | my $continue = $self->step; 114 | last unless $continue; 115 | } 116 | print "\n"; 117 | } 118 | 119 | =method step($line, $verbose) 120 | 121 | Runs a single iteration of the repl. If C<$line> is given, it will be used as 122 | the string to evaluate (and the C and C callbacks will not 123 | be called). If C<$verbose> is true, the prompt and line will be displayed as 124 | though they were typed. Returns true if the repl can continue, and false if it 125 | was requested to quit. 126 | 127 | =cut 128 | 129 | sub step { 130 | my $self = shift; 131 | my ($line, $verbose) = @_; 132 | 133 | if (defined $line) { 134 | print $self->_wrapped_plugin('prompt'), $line, "\n" 135 | if $verbose; 136 | } 137 | else { 138 | $line = $self->_read; 139 | } 140 | 141 | return unless defined $line; 142 | 143 | $line = $self->_preprocess_line($line); 144 | 145 | try { 146 | my @result = $self->_eval($line); 147 | $self->_print_result(@result); 148 | } 149 | catch { 150 | $self->_print_error($_); 151 | }; 152 | 153 | my ($continue) = $self->_loop; 154 | return $continue; 155 | } 156 | 157 | sub _load_config { 158 | my $self = shift; 159 | my ($config) = @_; 160 | 161 | my $data = $config->data; 162 | 163 | my $root_config; 164 | for my $section (@$data) { 165 | my ($name, $data) = @$section; 166 | if ($name eq '_') { 167 | $root_config = $data; 168 | } 169 | else { 170 | $self->_load_plugin($name => $data); 171 | } 172 | } 173 | 174 | for my $line (sort grep { /^script_line/ } keys %$root_config) { 175 | $self->step($root_config->{$line}); 176 | } 177 | 178 | if (defined(my $file = $root_config->{script_file})) { 179 | my $contents = do { 180 | open my $fh, '<', $file or die "Couldn't open $file: $!"; 181 | local $/ = undef; 182 | <$fh> 183 | }; 184 | $self->step($contents); 185 | } 186 | } 187 | 188 | sub _load_plugin { 189 | my $self = shift; 190 | my ($plugin, $opts) = @_; 191 | 192 | $plugin = $self->_instantiate_plugin($plugin, $opts); 193 | 194 | push @{ $self->{plugins} }, $plugin; 195 | } 196 | 197 | sub _instantiate_plugin { 198 | my $self = shift; 199 | my ($plugin, $opts) = @_; 200 | 201 | if (!blessed($plugin)) { 202 | $plugin = compose_module_name("Reply::Plugin", $plugin); 203 | require_module($plugin); 204 | die "$plugin is not a valid plugin" 205 | unless $plugin->isa("Reply::Plugin"); 206 | 207 | my $weakself = $self; 208 | weaken($weakself); 209 | 210 | $plugin = $plugin->new( 211 | %$opts, 212 | publisher => sub { $weakself->_publish(@_) }, 213 | ); 214 | } 215 | 216 | return $plugin; 217 | } 218 | 219 | sub _plugins { 220 | my $self = shift; 221 | 222 | return ( 223 | @{ $self->{plugins} }, 224 | $self->{_default_plugin}, 225 | ); 226 | } 227 | 228 | sub _read { 229 | my $self = shift; 230 | 231 | my $prompt = $self->_wrapped_plugin('prompt'); 232 | return $self->_wrapped_plugin('read_line', $prompt); 233 | } 234 | 235 | sub _preprocess_line { 236 | my $self = shift; 237 | my ($line) = @_; 238 | 239 | if ($line =~ s/^#(\w+)(?:\s+|$)//) { 240 | ($line) = $self->_chained_plugin("command_\L$1", $line); 241 | } 242 | 243 | return "\n#line 1 \"reply input\"\n$line"; 244 | } 245 | 246 | sub _eval { 247 | my $self = shift; 248 | my ($line) = @_; 249 | 250 | ($line) = $self->_chained_plugin('mangle_line', $line) 251 | if defined $line; 252 | 253 | my ($code) = $self->_wrapped_plugin('compile', $line); 254 | return $self->_wrapped_plugin('execute', $code); 255 | } 256 | 257 | sub _print_error { 258 | my $self = shift; 259 | my ($error) = @_; 260 | 261 | ($error) = $self->_chained_plugin('mangle_error', $error); 262 | $self->_wrapped_plugin('print_error', $error); 263 | } 264 | 265 | sub _print_result { 266 | my $self = shift; 267 | my (@result) = @_; 268 | 269 | @result = $self->_chained_plugin('mangle_result', @result); 270 | $self->_wrapped_plugin('print_result', @result); 271 | } 272 | 273 | sub _loop { 274 | my $self = shift; 275 | 276 | $self->_chained_plugin('loop', 1); 277 | } 278 | 279 | sub _publish { 280 | my $self = shift; 281 | 282 | $self->_concatenate_plugin(@_); 283 | } 284 | 285 | sub _wrapped_plugin { 286 | my $self = shift; 287 | my @plugins = ref($_[0]) ? @{ shift() } : $self->_plugins; 288 | my ($method, @args) = @_; 289 | 290 | @plugins = grep { $_->can($method) } @plugins; 291 | 292 | return @args unless @plugins; 293 | 294 | my $plugin = shift @plugins; 295 | my $next = sub { $self->_wrapped_plugin(\@plugins, $method, @_) }; 296 | 297 | return $plugin->$method($next, @args); 298 | } 299 | 300 | sub _chained_plugin { 301 | my $self = shift; 302 | my @plugins = ref($_[0]) ? @{ shift() } : $self->_plugins; 303 | my ($method, @args) = @_; 304 | 305 | @plugins = grep { $_->can($method) } @plugins; 306 | 307 | for my $plugin (@plugins) { 308 | @args = $plugin->$method(@args); 309 | } 310 | 311 | return @args; 312 | } 313 | 314 | sub _concatenate_plugin { 315 | my $self = shift; 316 | my @plugins = ref($_[0]) ? @{ shift() } : $self->_plugins; 317 | my ($method, @args) = @_; 318 | 319 | @plugins = grep { $_->can($method) } @plugins; 320 | 321 | my @results; 322 | 323 | for my $plugin (@plugins) { 324 | push @results, $plugin->$method(@args); 325 | } 326 | 327 | return @results; 328 | } 329 | 330 | =head1 BUGS 331 | 332 | No known bugs. 333 | 334 | Please report any bugs to GitHub Issues at 335 | L. 336 | 337 | =head1 SEE ALSO 338 | 339 | L 340 | 341 | =head1 SUPPORT 342 | 343 | You can find this documentation for this module with the perldoc command. 344 | 345 | perldoc Reply 346 | 347 | You can also look for information at: 348 | 349 | =over 4 350 | 351 | =item * MetaCPAN 352 | 353 | L 354 | 355 | =item * Github 356 | 357 | L 358 | 359 | =item * RT: CPAN's request tracker 360 | 361 | L 362 | 363 | =item * CPAN Ratings 364 | 365 | L 366 | 367 | =back 368 | 369 | =cut 370 | 371 | 1; 372 | -------------------------------------------------------------------------------- /lib/Reply/App.pm: -------------------------------------------------------------------------------- 1 | package Reply::App; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: command line app runner for Reply 5 | 6 | use Getopt::Long 2.36 'GetOptionsFromArray'; 7 | 8 | use Reply; 9 | use Reply::Config; 10 | 11 | =head1 SYNOPSIS 12 | 13 | use Reply::App; 14 | exit(Reply::App->new->run(@ARGV)); 15 | 16 | =head1 DESCRIPTION 17 | 18 | This module encapsulates the various bits of functionality related to running 19 | L as a command line application. 20 | 21 | =cut 22 | 23 | =method new 24 | 25 | Returns a new Reply::App instance. Takes no arguments. 26 | 27 | =cut 28 | 29 | sub new { bless {}, shift } 30 | 31 | =method run(@argv) 32 | 33 | Parses the argument list given (typically from @ARGV), along with the user's configuration file, and attempts to start a Reply shell. A default configuration file will be generated for the user if none exists. 34 | 35 | =cut 36 | 37 | sub run { 38 | my $self = shift; 39 | my @argv = @_; 40 | 41 | Getopt::Long::Configure("gnu_getopt"); 42 | 43 | my $cfgfile = '.replyrc'; 44 | my $exitcode; 45 | my (@modules, @script_lines, @files); 46 | my $parsed = GetOptionsFromArray( 47 | \@argv, 48 | 'cfg:s' => \$cfgfile, 49 | 'l|lib' => sub { unshift @INC, 'lib' }, 50 | 'b|blib' => sub { unshift @INC, 'blib/lib', 'blib/arch' }, 51 | 'I:s@' => sub { unshift @INC, $_[1] }, 52 | 'M:s@' => \@modules, 53 | 'e:s@' => \@script_lines, 54 | 'version' => sub { $exitcode = 0; version() }, 55 | 'help' => sub { $exitcode = 0; usage() }, 56 | ); 57 | 58 | @files = @argv; 59 | for my $file (@files) { 60 | if (!stat $file) { 61 | die "Can't read $file: $!"; 62 | } 63 | } 64 | 65 | if (!$parsed) { 66 | usage(1); 67 | $exitcode = 1; 68 | } 69 | 70 | return $exitcode if defined $exitcode; 71 | 72 | my $cfg = Reply::Config->new(file => $cfgfile); 73 | 74 | my %args = (config => $cfg); 75 | my $file = $cfg->file; 76 | if (!-e $file) { 77 | print("$file not found. Generating a default...\n"); 78 | unless ($self->generate_default_config($file)) { 79 | %args = (); 80 | } 81 | } 82 | 83 | my $reply = Reply->new(%args); 84 | $reply->step("use $_") for @modules; 85 | $reply->step($_, 1) for @script_lines; 86 | $reply->step('do "' . quotemeta($_) . '"', 1) for @files; 87 | $reply->run; 88 | 89 | return 0; 90 | } 91 | 92 | =method generate_default_config($file) 93 | 94 | Generates default configuration file as per specified destination. 95 | 96 | =cut 97 | 98 | sub generate_default_config { 99 | my $self = shift; 100 | my ($file) = @_; 101 | 102 | if (open my $fh, '>', $file) { 103 | my $contents = do { 104 | local $/; 105 | 106 | }; 107 | $contents =~ s/use 5.XXX/use $]/; 108 | print $fh $contents; 109 | close $fh; 110 | 111 | return 1; 112 | } 113 | else { 114 | warn "Couldn't write to $file"; 115 | 116 | return 0; 117 | } 118 | } 119 | 120 | =method usage($exitcode) 121 | 122 | Prints usage information to the screen. If C<$exitcode> is 0, it will be 123 | printed to C, otherwise it will be printed to C. 124 | 125 | =cut 126 | 127 | sub usage { 128 | my $fh = $_[0] ? *STDERR : *STDOUT; 129 | print $fh " reply [-lb] [-I dir] [-M mod] [--version] [--help] [--cfg file]\n"; 130 | } 131 | 132 | =method version($exitcode) 133 | 134 | Prints version information to the screen. If C<$exitcode> is 0, it will be 135 | printed to C, otherwise it will be printed to C. 136 | 137 | =cut 138 | 139 | sub version { 140 | my $fh = $_[0] ? *STDERR : *STDOUT; 141 | print $fh "Reply version $Reply::VERSION\n"; 142 | } 143 | 144 | 1; 145 | 146 | __DATA__ 147 | script_line1 = use strict 148 | script_line2 = use warnings 149 | script_line3 = use 5.XXX 150 | 151 | [Interrupt] 152 | [FancyPrompt] 153 | [DataDumper] 154 | [Colors] 155 | [ReadLine] 156 | [Hints] 157 | [Packages] 158 | [LexicalPersistence] 159 | [ResultCache] 160 | [Autocomplete::Packages] 161 | [Autocomplete::Lexicals] 162 | [Autocomplete::Functions] 163 | [Autocomplete::Globals] 164 | [Autocomplete::Methods] 165 | [Autocomplete::Commands] 166 | -------------------------------------------------------------------------------- /lib/Reply/Config.pm: -------------------------------------------------------------------------------- 1 | package Reply::Config; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: config loading for Reply 5 | 6 | use Config::INI::Reader::Ordered; 7 | use File::HomeDir; 8 | use File::Spec; 9 | 10 | =head1 SYNOPSIS 11 | 12 | use Reply; 13 | use Reply::Config; 14 | 15 | Reply->new(config => Reply::Config->new(file => 'something_else'))->run; 16 | 17 | =head1 DESCRIPTION 18 | 19 | This class abstracts out the config file loading, so that other applications 20 | can start up Reply shells using similar logic. Reply configuration is specified 21 | in an INI format - see L for more details. 22 | 23 | =cut 24 | 25 | =method new(%opts) 26 | 27 | Creates a new config object. Valid options are: 28 | 29 | =over 4 30 | 31 | =item file 32 | 33 | Configuration file to use. If the file is specified by a relative path, it will 34 | be relative to the user's home directory, otherwise it will be used as-is. 35 | 36 | =back 37 | 38 | =cut 39 | 40 | sub new { 41 | my $class = shift; 42 | my %opts = @_; 43 | 44 | $opts{file} = '.replyrc' 45 | unless defined $opts{file}; 46 | 47 | my $file = File::Spec->catfile( 48 | (File::Spec->file_name_is_absolute($opts{file}) 49 | ? () 50 | : (File::HomeDir->my_home)), 51 | $opts{file} 52 | ); 53 | 54 | my $self = bless {}, $class; 55 | 56 | $self->{file} = $file; 57 | $self->{config} = Config::INI::Reader::Ordered->new; 58 | 59 | return $self; 60 | } 61 | 62 | =method file 63 | 64 | Returns the absolute path to the config file that is to be used. 65 | 66 | =cut 67 | 68 | sub file { shift->{file} } 69 | 70 | =method data 71 | 72 | Returns the loaded configuration data. 73 | 74 | =cut 75 | 76 | sub data { 77 | my $self = shift; 78 | 79 | return $self->{config}->read_file($self->{file}); 80 | } 81 | 82 | 1; 83 | -------------------------------------------------------------------------------- /lib/Reply/Plugin.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: base class for Reply plugins 5 | 6 | use Reply::Util 'methods'; 7 | 8 | =head1 SYNOPSIS 9 | 10 | package Reply::Plugin::Foo; 11 | use strict; 12 | use warnings; 13 | 14 | use base 'Reply::Plugin'; 15 | 16 | # ... 17 | 18 | =head1 DESCRIPTION 19 | 20 | A L plugin is an object which adds some functionality to a Reply 21 | instance by implementing some specific methods which the Reply object will call 22 | at various points during execution. Plugins may implement as many callback 23 | methods as necessary to implement their functionality (although the more 24 | callbacks a given plugin implements, the more likely it is that the plugin may 25 | be more useful as multiple independent plugins). 26 | 27 | Callback methods have three potential calling conventions: 28 | 29 | =over 4 30 | 31 | =item wrapped 32 | 33 | Wrapped callbacks receive a coderef as their first argument (before any 34 | arguments to the callback itself), and that coderef can be used to call the 35 | next callback in the list (if more than one plugin implements a given 36 | callback). In particular, this allows calling the next plugin multiple times, 37 | or not at all if necessary. Wrapped plugins should always call their coderef in 38 | list context. All plugins listed below are wrapped plugins unless indicated 39 | otherwise. 40 | 41 | =item chained 42 | 43 | Chained callbacks receive a list of arguments, and return a new list of 44 | arguments which will be passed to the next plugin in the chain. This allows 45 | each plugin a chance to modify a value before it's actually used by the repl. 46 | 47 | =item concatenate 48 | 49 | Concatenate callbacks receive a list of arguments, and return a list of 50 | response values. Each plugin that implements the given callback will be called 51 | with the same arguments, and the results will be concatenated together into a 52 | single list, which will be returned. Callbacks for published messages are of 53 | this type. 54 | 55 | =back 56 | 57 | =head2 CALLBACKS 58 | 59 | =over 4 60 | 61 | =item prompt 62 | 63 | Called to determine the prompt to use when reading the next line. Takes no 64 | arguments, and returns a single string to use as the prompt. The default 65 | implementation returns C<< ">" >> 66 | 67 | =item read_line 68 | 69 | Called to actually read a line from the user. Takes no arguments, and returns a 70 | single string. The default implementation uses the C<< <> >> operator to read a 71 | single line from C. 72 | 73 | =item command_C<$name> (chained) 74 | 75 | If the line read from the user is of the form C<"#foo args...">, then plugins 76 | will be searched for a callback method named C. This callback 77 | takes a single string containing the provided arguments, and returns a new line 78 | to evaluate instead, if any. 79 | 80 | =item mangle_line (chained) 81 | 82 | Modifies the line read from the user before it's evaluated. Takes the line as a 83 | string and returns the modified line. 84 | 85 | =item compile 86 | 87 | Compiles the string of Perl code into a coderef. Takes the line of code as a 88 | string and a hash of extra parameters, and returns the coderef to be executed. 89 | The default implementation uses L to compile the given string. 90 | 91 | The hash of extra parameters is passed directly to C. 92 | 93 | =item execute 94 | 95 | Executes the coderef which has just been compiled. Takes the coderef and a list 96 | of parameters to pass to it, and returns the list of results returned by 97 | calling the coderef. The default implementation just calls the coderef 98 | directly. 99 | 100 | =item mangle_error (chained) 101 | 102 | If the C or C callbacks throw an exception, this callback 103 | will be called to modify the exception before it is passed to C. 104 | It receives the exception and returns the modified exception. 105 | 106 | =item print_error 107 | 108 | If the C or C callbacks throw an exception, this callback 109 | will be called to display it to the user. It receives the exception and returns 110 | nothing. The default implementation just uses C to print it to the 111 | screen. 112 | 113 | =item mangle_result (chained) 114 | 115 | This callback is used to modify the result of evaluating the line of code 116 | before it is displayed. It receives the list of results and returns a modified 117 | list of results. 118 | 119 | =item print_result 120 | 121 | This callback displays to the user the results of evaluating the given line of 122 | code. It receives the list of results, and returns nothing. The default 123 | implementation just uses C to print them to the screen. 124 | 125 | =item loop (chained) 126 | 127 | This callback is called at the end of each evaluation. It receives whether the 128 | repl has been requested to terminate so far, and returns whether the repl 129 | should terminate. 130 | 131 | =back 132 | 133 | Reply plugins can also communicate among each other via a pub/sub mechanism. By 134 | calling the C method, all plugins which respond to the given message 135 | (implement a method of the given name) will have that method called with the 136 | given arguments, and all of the responses will be collected and returned. Some 137 | messages used by the default plugins are: 138 | 139 | =over 4 140 | 141 | =item tab_handler ($line) 142 | 143 | Plugins can publish this message when they want to attempt tab completion. 144 | Plugins that respond to this message should return a list of potential 145 | completions of the line which is passed in. 146 | 147 | =item lexical_environment 148 | 149 | Plugins which wish to modify the lexical environment should do so by 150 | implementing this message, which should return a hashref of variable names 151 | (including sigils) to value references. There can be more than one lexical 152 | environment (each maintained by a different plugin), so plugins that wish to 153 | inspect the lexical environment should do so by calling 154 | C<< $self->publish('lexical_environment') >>, and then merging together all of 155 | the hashrefs which are returned. 156 | 157 | =item package 158 | 159 | Plugins which wish to modify the currently active package should do so by 160 | implementing this message, which should return the name of the current package. 161 | Then, to access the currently active package, a plugin can call 162 | C<< ($self->publish('package'))[-1] >>. 163 | 164 | =back 165 | 166 | Your plugins, however, are not limited to these messages - you can use whatever 167 | messages you want to communicate. 168 | 169 | =cut 170 | 171 | sub new { 172 | my $class = shift; 173 | my (%opts) = @_; 174 | 175 | die "publisher is required" unless $opts{publisher}; 176 | 177 | return bless { 178 | publisher => $opts{publisher}, 179 | }, $class; 180 | } 181 | 182 | =method publish ($name, @args) 183 | 184 | Publish a message to other plugins which respond to it. All loaded plugins 185 | which implement a method named C<$name> will have it called with C<@args> as 186 | the parameters. Returns a list of everything that each plugin responded with. 187 | 188 | =cut 189 | 190 | sub publish { 191 | my $self = shift; 192 | 193 | $self->{publisher}->(@_); 194 | } 195 | 196 | =method commands 197 | 198 | Returns the names of the C<#> commands that this plugin implements. This can 199 | be used in conjunction with C - C<< $plugin->publish('commands') >> 200 | will return a list of all commands which are available in the current Reply 201 | session. 202 | 203 | =cut 204 | 205 | sub commands { 206 | my $self = shift; 207 | 208 | return map { s/^command_//; $_ } grep { /^command_/ } methods($self); 209 | } 210 | 211 | =for Pod::Coverage 212 | new 213 | 214 | =cut 215 | 216 | 1; 217 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/AutoRefresh.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::AutoRefresh; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: automatically refreshes the external code you use 5 | 6 | use base 'Reply::Plugin'; 7 | use Class::Refresh 0.05 (); 8 | 9 | =head1 SYNOPSIS 10 | 11 | ; .replyrc 12 | [AutoRefresh] 13 | track_require = 1 14 | 15 | =head1 DESCRIPTION 16 | 17 | This plugin automatically refreshes all loaded modules before every 18 | statement execution. It's useful if you are working on a module in 19 | a file and you want the changes to automatically be loaded in Reply. 20 | 21 | It takes a single argument, C, which defaults to true. 22 | If this option is set, the C functionality from 23 | L will be enabled. 24 | 25 | Note that to use the C functionality, this module must 26 | be loaded as early as possible (preferably first), so that other 27 | modules correctly see the global override. 28 | 29 | =cut 30 | 31 | sub new { 32 | my $class = shift; 33 | my %opts = @_; 34 | 35 | $opts{track_require} = 1 36 | unless defined $opts{track_require}; 37 | 38 | Class::Refresh->import(track_require => $opts{track_require}); 39 | 40 | # so that when we load things after this plugin, they get a copy of 41 | # Module::Runtime which has the call to require() rebound to our overridden 42 | # copy. if this plugin is loaded first, these should be the only 43 | # modules loaded so far which load arbitrary user-specified modules. 44 | Class::Refresh->refresh_module('Module::Runtime'); 45 | Class::Refresh->refresh_module('base'); 46 | 47 | return $class->SUPER::new(@_); 48 | } 49 | 50 | sub compile { 51 | my $self = shift; 52 | my ($next, @args) = @_; 53 | 54 | Class::Refresh->refresh; 55 | $next->(@args); 56 | } 57 | 58 | 1; 59 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Autocomplete/Commands.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Autocomplete::Commands; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: tab completion for reply commands 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | =head1 SYNOPSIS 9 | 10 | ; .replyrc 11 | [ReadLine] 12 | [Autocomplete::Commands] 13 | 14 | =head1 DESCRIPTION 15 | 16 | This plugin registers a tab key handler to autocomplete Reply commands. 17 | 18 | =cut 19 | 20 | sub tab_handler { 21 | my $self = shift; 22 | my ($line) = @_; 23 | 24 | my ($prefix) = $line =~ /^#(.*)/; 25 | return unless defined $prefix; 26 | 27 | my @commands = $self->publish('commands'); 28 | 29 | return map { "#$_" } sort grep { index($_, $prefix) == 0 } @commands; 30 | } 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Autocomplete/Functions.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Autocomplete::Functions; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: tab completion for function names 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Module::Runtime '$module_name_rx'; 9 | use Package::Stash; 10 | 11 | =head1 SYNOPSIS 12 | 13 | ; .replyrc 14 | [ReadLine] 15 | [Autocomplete::Functions] 16 | 17 | =head1 DESCRIPTION 18 | 19 | This plugin registers a tab key handler to autocomplete function names in Perl 20 | code, including imported functions. 21 | 22 | =cut 23 | 24 | sub tab_handler { 25 | my $self = shift; 26 | my ($line) = @_; 27 | 28 | my ($before, $fragment) = $line =~ /(.*?)(${module_name_rx}(::)?)$/; 29 | return unless $fragment; 30 | return if $before =~ /^#/; # commands 31 | 32 | my $current_package = ($self->publish('package'))[-1]; 33 | 34 | my ($package, $func); 35 | if ($fragment =~ /:/) { 36 | ($package, $func) = ($fragment =~ /^(.+:)(\w*)$/); 37 | $func = '' unless defined $func; 38 | $package =~ s/:{1,2}$//; 39 | } 40 | else { 41 | $package = $current_package; 42 | $func = $fragment; 43 | } 44 | 45 | return 46 | map { $package eq $current_package ? $_ : "$package\::$_" } 47 | grep { $func ? /^\Q$func/ : 1 } 48 | 'Package::Stash'->new($package)->list_all_symbols('CODE'); 49 | } 50 | 51 | 1; 52 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Autocomplete/Globals.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Autocomplete::Globals; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: tab completion for global variables 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Package::Stash; 9 | 10 | use Reply::Util qw($fq_ident_rx $fq_varname_rx); 11 | 12 | =head1 SYNOPSIS 13 | 14 | ; .replyrc 15 | [ReadLine] 16 | [Autocomplete::Globals] 17 | 18 | =head1 DESCRIPTION 19 | 20 | This plugin registers a tab key handler to autocomplete global variables in 21 | Perl code. 22 | 23 | =cut 24 | 25 | sub new { 26 | my $class = shift; 27 | 28 | my $self = $class->SUPER::new(@_); 29 | 30 | return $self; 31 | } 32 | 33 | sub tab_handler { 34 | my $self = shift; 35 | my ($line) = @_; 36 | 37 | my ($maybe_var) = $line =~ /($fq_varname_rx)$/; 38 | return unless $maybe_var; 39 | $maybe_var =~ s/\s+//g; 40 | 41 | my ($sigil, $rest) = $maybe_var =~ /(.)(.*)/; 42 | 43 | my @parts = split '::', $rest, -1; 44 | return if grep { /:/ } @parts; 45 | return if @parts && $parts[0] =~ /^[0-9]/; 46 | 47 | my $var_prefix = pop @parts; 48 | $var_prefix = '' unless defined $var_prefix; 49 | 50 | my $stash_name = join('::', @parts); 51 | my $stash = eval { 52 | Package::Stash->new(@parts ? $stash_name : 'main') 53 | }; 54 | return unless $stash; 55 | 56 | my @symbols = map { s/^(.)main::/$1/; $_ } _recursive_symbols($stash); 57 | 58 | my $prefix = $stash_name 59 | ? $stash_name . '::' . $var_prefix 60 | : $var_prefix; 61 | 62 | my @results; 63 | for my $global (@symbols) { 64 | my ($global_sigil, $global_name) = $global =~ /(.)(.*)/; 65 | next unless index($global_name, $prefix) == 0; 66 | 67 | # this is weird, not sure why % gets stripped but not $ or @ 68 | if ($sigil eq $global_sigil) { 69 | push @results, $sigil eq '%' ? $global : $global_name; 70 | } 71 | elsif ($global_sigil eq '@' && $sigil eq '$') { 72 | push @results, "$global_name\["; 73 | } 74 | elsif ($global_sigil eq '%') { 75 | push @results, "$global_name\{"; 76 | } 77 | } 78 | 79 | return @results; 80 | } 81 | 82 | sub _recursive_symbols { 83 | my ($stash) = @_; 84 | 85 | my $stash_name = $stash->name; 86 | 87 | my @symbols; 88 | for my $name ($stash->list_all_symbols) { 89 | # main can have things in it like "_new(join('::', $stash_name, $name)); 99 | next if $next->namespace == $stash->namespace; 100 | push @symbols, _recursive_symbols($next); 101 | } 102 | else { 103 | push @symbols, "\$${stash_name}::$name" 104 | if $stash->has_symbol("\$$name"); 105 | push @symbols, "\@${stash_name}::$name" 106 | if $stash->has_symbol("\@$name"); 107 | push @symbols, "\%${stash_name}::$name" 108 | if $stash->has_symbol("\%$name"); 109 | push @symbols, "\&${stash_name}::$name" 110 | if $stash->has_symbol("\&$name"); 111 | push @symbols, "\*${stash_name}::$name" 112 | if $stash->has_symbol($name); 113 | } 114 | } 115 | 116 | return @symbols; 117 | } 118 | 119 | 1; 120 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Autocomplete/Keywords.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Autocomplete::Keywords; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: tab completion for perl keywords 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use B::Keywords qw/@Functions @Barewords/; 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [ReadLine] 14 | [Autocomplete::Keywords] 15 | 16 | =head1 DESCRIPTION 17 | 18 | This plugin registers a tab key handler to autocomplete keywords in Perl code. 19 | 20 | =cut 21 | 22 | sub tab_handler { 23 | my $self = shift; 24 | my ($line) = @_; 25 | 26 | my ($before, $last_word) = $line =~ /(.*?)(\w+)$/; 27 | return unless $last_word; 28 | return if $before =~ /^#/; # command 29 | return if $before =~ /::$/; # Package::function call 30 | return if $before =~ /->\s*$/; # method call 31 | return if $before =~ /[\$\@\%\&\*]\s*$/; 32 | 33 | my $re = qr/^\Q$last_word/; 34 | 35 | return grep { $_ =~ $re } @Functions, @Barewords; 36 | } 37 | 38 | 1; 39 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Autocomplete/Lexicals.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Autocomplete::Lexicals; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: tab completion for lexical variables 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Reply::Util qw($varname_rx); 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [ReadLine] 14 | [Autocomplete::Lexicals] 15 | 16 | =head1 DESCRIPTION 17 | 18 | This plugin registers a tab key handler to autocomplete lexical variables in 19 | Perl code. 20 | 21 | =cut 22 | 23 | sub tab_handler { 24 | my $self = shift; 25 | my ($line) = @_; 26 | 27 | my ($var) = $line =~ /($varname_rx)$/; 28 | return unless $var; 29 | 30 | my ($sigil, $name_prefix) = $var =~ /(.)(.*)/; 31 | 32 | # these can't be lexicals 33 | return if $sigil eq '&' || $sigil eq '*'; 34 | 35 | my $env = { map { %$_ } $self->publish('lexical_environment') }; 36 | my @env = keys %$env; 37 | 38 | my @results; 39 | for my $env_var (@env) { 40 | my ($env_sigil, $env_name) = $env_var =~ /(.)(.*)/; 41 | 42 | next unless index($env_name, $name_prefix) == 0; 43 | 44 | # this is weird, not sure why % gets stripped but not $ or @ 45 | if ($sigil eq $env_sigil) { 46 | push @results, $sigil eq '%' ? $env_var : $env_name; 47 | } 48 | elsif ($env_sigil eq '@' && $sigil eq '$') { 49 | push @results, "$env_name\["; 50 | } 51 | elsif ($env_sigil eq '%') { 52 | push @results, "$env_name\{"; 53 | } 54 | } 55 | 56 | return @results; 57 | } 58 | 59 | 1; 60 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Autocomplete/Methods.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Autocomplete::Methods; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: tab completion for methods 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Scalar::Util 'blessed'; 9 | 10 | use Reply::Util qw($ident_rx $fq_ident_rx $fq_varname_rx methods); 11 | 12 | =head1 SYNOPSIS 13 | 14 | ; .replyrc 15 | [ReadLine] 16 | [Autocomplete::Methods] 17 | 18 | =head1 DESCRIPTION 19 | 20 | This plugin registers a tab key handler to autocomplete method names in Perl 21 | code. 22 | 23 | =cut 24 | 25 | sub tab_handler { 26 | my $self = shift; 27 | my ($line) = @_; 28 | 29 | my ($invocant, $method_prefix) = $line =~ /($fq_varname_rx|$fq_ident_rx)->($ident_rx)?$/; 30 | return unless $invocant; 31 | # XXX unicode 32 | return unless $invocant =~ /^[\$A-Z_a-z]/; 33 | 34 | $method_prefix = '' unless defined $method_prefix; 35 | 36 | my $class; 37 | if ($invocant =~ /^\$/) { 38 | # XXX should support globals here 39 | my $env = { 40 | map { %$_ } $self->publish('lexical_environment'), 41 | }; 42 | my $var = $env->{$invocant}; 43 | return unless $var && ref($var) eq 'REF' && blessed($$var); 44 | $class = blessed($$var); 45 | } 46 | else { 47 | $class = $invocant; 48 | } 49 | 50 | my @results; 51 | for my $method (methods($class)) { 52 | push @results, $method if index($method, $method_prefix) == 0; 53 | } 54 | 55 | return sort @results; 56 | } 57 | 58 | 1; 59 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Autocomplete/Packages.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Autocomplete::Packages; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: tab completion for package names 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Module::Runtime '$module_name_rx'; 9 | 10 | use Reply::Util 'all_packages'; 11 | 12 | =head1 SYNOPSIS 13 | 14 | ; .replyrc 15 | [ReadLine] 16 | [Autocomplete::Packages] 17 | 18 | =head1 DESCRIPTION 19 | 20 | This plugin registers a tab key handler to autocomplete package names in Perl 21 | code. 22 | 23 | =cut 24 | 25 | sub tab_handler { 26 | my $self = shift; 27 | my ($line) = @_; 28 | 29 | # $module_name_rx does not permit trailing :: 30 | my ($before, $package_fragment) = $line =~ /(.*?)(${module_name_rx}:?:?)$/; 31 | return unless $package_fragment; 32 | return if $before =~ /^#/; # command 33 | return if $before =~ /->\s*$/; # method call 34 | return if $before =~ /[\$\@\%\&\*]\s*$/; 35 | 36 | return sort grep { index($_, $package_fragment) == 0 } all_packages(); 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/CollapseStack.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::CollapseStack; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: display error stack traces only on demand 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | { 9 | local @SIG{qw(__DIE__ __WARN__)}; 10 | require Carp::Always; 11 | } 12 | 13 | =head1 SYNOPSIS 14 | 15 | ; .replyrc 16 | [CollapseStack] 17 | num_lines = 1 18 | 19 | =head1 DESCRIPTION 20 | 21 | This plugin hides stack traces until you specifically request them 22 | with the C<#stack> command. 23 | 24 | The number of lines of stack to always show is configurable; specify 25 | the C option. 26 | 27 | =cut 28 | 29 | sub new { 30 | my $class = shift; 31 | my %opts = @_; 32 | 33 | my $self = $class->SUPER::new(@_); 34 | $self->{num_lines} = $opts{num_lines} || 1; 35 | 36 | return $self; 37 | } 38 | 39 | sub compile { 40 | my $self = shift; 41 | my ($next, @args) = @_; 42 | 43 | local $SIG{__DIE__} = \&Carp::Always::_die; 44 | $next->(@args); 45 | } 46 | 47 | sub execute { 48 | my $self = shift; 49 | my ($next, @args) = @_; 50 | 51 | local $SIG{__DIE__} = \&Carp::Always::_die; 52 | $next->(@args); 53 | } 54 | 55 | sub mangle_error { 56 | my $self = shift; 57 | my $error = shift; 58 | 59 | $self->{full_error} = $error; 60 | 61 | my @lines = split /\n/, $error; 62 | if (@lines > $self->{num_lines}) { 63 | splice @lines, $self->{num_lines}; 64 | $error = join "\n", @lines, " (Run #stack to see the full trace)\n"; 65 | } 66 | 67 | return $error; 68 | } 69 | 70 | sub command_stack { 71 | my $self = shift; 72 | 73 | # XXX should use print_error here 74 | print($self->{full_error} || "No stack to display.\n"); 75 | 76 | return ''; 77 | } 78 | 79 | =for Pod::Coverage 80 | command_stack 81 | 82 | =cut 83 | 84 | 1; 85 | 86 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Colors.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Colors; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: colorize output 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Term::ANSIColor; 9 | BEGIN { 10 | if ($^O eq 'MSWin32') { 11 | require Win32::Console::ANSI; 12 | Win32::Console::ANSI->import; 13 | } 14 | } 15 | 16 | =head1 SYNOPSIS 17 | 18 | ; .replyrc 19 | [Colors] 20 | error = bright red 21 | warning = bright yellow 22 | result = bright green 23 | 24 | =head1 DESCRIPTION 25 | 26 | This plugin adds coloring to the results when they are printed to the screen. 27 | By default, errors are C, warnings are C, and normal results are 28 | C, although this can be overridden through configuration as shown in the 29 | synopsis. L is used to generate the colors, so any value that 30 | is accepted by that module is a valid value for the C, C, and 31 | C options. 32 | 33 | =cut 34 | 35 | sub new { 36 | my $class = shift; 37 | my %opts = @_; 38 | 39 | my $self = $class->SUPER::new(@_); 40 | $self->{error} = $opts{error} || 'red'; 41 | $self->{warning} = $opts{warning} || 'yellow'; 42 | $self->{result} = $opts{result} || 'green'; 43 | 44 | return $self; 45 | } 46 | 47 | sub compile { 48 | my $self = shift; 49 | my ($next, @args) = @_; 50 | 51 | local $SIG{__WARN__} = sub { $self->print_warn(@_) }; 52 | $next->(@args); 53 | } 54 | 55 | sub execute { 56 | my $self = shift; 57 | my ($next, @args) = @_; 58 | 59 | local $SIG{__WARN__} = sub { $self->print_warn(@_) }; 60 | $next->(@args); 61 | } 62 | 63 | sub print_error { 64 | my $self = shift; 65 | my ($next, $error) = @_; 66 | 67 | print color($self->{error}); 68 | $next->($error); 69 | local $| = 1; 70 | print color('reset'); 71 | } 72 | 73 | sub print_result { 74 | my $self = shift; 75 | my ($next, @result) = @_; 76 | 77 | print color($self->{result}); 78 | $next->(@result); 79 | local $| = 1; 80 | print color('reset'); 81 | } 82 | 83 | sub print_warn { 84 | my $self = shift; 85 | my ($warning) = @_; 86 | 87 | print color($self->{warning}); 88 | print $warning; 89 | local $| = 1; 90 | print color('reset'); 91 | } 92 | 93 | =for Pod::Coverage 94 | print_warn 95 | 96 | =cut 97 | 98 | 1; 99 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/DataDump.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::DataDump; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: format results using Data::Dump 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Data::Dump 'dumpf'; 9 | use overload (); 10 | 11 | =head1 SYNOPSIS 12 | 13 | ; .replyrc 14 | [DataDump] 15 | respect_stringification = 1 16 | 17 | =head1 DESCRIPTION 18 | 19 | This plugin uses L to format results. By default, if it reaches an 20 | object which has a stringification overload, it will dump that directly. To 21 | disable this behavior, set the C option to a false 22 | value. 23 | 24 | =cut 25 | 26 | sub new { 27 | my $class = shift; 28 | my %opts = @_; 29 | $opts{respect_stringification} = 1 30 | unless defined $opts{respect_stringification}; 31 | 32 | my $self = $class->SUPER::new(@_); 33 | $self->{filter} = sub { 34 | my ($ctx, $ref) = @_; 35 | return unless $ctx->is_blessed; 36 | my $stringify = overload::Method($ref, '""'); 37 | return unless $stringify; 38 | return { 39 | dump => $stringify->($ref), 40 | }; 41 | } if $opts{respect_stringification}; 42 | 43 | return $self; 44 | } 45 | 46 | sub mangle_result { 47 | my $self = shift; 48 | my (@result) = @_; 49 | return @result ? dumpf(@result, $self->{filter}) : (); 50 | } 51 | 52 | 1; 53 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/DataDumper.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::DataDumper; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: format results using Data::Dumper 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Data::Dumper; 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [DataDumper] 14 | 15 | =head1 DESCRIPTION 16 | 17 | This plugin uses L to format results. 18 | 19 | =cut 20 | 21 | sub new { 22 | my $class = shift; 23 | 24 | $Data::Dumper::Terse = 1; 25 | $Data::Dumper::Sortkeys = 1; 26 | 27 | return $class->SUPER::new(@_); 28 | } 29 | 30 | sub mangle_result { 31 | my $self = shift; 32 | my (@result) = @_; 33 | return Dumper(@result == 0 ? () : @result == 1 ? $result[0] : \@result); 34 | } 35 | 36 | 1; 37 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/DataPrinter.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::DataPrinter; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: format results using Data::Printer 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Data::Printer alias => 'p', colored => 1, return_value => 'dump'; 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [DataPrinter] 14 | 15 | =head1 DESCRIPTION 16 | 17 | This plugin uses L to format results. 18 | 19 | =cut 20 | 21 | sub mangle_result { 22 | my ($self, @result) = @_; 23 | return unless @result; 24 | ( @result == 1 ) && return p($result[0]); 25 | return p(@result); 26 | } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Defaults.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Defaults; 2 | 3 | # XXX Eval::Closure imposes its own hints on things that are eval'ed at the 4 | # moment, but this may be fixed in the future 5 | BEGIN { 6 | our $default_hints = $^H; 7 | our $default_hinthash = { %^H }; 8 | our $default_warning_bits = ${^WARNING_BITS}; 9 | } 10 | 11 | use strict; 12 | use warnings; 13 | 14 | use base 'Reply::Plugin'; 15 | 16 | use Eval::Closure 0.11; 17 | 18 | sub new { 19 | my $class = shift; 20 | 21 | my $self = $class->SUPER::new(@_); 22 | $self->{quit} = 0; 23 | 24 | return $self; 25 | } 26 | 27 | sub prompt { "> " } 28 | 29 | sub read_line { 30 | my $self = shift; 31 | my ($next, $prompt) = @_; 32 | 33 | print $prompt; 34 | return scalar ; 35 | } 36 | 37 | (my $PREFIX = <<'PREFIX') =~ s/__PACKAGE__/__PACKAGE__/ge; 38 | BEGIN { 39 | $^H = $__PACKAGE__::default_hints; 40 | %^H = %$__PACKAGE__::default_hinthash; 41 | ${^WARNING_BITS} = $__PACKAGE__::default_warning_bits; 42 | } 43 | PREFIX 44 | 45 | sub compile { 46 | my $self = shift; 47 | my ($next, $line, %args) = @_; 48 | 49 | my $env = { map { %$_ } $self->publish('lexical_environment') }; 50 | my $package = ($self->publish('package'))[-1]; 51 | $package = 'main' unless defined $package; 52 | 53 | my $prefix = "package $package;\n$PREFIX"; 54 | 55 | my $code = eval_closure( 56 | source => "sub {\n$prefix;\n$line\n}", 57 | terse_error => 1, 58 | alias => 1, 59 | environment => $env, 60 | %args, 61 | ); 62 | 63 | return $code; 64 | } 65 | 66 | sub execute { 67 | my $self = shift; 68 | my ($next, $code, @args) = @_; 69 | 70 | return $code->(@args); 71 | } 72 | 73 | sub print_error { 74 | my $self = shift; 75 | my ($next, $error) = @_; 76 | 77 | print $error 78 | if defined $error; 79 | } 80 | 81 | sub print_result { 82 | my $self = shift; 83 | my ($next, @result) = @_; 84 | 85 | print @result, "\n" 86 | if @result; 87 | } 88 | 89 | sub command_q { 90 | my $self = shift; 91 | $self->{quit} = 1; 92 | return ''; 93 | } 94 | 95 | sub command_vars { 96 | my $self = shift; 97 | 98 | my %env = map { %$_ } $self->publish('lexical_environment'); 99 | return '(' . join(', ', map { qq<'$_'> } keys %env) . ')'; 100 | } 101 | 102 | sub loop { 103 | my $self = shift; 104 | my ($continue) = @_; 105 | 106 | $continue = 0 if $self->{quit}; 107 | 108 | return $continue; 109 | } 110 | 111 | =begin Pod::Coverage 112 | 113 | new 114 | command_q 115 | command_vars 116 | 117 | =end Pod::Coverage 118 | 119 | =cut 120 | 121 | 1; 122 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Editor.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Editor; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: command to edit the current line in a text editor 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use File::HomeDir; 9 | use File::Spec; 10 | use Proc::InvokeEditor; 11 | 12 | =head1 SYNOPSIS 13 | 14 | ; .replyrc 15 | [Editor] 16 | editor = emacs 17 | 18 | =head1 DESCRIPTION 19 | 20 | This plugin provides the C<#e> command. It will launch your editor, and allow 21 | you to edit bits of code in your editor, which will then be evaluated all at 22 | once. The text you entered will be saved, and restored the next time you enter 23 | the command. Alternatively, you can pass a filename to the C<#e> command, and 24 | the contents of that file will be preloaded instead. 25 | 26 | The C option can be specified to provide a different editor to use, 27 | otherwise it will use the value of C<$ENV{VISUAL}> or C<$ENV{EDITOR}>. 28 | 29 | =cut 30 | 31 | sub new { 32 | my $class = shift; 33 | my %opts = @_; 34 | 35 | my $self = $class->SUPER::new(@_); 36 | $self->{editor} = Proc::InvokeEditor->new( 37 | (defined $opts{editor} 38 | ? (editors => [ $opts{editor} ]) 39 | : ()) 40 | ); 41 | $self->{current_text} = ''; 42 | 43 | return $self; 44 | } 45 | 46 | sub command_e { 47 | my $self = shift; 48 | my ($line) = @_; 49 | 50 | my $text; 51 | if (length $line) { 52 | if ($line =~ s+^~/++) { 53 | $line = File::Spec->catfile(File::HomeDir->my_home, $line); 54 | } 55 | elsif ($line =~ s+^~([^/]*)/++) { 56 | $line = File::Spec->catfile(File::HomeDir->users_home($1), $line); 57 | } 58 | 59 | my $current_text = do { 60 | local $/; 61 | if (open my $fh, '<', $line) { 62 | <$fh>; 63 | } 64 | else { 65 | warn "Couldn't open $line: $!"; 66 | return ''; 67 | } 68 | }; 69 | $text = $self->{editor}->edit($current_text, '.pl'); 70 | } 71 | else { 72 | $text = $self->{editor}->edit($self->{current_text}, '.pl'); 73 | $self->{current_text} = $text; 74 | } 75 | 76 | return $text; 77 | } 78 | 79 | =for Pod::Coverage 80 | command_e 81 | 82 | =cut 83 | 84 | 1; 85 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/FancyPrompt.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::FancyPrompt; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: provides a more informative prompt 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | =head1 SYNOPSIS 9 | 10 | ; .replyrc 11 | [FancyPrompt] 12 | 13 | =head1 DESCRIPTION 14 | 15 | This plugin enhances the default Reply prompt. Currently, the only difference 16 | is that it includes a counter of the number of lines evaluated so far in the 17 | current session. 18 | 19 | =cut 20 | 21 | sub new { 22 | my $class = shift; 23 | my $self = $class->SUPER::new(@_); 24 | $self->{counter} = 0; 25 | $self->{prompted} = 0; 26 | return $self; 27 | } 28 | 29 | sub prompt { 30 | my $self = shift; 31 | my ($next) = @_; 32 | $self->{prompted} = 1; 33 | return $self->{counter} . $next->(); 34 | } 35 | 36 | sub loop { 37 | my $self = shift; 38 | my ($continue) = @_; 39 | $self->{counter}++ if $self->{prompted}; 40 | $self->{prompted} = 0; 41 | $continue; 42 | } 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Hints.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Hints; 2 | 3 | my $default_hints; 4 | my $default_hinthash; 5 | my $default_warning_bits; 6 | BEGIN { 7 | $default_hints = $^H; 8 | $default_hinthash = \%^H; 9 | $default_warning_bits = ${^WARNING_BITS}; 10 | } 11 | 12 | use strict; 13 | use warnings; 14 | # ABSTRACT: persists lexical hints across input lines 15 | 16 | use base 'Reply::Plugin'; 17 | 18 | =head1 SYNOPSIS 19 | 20 | ; .replyrc 21 | [Hints] 22 | 23 | =head1 DESCRIPTION 24 | 25 | This plugin persists the values of various compile time lexical hints between 26 | evaluated lines. This means, for instance, that entering a line like C at the Reply prompt will cause C to be enabled for all future 28 | lines (at least until C is given). 29 | 30 | =cut 31 | 32 | sub new { 33 | my $class = shift; 34 | 35 | my $self = $class->SUPER::new(@_); 36 | $self->{hints} = $default_hints; 37 | $self->{hinthash} = $default_hinthash; 38 | $self->{warning_bits} = $default_warning_bits; 39 | 40 | return $self; 41 | } 42 | 43 | sub mangle_line { 44 | my $self = shift; 45 | my ($line) = @_; 46 | 47 | my $package = __PACKAGE__; 48 | return <{hints}; 72 | our $hinthash = $self->{hinthash}; 73 | our $warning_bits = $self->{warning_bits}; 74 | 75 | my @result = $next->($line, %args); 76 | 77 | $self->{hints} = $hints; 78 | $self->{hinthash} = $hinthash; 79 | $self->{warning_bits} = $warning_bits; 80 | 81 | return @result; 82 | } 83 | 84 | 1; 85 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Interrupt.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Interrupt; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: allows using Ctrl+C to interrupt long-running lines 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | =head1 SYNOPSIS 9 | 10 | ; .replyrc 11 | [Interrupt] 12 | 13 | =head1 DESCRIPTION 14 | 15 | This plugin allows you to use Ctrl+C to interrupt long running commands without 16 | exiting the Reply shell entirely. 17 | 18 | =cut 19 | 20 | sub compile { 21 | my $self = shift; 22 | my ($next, @args) = @_; 23 | 24 | local $SIG{INT} = sub { die "Interrupted" }; 25 | $next->(@args); 26 | } 27 | 28 | sub execute { 29 | my $self = shift; 30 | my ($next, @args) = @_; 31 | 32 | local $SIG{INT} = sub { die "Interrupted" }; 33 | $next->(@args); 34 | } 35 | 36 | 1; 37 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/LexicalPersistence.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::LexicalPersistence; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: persists lexical variables between lines 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use PadWalker 'peek_sub', 'closed_over'; 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [LexicalPersistence] 14 | 15 | =head1 DESCRIPTION 16 | 17 | This plugin persists the values of lexical variables between input lines. For 18 | instance, with this plugin you can enter C into the Reply shell, and 19 | then use C<$x> as expected in subsequent lines. 20 | 21 | =cut 22 | 23 | sub new { 24 | my $class = shift; 25 | my %opts = @_; 26 | 27 | my $self = $class->SUPER::new(@_); 28 | $self->{env} = {}; 29 | 30 | return $self; 31 | } 32 | 33 | sub compile { 34 | my $self = shift; 35 | my ($next, $line, %args) = @_; 36 | 37 | my ($code) = $next->($line, %args); 38 | 39 | my $new_env = peek_sub($code); 40 | delete $new_env->{$_} for keys %{ closed_over($code) }; 41 | 42 | $self->{env} = { 43 | %{ $self->{env} }, 44 | %$new_env, 45 | }; 46 | 47 | return $code; 48 | } 49 | 50 | sub lexical_environment { 51 | my $self = shift; 52 | 53 | return $self->{env}; 54 | } 55 | 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/LoadClass.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::LoadClass; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: attempts to load classes implicitly if possible 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Module::Runtime 'use_package_optimistically'; 9 | use Try::Tiny; 10 | 11 | =head1 SYNOPSIS 12 | 13 | ; .replyrc 14 | [LoadClass] 15 | 16 | =head1 DESCRIPTION 17 | 18 | If executing a line of code fails due to a method not being defined on a 19 | package, this plugin will load the corresponding module and then try executing 20 | the line again. This simplifies common cases like running C<< DateTime->now >> 21 | at the prompt before loading L - this plugin will cause DateTime to 22 | be loaded implicitly. 23 | 24 | =cut 25 | 26 | sub execute { 27 | my $self = shift; 28 | my ($next, @args) = @_; 29 | 30 | try { 31 | $next->(@args); 32 | } 33 | catch { 34 | if (/^Can't locate object method "[^"]*" via package "([^"]*)"/) { 35 | use_package_optimistically($1); 36 | $next->(@args); 37 | } 38 | else { 39 | die $_; 40 | } 41 | } 42 | } 43 | 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Nopaste.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Nopaste; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: command to nopaste a transcript of the current session 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use App::Nopaste; 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [Nopaste] 14 | service = Gist 15 | 16 | =head1 DESCRIPTION 17 | 18 | This plugin provides a C<#nopaste> command, which will use L to 19 | nopaste a transcript of the current Reply session. The C option can be 20 | used to choose an alternate service to use, rather than using the one that 21 | App::Nopaste chooses on its own. If arguments are passed to the C<#nopaste> 22 | command, they will be used as the title of the paste. 23 | 24 | Note that this plugin should be loaded early in your configuration file, in 25 | order to ensure that it sees all modifications to the result (due to plugins 26 | like [DataDump], etc). 27 | 28 | =cut 29 | 30 | sub new { 31 | my $class = shift; 32 | my %opts = @_; 33 | 34 | my $self = $class->SUPER::new(@_); 35 | $self->{history} = ''; 36 | $self->{service} = $opts{service}; 37 | 38 | return $self; 39 | } 40 | 41 | sub prompt { 42 | my $self = shift; 43 | my ($next, @args) = @_; 44 | my $prompt = $next->(@args); 45 | $self->{prompt} = $prompt; 46 | return $prompt; 47 | } 48 | 49 | sub read_line { 50 | my $self = shift; 51 | my ($next, @args) = @_; 52 | my $line = $next->(@args); 53 | $self->{line} = "$line\n" if defined $line; 54 | return $line; 55 | } 56 | 57 | sub print_error { 58 | my $self = shift; 59 | my ($next, $error) = @_; 60 | $self->{result} = $error; 61 | $next->($error); 62 | } 63 | 64 | sub print_result { 65 | my $self = shift; 66 | my ($next, @result) = @_; 67 | $self->{result} = @result ? join('', @result) . "\n" : ''; 68 | $next->(@result); 69 | } 70 | 71 | sub loop { 72 | my $self = shift; 73 | my ($continue) = @_; 74 | 75 | my $prompt = delete $self->{prompt}; 76 | my $line = delete $self->{line}; 77 | my $result = delete $self->{result}; 78 | 79 | $self->{history} .= "$prompt$line$result" 80 | if defined $prompt 81 | && defined $line 82 | && defined $result; 83 | 84 | $continue; 85 | } 86 | 87 | sub command_nopaste { 88 | my $self = shift; 89 | my ($line) = @_; 90 | 91 | $line = "Reply session" unless length $line; 92 | 93 | print App::Nopaste->nopaste( 94 | text => $self->{history}, 95 | desc => $line, 96 | lang => 'perl', 97 | (defined $self->{service} 98 | ? (services => [ $self->{service} ]) 99 | : ()), 100 | ) . "\n"; 101 | 102 | return ''; 103 | } 104 | 105 | =for Pod::Coverage 106 | command_nopaste 107 | 108 | =cut 109 | 110 | 1; 111 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Packages.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Packages; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: persist the current package between lines 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | =head1 SYNOPSIS 9 | 10 | ; .replyrc 11 | [Packages] 12 | default_package = My::Scratchpad 13 | 14 | =head1 DESCRIPTION 15 | 16 | This plugin persists the state of the current package between lines. This 17 | allows lines such as C in the Reply shell to do what you'd 18 | expect. The C configuration option can also be used to set the 19 | initial package to use when Reply starts up. 20 | 21 | =cut 22 | 23 | sub new { 24 | my $class = shift; 25 | my %opts = @_; 26 | 27 | my $self = $class->SUPER::new(@_); 28 | $self->{package} = $opts{default_package} || 'main'; 29 | 30 | return $self; 31 | } 32 | 33 | sub mangle_line { 34 | my $self = shift; 35 | my ($line) = @_; 36 | 37 | my $package = __PACKAGE__; 38 | return <($line, %args); 52 | 53 | # XXX it'd be nice to avoid using globals here, but we can't use 54 | # eval_closure's environment parameter since we need to access the 55 | # information in a BEGIN block 56 | $self->{package} = our $package; 57 | 58 | return @result; 59 | } 60 | 61 | sub package { 62 | my $self = shift; 63 | return $self->{package}; 64 | } 65 | 66 | 1; 67 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Pager.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Pager; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: command to automatically open long results in a pager 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Term::ReadKey; 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [Pager] 14 | pager = less 15 | 16 | =head1 DESCRIPTION 17 | 18 | This plugin notices when too much output is going to be displayed as the result 19 | of an expression, and automatically loads the result into a pager instead. 20 | 21 | The C option can be specified to provide a different pager to use, 22 | otherwise it will use the value of C<$ENV{PAGER}>. 23 | 24 | =cut 25 | 26 | sub new { 27 | my $class = shift; 28 | my %opts = @_; 29 | 30 | if (defined $opts{pager}) { 31 | $ENV{PAGER} = $opts{pager}; 32 | } 33 | 34 | # delay this because it checks $ENV{PAGER} at load time 35 | require IO::Pager; 36 | 37 | my $self = $class->SUPER::new(@_); 38 | return $self; 39 | } 40 | 41 | sub print_result { 42 | my $self = shift; 43 | my ($next, @result) = @_; 44 | 45 | my ($cols, $rows) = GetTerminalSize; 46 | 47 | my @lines = map { split /\n/ } @result; 48 | if (@lines >= $rows - 2) { 49 | IO::Pager::open(my $fh) or die "Couldn't run pager: $!"; 50 | $fh->print(@result, "\n"); 51 | } 52 | else { 53 | $next->(@result); 54 | } 55 | } 56 | 57 | =for Pod::Coverage 58 | print_result 59 | 60 | =cut 61 | 62 | 1; 63 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/ReadLine.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::ReadLine; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: use Term::ReadLine for user input 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use File::HomeDir; 9 | use File::Spec; 10 | use Scalar::Util 'weaken'; 11 | use Term::ReadLine; 12 | 13 | =head1 SYNOPSIS 14 | 15 | ; .replyrc 16 | [ReadLine] 17 | history_file = .hist 18 | history_length = 100 19 | 20 | =head1 DESCRIPTION 21 | 22 | This plugin uses L to read lines from the user. This enables 23 | useful features such as line editing and command history. The history will be 24 | persisted between runs, by default in C<.reply_history> in your application 25 | data directory, although this is changeable with the C option. To 26 | limit the number of lines written to this file, you can use the 27 | C option. Setting a C of C<0> will disable 28 | writing history to a file entirely. 29 | 30 | NOTE: you probably want to install a reasonable L backend in 31 | order for this plugin to be very useful. L is highly 32 | recommended if possible. 33 | 34 | =cut 35 | 36 | sub new { 37 | my $class = shift; 38 | my %opts = @_; 39 | 40 | my $self = $class->SUPER::new(@_); 41 | $self->{term} = Term::ReadLine->new('Reply'); 42 | my $history = $opts{history_file} || '.reply_history'; 43 | $history =~ s{^~/}{$ENV{HOME}/}; 44 | $self->{history_file} = File::Spec->catfile( 45 | (File::Spec->file_name_is_absolute($history) 46 | ? () 47 | : (File::HomeDir->my_data)), 48 | $history 49 | ); 50 | 51 | $self->{rl_gnu} = $self->{term}->ReadLine eq 'Term::ReadLine::Gnu'; 52 | $self->{rl_perl5} = $self->{term}->ReadLine eq 'Term::ReadLine::Perl5'; 53 | $self->{rl_caroline} = $self->{term}->ReadLine eq 'Term::ReadLine::Caroline'; 54 | 55 | if ($self->{rl_perl5}) { 56 | # output compatible with Term::ReadLine::Gnu 57 | $readline::rl_scroll_nextline = 0; 58 | } 59 | 60 | if ($self->{rl_perl5} || $self->{rl_gnu} || $self->{rl_caroline}) { 61 | $self->{term}->StifleHistory($opts{history_length}) 62 | if defined $opts{history_length} && $opts{history_length} >= 0; 63 | } 64 | 65 | if (open my $fh, '<', $self->{history_file}) { 66 | for my $line (<$fh>) { 67 | chomp $line; 68 | $self->{term}->addhistory($line); 69 | } 70 | } 71 | else { 72 | my $e = $!; 73 | warn "Couldn't open $self->{history_file} for reading: $e" 74 | if -e $self->{history_file}; 75 | } 76 | 77 | $self->_register_tab_complete; 78 | 79 | return $self; 80 | } 81 | 82 | sub read_line { 83 | my $self = shift; 84 | my ($next, $prompt) = @_; 85 | 86 | return $self->{term}->readline($prompt); 87 | } 88 | 89 | sub DESTROY { 90 | my $self = shift; 91 | 92 | return if defined $self->{history_length} && $self->{history_length} == 0; 93 | 94 | # XXX support more later 95 | return unless ($self->{rl_gnu} || $self->{rl_perl5} || $self->{rl_caroline}); 96 | 97 | $self->{term}->WriteHistory($self->{history_file}) 98 | or warn "Couldn't write history to $self->{history_file}"; 99 | } 100 | 101 | sub _register_tab_complete { 102 | my $self = shift; 103 | 104 | my $term = $self->{term}; 105 | 106 | weaken(my $weakself = $self); 107 | 108 | if ($self->{rl_gnu}) { 109 | $term->Attribs->{attempted_completion_function} = sub { 110 | my ($text, $line, $start, $end) = @_; 111 | 112 | # discard everything after the cursor for completion purposes 113 | substr($line, $end) = ''; 114 | 115 | my @matches = $weakself->publish('tab_handler', $line); 116 | my $match_index = 0; 117 | 118 | return $term->completion_matches($text, sub { 119 | my ($text, $index) = @_; 120 | return $matches[$index]; 121 | }); 122 | }; 123 | } 124 | 125 | if ($self->{rl_perl5}) { 126 | $term->Attribs->{completion_function} = sub { 127 | my ($text, $line, $start) = @_; 128 | my $end = $start + length($text); 129 | 130 | # discard everything after the cursor for completion purposes 131 | substr($line, $end) = ''; 132 | 133 | my @matches = $weakself->publish('tab_handler', $line); 134 | return scalar(@matches) ? @matches : (); 135 | }; 136 | } 137 | 138 | if ($self->{rl_caroline}) { 139 | $term->caroline->completion_callback(sub { 140 | my ($line) = @_; 141 | 142 | my @matches = $weakself->publish('tab_handler', $line); 143 | # for variable completion, method name completion. 144 | if (@matches && $line =~ /\W/) { 145 | $line =~ s/[:\w]+\z//; 146 | @matches = map { $line.$_ } @matches; 147 | } 148 | return scalar(@matches) ? @matches : (); 149 | }); 150 | } 151 | } 152 | 153 | 1; 154 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/ResultCache.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::ResultCache; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: retain previous results to be able to refer to them later 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | =head1 SYNOPSIS 9 | 10 | ; .replyrc 11 | [ResultCache] 12 | variable = r 13 | 14 | =head1 DESCRIPTION 15 | 16 | This plugin caches the results of successful evaluations, and provides them in 17 | a lexical array (by default C<@res>, although this can be changed via the 18 | C option). This means that you can, for instance, access the value 19 | returned by the previous line with C<$res[-1]>. It also modifies the output to 20 | include an indication of where the value is stored, for later reference. 21 | 22 | =cut 23 | 24 | sub new { 25 | my $class = shift; 26 | my %opts = @_; 27 | 28 | my $self = $class->SUPER::new(@_); 29 | $self->{results} = []; 30 | $self->{result_name} = $opts{variable} || 'res'; 31 | 32 | return $self; 33 | } 34 | 35 | sub execute { 36 | my $self = shift; 37 | my ($next, @args) = @_; 38 | 39 | my @res = $next->(@args); 40 | if (@res == 1) { 41 | push @{ $self->{results} }, $res[0]; 42 | } 43 | elsif (@res > 1) { 44 | push @{ $self->{results} }, \@res; 45 | } 46 | 47 | return @res; 48 | } 49 | 50 | sub mangle_result { 51 | my $self = shift; 52 | my ($result) = @_; 53 | 54 | return unless defined $result; 55 | return '$' . $self->{result_name} . '[' . $#{ $self->{results} } . '] = ' 56 | . $result; 57 | } 58 | 59 | sub lexical_environment { 60 | my $self = shift; 61 | return { "\@$self->{result_name}" => [ @{ $self->{results} } ] }; 62 | } 63 | 64 | 1; 65 | -------------------------------------------------------------------------------- /lib/Reply/Plugin/Timer.pm: -------------------------------------------------------------------------------- 1 | package Reply::Plugin::Timer; 2 | use strict; 3 | use warnings; 4 | # ABSTRACT: time commands 5 | 6 | use base 'Reply::Plugin'; 7 | 8 | use Time::HiRes qw(gettimeofday tv_interval); 9 | 10 | =head1 SYNOPSIS 11 | 12 | ; .replyrc 13 | [Timer] 14 | mintime = 0.01 15 | 16 | =head1 DESCRIPTION 17 | 18 | This plugin prints timer info for results that take longer than C. 19 | the default C is C<< 0.01 >> seconds. 20 | 21 | =cut 22 | 23 | sub new { 24 | my $class = shift; 25 | my %opts = @_; 26 | 27 | my $self = $class->SUPER::new(@_); 28 | $self->{mintime} = $opts{mintime} || 0.01; 29 | 30 | return $self; 31 | } 32 | 33 | 34 | sub execute { 35 | my ($self, $next, @args) = @_; 36 | 37 | my $t0 = [gettimeofday]; 38 | my @ret = $next->(@args); 39 | my $elapsed = tv_interval($t0); 40 | 41 | if ($elapsed > $self->{mintime}) { 42 | if ($elapsed >= 1) { 43 | printf "Execution Time: %0.3fs\n", $elapsed 44 | } else { 45 | printf "Execution Time: %dms\n", $elapsed * 1000 46 | } 47 | } 48 | 49 | return @ret; 50 | } 51 | 52 | 1; 53 | -------------------------------------------------------------------------------- /lib/Reply/Util.pm: -------------------------------------------------------------------------------- 1 | package Reply::Util; 2 | use strict; 3 | use warnings; 4 | 5 | BEGIN { 6 | if ($] < 5.010) { 7 | require MRO::Compat; 8 | } 9 | else { 10 | require mro; 11 | } 12 | } 13 | 14 | use Package::Stash; 15 | use Scalar::Util 'blessed'; 16 | 17 | use Exporter 'import'; 18 | our @EXPORT_OK = qw( 19 | $ident_rx $varname_rx $fq_ident_rx $fq_varname_rx 20 | methods all_packages 21 | ); 22 | 23 | # XXX this should be updated for unicode 24 | our $varstart_rx = qr/[A-Z_a-z]/; 25 | our $varcont_rx = qr/[0-9A-Z_a-z]/; 26 | our $ident_rx = qr/${varstart_rx}${varcont_rx}*/; 27 | our $sigil_rx = qr/[\$\@\%\&\*]/; 28 | our $varname_rx = qr/$sigil_rx\s*$ident_rx/; 29 | our $fq_ident_rx = qr/$ident_rx(?:::$varcont_rx+)*/; 30 | our $fq_varname_rx = qr/$varname_rx(?:::$varcont_rx+)*/; 31 | 32 | sub methods { 33 | my ($invocant) = @_; 34 | 35 | my $class = blessed($invocant) || $invocant; 36 | 37 | my @mro = ( 38 | @{ mro::get_linear_isa('UNIVERSAL') }, 39 | @{ mro::get_linear_isa($class) }, 40 | ); 41 | 42 | my @methods; 43 | for my $package (@mro) { 44 | my $stash = eval { Package::Stash->new($package) }; 45 | next unless $stash; 46 | push @methods, $stash->list_all_symbols('CODE'); 47 | } 48 | 49 | return @methods; 50 | } 51 | 52 | sub all_packages { 53 | my ($root) = @_; 54 | $root ||= \%::; 55 | 56 | my @packages; 57 | for my $fragment (grep { /::$/ } keys %$root) { 58 | next if ref($root) && $root == \%:: && $fragment eq 'main::'; 59 | push @packages, ( 60 | $fragment, 61 | map { $fragment . $_ } all_packages($root->{$fragment}) 62 | ); 63 | } 64 | 65 | return map { s/::$//; $_ } @packages; 66 | } 67 | 68 | =begin Pod::Coverage 69 | 70 | methods 71 | all_packages 72 | 73 | =end Pod::Coverage 74 | 75 | =cut 76 | 77 | 1; 78 | --------------------------------------------------------------------------------