view release on metacpan or  search on metacpan

Bind.pm  view on Meta::CPAN

Note that the module simply replaces B<(?#E<lt>field nameE<gt>> with
B<(> and binds the field's name to buffer. It does not check for
syntax correctness, so any fancier usage may crash.


=head1 INLINE FILTERING

Inline filtering now works with B<embedded syntax>. Matched parts are
saved in $_, and you can do some simple transformation within the
brackets before they are exported.

  bind($string, qr'# (?#<field_1>{ s/\s+//, $_ }\w+) (?#<field_2>{ $_*= 10, $_ }\d+)\n'm);


=cut

package Regexp::Bind;

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(bind global_bind bind_array global_bind_array);
our $VERSION = '0.05';

our $USE_NAMED_VAR = 0;
use strict;
no strict 'refs';

sub _get_fields {
    my @field;
    while($_[0] =~ s,\(\?#<(\w+?)>,(,o){
	  push @field, $1;
    }
    @field;
}

sub _get_filters {
    my @filter;
    # well, i know, this vulgar pattern doesn't really work for all occasions
    # i will introduce Text::Balanced with this.
    while($_[0] =~ s,(\(\?#(?:<(?:\w+?)>))\{(.+?)\},$1,o){
      push @filter, $2;
    }
    (undef, map{eval 'sub { local $_ = shift;'.$_.'};' }@filter);
}      

use Data::Dumper;
use B::Deparse;
sub bind {
    my $string = (ref($_[0]) eq 'SCALAR' ? ${shift()} : shift) || die "No string input";
    my $regexp = shift || die "No regexp input";

    my @filter = _get_filters $regexp;
    my @field = _get_fields $regexp;
    @field = @_ unless @field;


    $string =~ m/$regexp/;
    my $cnt = 1;
    if($USE_NAMED_VAR){
	my $pkg = (caller)[0];
	foreach my $field (@field){
	    my $t = ref($filter[$cnt]) eq 'CODE'? $filter[$cnt]->(${$cnt}) : ${$cnt};
	    $cnt++;
	    ${"${pkg}::$field"} = $t;
	}
    }
    else {
      +{
	map{ 
	  my $t = ref($filter[$cnt]) eq 'CODE'? $filter[$cnt]->(${$cnt}) : ${$cnt};
          $cnt++;
	  $_ => $t;
	} @field
       };
    }
}

sub bind_array {
   my $string = (ref($_[0]) eq 'SCALAR' ? ${shift()} : shift) || die "No string input";
   my $regexp = shift || die "No regexp input";
   my $cnt = 1;
   [ ($string =~ m/$regexp/) ];
}


sub global_bind {
    my $string = (ref($_[0]) eq 'SCALAR' ? ${shift()} : shift) || die "No string input";
    my $regexp = shift || die "No regexp input";

    my @filter = _get_filters $regexp;
    my @field = _get_fields $regexp;
    @field = @_ unless @field;

    my @bind;
    my $cnt;
    while($string =~ m/$regexp/g){
      $cnt = 1;
      push @bind,
	+{
	  map{
	    my $t = ref($filter[$cnt]) eq 'CODE'
	      ? $filter[$cnt]->(${$cnt}) : ${$cnt};
            $cnt++;
	    $_ => $t;
	  } @field
	 };
    }
    wantarray ? @bind : \@bind;
}

sub global_bind_array {
   my $string = (ref($_[0]) eq 'SCALAR' ? ${shift()} : shift) || die "No string input";
   my $regexp = shift || die "No regexp input";

   my @bind;
   push @bind, [ map{${$_}} 1..$#+ ] while $string =~ m/$regexp/g;
   @bind;
}

1;