PageRenderTime 50ms CodeModel.GetById 24ms RepoModel.GetById 0ms app.codeStats 0ms

/lib/Hailo/UI/ReadLine.pm

https://github.com/hailo/hailo
Perl | 188 lines | 165 code | 19 blank | 4 comment | 7 complexity | 6c28119b8199673acb75804fb6751aee MD5 | raw file
  1. package Hailo::UI::ReadLine;
  2. use v5.10.0;
  3. use Moose;
  4. use MooseX::StrictConstructor;
  5. use Encode 'decode';
  6. use Hailo;
  7. use Term::ReadLine;
  8. use Data::Dump 'dump';
  9. use namespace::clean -except => 'meta';
  10. with qw(Hailo::Role::Arguments
  11. Hailo::Role::UI);
  12. sub BUILD {
  13. $ENV{PERL_RL} = 'Perl o=0' unless $ENV{PERL_RL};
  14. return;
  15. }
  16. sub run {
  17. my ($self, $hailo) = @_;
  18. my $name = 'Hailo';
  19. my $term = Term::ReadLine->new($name);
  20. my $command = qr[
  21. ^
  22. # A dot-prefix like in SQLite
  23. \.
  24. # We only have Hailo methods matching this
  25. (?<method> [a-z_]+ )
  26. # Optional arguments. These'll be passed to eval() before being
  27. # passed to the method
  28. \s*
  29. (?: (?<arguments>.+) )?
  30. $]x;
  31. print $self->_intro;
  32. while (defined (my $line = $term->readline($name . '> '))) {
  33. $line = decode('utf8', $line);
  34. if ($line =~ /$command/p) {
  35. if ($+{method} eq 'help') {
  36. print $self->_help($hailo);
  37. } elsif ($+{method} =~ /^(?: quit | exit )$/xs) {
  38. say $hailo->reply("Dave, this conversation can serve no purpose anymore. Goodbye.") // "Bye!";
  39. exit 0;
  40. }
  41. my $meth = $+{method};
  42. my @args = defined $+{arguments} ? eval $+{arguments} : ();
  43. eval {
  44. say dump $hailo->$meth(@args);
  45. 1;
  46. } or do {
  47. chomp(my $err = $@ || "Zombie Error");
  48. say STDERR "Failed on <<${^MATCH}>>: <<$err>>";
  49. }
  50. } else {
  51. my $answer = $hailo->learn_reply($line);
  52. say $answer // "I don't know enough to answer you yet.";
  53. }
  54. }
  55. print "\n";
  56. return;
  57. }
  58. sub _intro {
  59. my ($self) = @_;
  60. my $intro = <<"INTRO";
  61. Welcome to the Hailo interactive shell
  62. Enter ".help" to show the built-in commands.
  63. Input that's not a command will be passed to Hailo to learn, and it'll
  64. reply back.
  65. INTRO
  66. return $intro;
  67. }
  68. sub _help {
  69. my ($self, $hailo) = @_;
  70. my $include = qr/ ^ _go /xs;
  71. my $exclude = qr/
  72. _
  73. (?:
  74. version
  75. | order
  76. | progress
  77. | random_reply
  78. | examples
  79. | autosave
  80. | brain
  81. | class
  82. )
  83. $/xs;
  84. my @attr;
  85. for my $attr ($hailo->meta->get_all_attributes) {
  86. # Only get attributes that are valid command-line options
  87. next unless $attr->name =~ $include;
  88. # We don't support changing these in mid-stream
  89. next if $attr->name =~ $exclude;
  90. push @attr => {
  91. name => do {
  92. my $tmp = $attr->cmd_flag;
  93. $tmp =~ tr/-/_/;
  94. $tmp;
  95. },
  96. documentation => $attr->documentation,
  97. };
  98. }
  99. push @attr => {
  100. name => 'quit',
  101. documentation => "Exit this chat session",
  102. };
  103. my $help = <<"HELP";
  104. These are the commands we know about:
  105. HELP
  106. my @sorted = sort { $a->{name} cmp $b->{name} } @attr;
  107. for my $cmd (@sorted) {
  108. $help .= sprintf " %-14s%s\n", '.'.$cmd->{name}, $cmd->{documentation};
  109. }
  110. $help .= <<"HELP";
  111. The commands are just method calls on a Hailo object. Any arguments to
  112. them will be passed through eval() used as method arguments. E.g.:
  113. .train "/tmp/megahal.trn"
  114. Trained from 350 lines in 0.54 seconds; 654.04 lines/s
  115. ()
  116. Return values are printed with Data::Dump:
  117. .stats
  118. (1311, 2997, 3580, 3563)
  119. Any input not starting with "." will be passed through Hailo's
  120. learn_reply method:
  121. Hailo> Help, mommy!
  122. Really? I can't. It's an ethical thing.
  123. HELP
  124. return $help;
  125. }
  126. __PACKAGE__->meta->make_immutable;
  127. =encoding utf8
  128. =head1 NAME
  129. Hailo::UI::ReadLine - A UI for L<Hailo|Hailo> using L<Term::ReadLine|Term::ReadLine>
  130. =head1 SYNOPSIS
  131. This module is called internally by L<Hailo|Hailo>, it takes no options.
  132. A ReadLine interface will be presented when calling L<hailo> on the
  133. command-line with only a C<--brain> argument:
  134. hailo --brain hailo.sqlite
  135. =head1 DESCRIPTION
  136. Presents a ReadLine interface using L<Term::ReadLine>, the
  137. L<Term::ReadLine::Gnu> frontend will be used.
  138. =head1 AUTHOR
  139. E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avar@cpan.org>
  140. =head1 LICENSE AND COPYRIGHT
  141. Copyright 2010 E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason.
  142. This program is free software, you can redistribute it and/or modify
  143. it under the same terms as Perl itself.
  144. =cut