I'm wondering whether you've actually read the perldoc man page for that module. If you've read it, I'm wondering why you're still trying the same basic approach as your first post.

(BTW, have you looked recently for updates and sub-replies to your earlier posts? I put an update or sub-reply on your previous thread, that explains about using "/$/" in a parser rule, to make sure the parser covers an entire input string, and this seems to be relevant to the current thread.)

I'm also wondering why you haven't tried to provide more detail about the sorts of user input you're trying to handle, and/or the sorts of feedback you want to provide to the user, and/or whether you really want to do anything with the parser results, apart from telling whether the input text is parsable or not.

It seems as though you're not getting some very basic concept about parser/grammar design, or about the sort of approach your app should be using, based on what you expect it to do (which has not been made very clear, yet).

And you certainly don't seem to be getting the hints about how to post code at the Monastery -- please read the part about code tags at Writeup Formatting Tips, and use that information.

Also start showing a little more effort in using ideas that have been provided, and exploring a broader range of approaches on your own. Otherwise, people might just decide you're too dense to learn anything, and they'll loose interest in answering your questions. (You might even get downvoted -- ack! .... just kidding; I would never do that. ;)

Sorry for removing the Tk code. It was easier for me to test it this way.

I wrote this program because I needed to figure out how to give relevant error messages using Parse::RecDescent. Don't count on us doing this much work for you in the future.

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper      ();
use Parse::RecDescent ();

our $test_num;

sub do_test {
   my $parser = $_[0];
   our $text; local *text = \$_[1];  # Pass by ref.

   ++$test_num;

   print("========================\n");
   print("\n");

   print("Test $test_num\n");
   print("======\n");
   print("\n");

   print("TEXT\n");
   print("----\n");
   print($text);
   print("\n");

   print("OUTPUT\n");
   print("------\n");
   my $data = $parser->parse($text);

   if ($data) {
      print(Data::Dumper::Dumper($data));
   } else {
      warn("Bad text.\n");
   }

   print("\n");
}


my $grammar = <<'__EOI__';

   ########################################
   # Helper Code
   #

   {
      sub OK     () { ''    }
      sub REJECT () { undef }

      my %COMMANDS = map { $_ => $_ } qw(
         print
      );
      
      # XXX Global bad.
      # Should be an attribute of the parser.
      my $in_code;

      sub dequote {
         local $_ = @_ ? $_[0] : $_;
         s/^['"]//;
         s/['"]$//;
         s/\\(.)/$1/gs;
         return $_;
      }
   }


   ########################################
   # Rules
   #

   parse      : SET_IN_JUNK parse_ { $item[2] }

   parse_     :         stmt_list EOF    { $item[1] }
              | IN_JUNK JUNK_LINE parse_ { $item[3] }

   stmt_list  : stmt SET_IN_CODE sep stmt_list_(s?)
                { [ $item[1], @{$item[4]} ] }

   stmt_list_ : stmt sep { $item[1] }

   stmt       : cmd_name arg_list { [ $item[1], @{$item[2]} ] }

   cmd_name   : IDENT { $COMMANDS{$item[1]} }
              | /[^ \t\n;]{1,20}/
                {
                   my $idx  = 1;
                   my $line = $itempos[$idx]{line}{from};
                   my $col  = $itempos[$idx]{column}{from};
                   my $cmd  = $item[$idx];
                   warn("$line,$col: Unknown command \"$cmd\".\n")
                      if ($in_code);
                   REJECT
                }

   arg_list   : QUOTED_STR { [ $item[1] ] }
              | {
                   my $idx  = 1;
                   my $line = $itempos[$idx]{line}{from};
                   my $col  = $itempos[$idx]{column}{from};
                   warn("$line,$col: Bad argument list.\n");
                   REJECT
                }

   sep        : SEP
              | {
                   my $idx  = 1;
                   my $line = $itempos[$idx]{line}{from};
                   my $col  = $itempos[$idx]{column}{from};
                   warn("$line,$col: Expecting ';'.\n");
                   REJECT
                }


   ########################################
   # Tokens
   #

   EOF        : /\Z/
   JUNK_LINE  : /[^\n]*\n/
   SEP        : ';'
   IDENT      : /[a-zA-Z][a-zA-Z0-9-_]*/
   QUOTED_STR : /'(?:[^'\\]|\\.)*'/ { dequote($item[1]) }
              | /"(?:[^"\\]|\\.)*"/ { dequote($item[1]) }


   ########################################
   # Special
   #

   SET_IN_JUNK : { $in_code = 0; OK }
   SET_IN_CODE : { $in_code = 1; OK }
   IN_JUNK     : { $in_code ? REJECT : OK }

__EOI__


$::RD_ERRORS = 1;
$::RD_WARN   = 1;
$::RD_HINT   = 1;
$::RD_TRACE  = undef;

# Make sure STDOUT and STDERR mix correctly.
select(STDOUT); $|=1;
select(STDERR); $|=1;
select(STDOUT);

my $parser = Parse::RecDescent->new($grammar)
or die("Bad Grammar.\n");

do_test($parser, <<'__EOI__');
junk junk junk
junk junk print junk junk
junk junk junk
print 'foo';
print 'bar';
__EOI__

do_test($parser, <<'__EOI__');
junk junk junk
junk junk print junk junk
junk junk junk
print 'boo';
junk junk
__EOI__

do_test($parser, <<'__EOI__');
junk junk junk
junk junk print junk junk
junk junk junk
print '\'moo\'';
__EOI__

do_test($parser, <<'__EOI__');
junk junk junk
junk junk print junk junk
junk junk junk
print 'Hello';
print;
__EOI__

print("========================\n");
[download]

Notes:

• I wrote it so more commands could be added easily.
• I left argument checking out of the parser to simplify extending the language.
• It allows more than one command per line, as long as they are seperated by semi-colons.
• It gives very useful error messages.

However,

• The semi-colon is required.
• Commands ('print') are case-sensitive.
  Changing $COMMANDS{$item[1]} to $COMMANDS{lc($item[1])} makes it case-insensitive.

Output:

To make semi-colons optional:

my $grammar = q{ 

# --- Tokens ---

    EOF             : /^\Z/

    IDENTIFIER      : /[A-Za-z]\w*/
    QUOTE        : '\''

# --- Rules ---


parse           : stmt(s?) EOF
            { $item[1] }
        
stmt            : print ';'        { $item[1] }
                 | <error>
print           : 'print' QUOTE IDENTIFIER QUOTE { $item[2] }
}
[download]