#! /usr/bin/perl -w
## ----------------------------------------------------------------------------
#  perlre.pl, Erlang::Port::Regexp.
# -----------------------------------------------------------------------------
# Mastering programmed by YAMASHINA Hio
#
# Copyright 2007 YAMASHINA Hio
# -----------------------------------------------------------------------------
# $Id: /perl/Erlang-Port/example/perlre.pl 388 2007-05-22T11:24:11.684354Z hio  $
# -----------------------------------------------------------------------------
package Erlang::Port::Regexp;
use strict;
use warnings;
use Erlang::Port;

caller or __PACKAGE__->main(@ARGV);

1;

# -----------------------------------------------------------------------------
# main.
#
sub main
{
	my $pkg = shift;
	
	Erlang::Port->new(sub{
		my $obj  = shift;
		my $port = shift;
		#$port->{log} ||= \*STDERR;
		
		my $log = $port->{log};
		$log and _dump($log, request => $obj);
		
		my $ret = eval{
			_my_proc($obj, $port);
		};
		$@ and $ret = $port->_newTuple([ $port->_newAtom('error') => $@, ]);
		$log and _dump($log, result => $ret);
		
		$ret;
	})->loop();
}

# -----------------------------------------------------------------------------
# _my_proc($obj, $port).
#
sub _my_proc
{
	my $obj  = shift;
	my $port = shift;
	
	if( !UNIVERSAL::isa($obj, 'ARRAY') )
	{
		return $port->_newTuple([$port->_newAtom('badarg'), $obj]);
	}
	
	my $key = _to_s($obj->[0]);
	if( !defined($key) || $key ne 'match' )
	{
		return $port->_newTuple([$port->_newAtom('badarg'), $obj]);
	}
	
	my $str = _to_s($obj->[1]);
	my $re  = _to_s($obj->[2]);
	if( !defined($str) || !defined($re) )
	{
		return $port->_newTuple([$port->_newAtom('badarg'), $obj]);
	}
	my $log = $port->{log};
	$log and print $log "str = [$str]\n";
	$log and print $log "re  = [$re]\n";
	
	[$str =~ $re];
}

sub _to_s
{
	my $obj = shift;
	if( defined($obj) && !ref($obj) )
	{
		$obj;
	}elsif( $obj && ref($obj) eq 'ARRAY' && @$obj==0 )
	{
		"";
	}elsif( ref($obj) && UNIVERSAL::isa($obj, 'Erlang::Atom') )
	{
		$$obj;
	}elsif( ref($obj) && UNIVERSAL::isa($obj, 'Erlang::Binary') )
	{
		$$obj;
	}else
	{
		undef;
	}
}


sub _dump
{
	my $log = shift;
	
	my $msg = shift;
	my $obj = shift;
	
	my $x = Dumper($obj);use Data::Dumper;
	$x =~ s/([^ -~\n])/sprintf('[%02x]',unpack("C",$1))/ge;
	$x =~ s/\r?\n/\r\n/g;
	print $log "$msg = ".$x;
}

# -----------------------------------------------------------------------------
# End of File.
# -----------------------------------------------------------------------------
__END__

=encoding utf8

=for stopwords
	YAMASHINA
	Hio
	ACKNOWLEDGEMENTS
	AnnoCPAN
	CPAN
	RT

=head1 NAME

example/perlre.pl - Erlang::Port example

=head1 SYNOPSIS

 example/$ erl
 1> perlre:start("perl -Mblib perlre.pl").
 #Port<0.94>
 2> perlre:match("abc", "(\\w+)(.+)").
 ["ab","c"]

=head1 DESCRIPTION

Example for L<Erlang::PerlPort>.

=head2 perlre:start().

=head2 perlre:start(Script).

Start script in an erlang external port.
Default is "perlre.pl".

=head2 perlre:stop().

Stop port.

=head2 perlre:match(String, Regexp).

execute $String =~ $Regexp in perl interpreter.

=head1 SEE ALSO

L<Erlang::Port>

=cut