view release on metacpan or  search on metacpan

lib/Parse/KeywordX.pm  view on Meta::CPAN

use 5.014;
use strict;
use warnings;

use Exporter::Tiny ();

package Parse::KeywordX;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.039';

use Text::Balanced qw( extract_bracketed );
use PadWalker qw( closed_over set_closed_over peek_my );
use Parse::Keyword {};

our @ISA    = qw( Exporter::Tiny );
our @EXPORT = qw( parse_name parse_variable parse_trait parse_block_or_match );

#### From p5-mop-redux
sub read_tokenish ()
{
	my $token = '';
	if ((my $next = lex_peek) =~ /[\$\@\%]/)
	{
		$token .= $next;
		lex_read;
	}
	while ((my $next = lex_peek) =~ /\S/)
	{
		$token .= $next;
		lex_read;
		last if ($next . lex_peek) =~ /^\S\b/;
	}
	return $token;
}

#### From p5-mop-redux
sub parse_name
{
	my ($what, $allow_package, $stop_at_single_colon) = @_;
	my $name = '';
	
	# XXX this isn't quite right, i think, but probably close enough for now?
	my $start_rx = qr/^[\p{ID_Start}_]$/;
	my $cont_rx  = qr/^\p{ID_Continue}$/;
	my $char_rx = $start_rx;
	
	while (1)
	{
		my $char = lex_peek;
	
		last unless length $char;
		if ($char =~ $char_rx)
		{
			$name .= $char;
			lex_read;
			$char_rx = $cont_rx;
		}
		elsif ($allow_package && $char eq ':')
		{
			if (lex_peek(3) !~ /^::(?:[^:]|$)/)
			{
				return $name if $stop_at_single_colon;
				die("Not a valid $what name: $name" . read_tokenish);
			}
			$name .= '::';
			lex_read(2);
		}
		else
		{
			last;
		}
	}