Regexp::MultiLanguage - Convert common regular expressions checks

    use Regexp::MultiLanguage qw(Perl JavaScript PHP);

    my $snippet = <<'END';
    number : integer || binary

    integer : /\d+/
    binary : /0b[01]+/i
    END

    print "Perl: \n";
	 print Regexp::MultiLanguage->compile( $snippet, 'Perl', 'isa_' );

	 print "\nJavaScript: \n";
	 print Regexp::MultiLanguage->compile( $snippet, 'JavaScript', 'isa_' );

	 print "\nPHP: \n";
	 print Regexp::MultiLanguage->compile( $snippet, 'PHP', 'isa_' );

	name : expr

    perldoc Regexp::MultiLanguage

package Regexp::MultiLanguage;

use Parse::RecDescent;

use warnings;
use strict;

our $parser;

our $VERSION = '0.03';

sub compile {
	my $class = shift;
	my $script = shift;
	my $dialect = shift;
	my $prefix = shift || '';
	
	my $di_obj = ('Regexp::MultiLanguage::'.$dialect)->new( 'prefix' => $prefix );
	
	unless ( $parser ) {

		$::RD_AUTOACTION = q
				| my $d = $thisparser->{'local'}->{'dialect'};
		  		  #print $item[0], "\n";
		  		  if ( my $f = $d->can( $item[0] ) ) { $return = $d->$f( \%item ); }
		  		  else { $return = $item[ $#item ]; }
		  		  1; |;

		# see the __DATA__ section below for the grammar definition
		my $fh;
		{
			no strict "refs";
			$fh = \*{"Regexp::MultiLanguage::DATA"};
		}
		my $grammar = ''; my $line;
		while ( defined( $line = <$fh> ) and $line !~ m/^__END__/ ) {
			$grammar .= $line;
		}
		close Regexp::MultiLanguage::DATA;

		$parser = Parse::RecDescent->new( $grammar );	
	}
	
	$parser->{'local'}->{'dialect'} = $di_obj;
	
	return $parser->regex_file( $script );
}

# import the following languages
sub import {
	my $class = shift;
	my $prefix = 'Regexp::MultiLanguage::';
	
	foreach ( @_ ) {
		eval "require ${prefix}$_";
		die $@ if $@;
	}
}

1; # End of Regexp::MultiLanguage

__DATA__

regex_file : sequence eofile | <error>

sequence : component(s)

component : comment | statement

statement : identifier ':' expr

comment : /((\/\/)|#)[^\n]*/

eofile: /^\Z/

empty : {''}

# expressions

expr: or_expr

or_expr : and_expr or_expr_i
or_expr_i : or_op and_expr or_expr_i | empty
or_op : '||'

and_expr : not_expr and_expr_i
and_expr_i : and_op not_expr and_expr_i | empty
and_op : '&&'

not_expr : '!' <commit> brack_expr | brack_expr

brack_expr : '(' expr ')' | operand

operand : identifier | regex

identifier : /[_a-z]\w*/i

regex : '/' <commit> 
        { 
				my @result = extract_quotelike('m/'.$text); 
				$text = $result[1];
				$return = $result[0];
		  } 
		  | # try without implicit 'm'		  
		  { 
				my @result = extract_quotelike($text);
				$text = $result[1];
				return undef unless ( $result[3] =~ /m|(qr)|\// );
				$return = $result[0];
		  }