view release on metacpan or  search on metacpan

Data/Stag/StagImpl.pm  view on Meta::CPAN

        }
    }
    else {
	my %trap_h = @_;
	my %opt_h = ();
	%trap_h =
	  map {
	      if ($_ =~ /^-(.*)/) {
		  $opt_h{lc($1)} = $trap_h{$_};
		  ();
	      }
	      else {
		  ($_ => $trap_h{$_})
	      }
	  } keys %trap_h;
	load_module("Data::Stag::BaseHandler");
	$handler = Data::Stag::BaseHandler->new;
	$handler->trap_h(\%trap_h);
	
	if ($opt_h{notree}) {
	    load_module("Data::Stag::null");
	    my $null = Data::Stag::null->new;
	    my $ch = Data::Stag->chainhandlers([keys %trap_h],
					       $handler,
					       $null);
	    return $ch;
	}
    }
    return $handler;
}
*mh = \&makehandler;

sub chainhandlers {
    my $tree = shift;
    my $block = shift;
    my @sh = @_;

    load_module("Data::Stag::ChainHandler");
    my $handler = Data::Stag::ChainHandler->new;
    $handler->subhandlers([
                           map {
                               if (ref($_)) {
                                   if (ref($_) eq 'HASH') {
                                       # make a new handler
                                       makehandler($tree, %$_);
                                   }
                                   else {
                                       # assume it is an object
                                       $_;
                                   }
                               }
			       elsif (!$_) {
				   ()
			       }
                               else {
                                   # assume it is string specifying format
                                   _gethandlerobj($tree, -fmt=>$_)
                               }
                             } @sh
                          ]);
    $handler->blocked_event($block);

    # if no explicit blocked events set, then introspect
    # the subhandlers to see if they declare what they emit
    if (ref($block) && !@$block) {
        my @emits = map {$_->CONSUMES} @{$handler->subhandlers};
        $handler->blocked_event(\@emits);
    }
    return $handler;
}

sub transform {
    my $tree = shift;
    my @T = @_;
    my %trap_h = 
      map {
	  my ($from, $to) = @$_;
	  $from=> sub {
	      my $self = shift;
	      my $stag = shift;
#	      print STDERR "Transforming $from => $to\n";
#	      print STDERR $stag->sxpr;
	      my $data = $stag->data;
	      my @path = splitpath($to);
	      my $node = [];
	      my $p = $node;
	      while (@path) {
		  my $elt = shift @path;
		  $p->[0] = $elt;
		  if (@path) {
		      my $newpath = [];
		      $p->[1] = [$newpath];
		      $p = $newpath;
		  }
		  else {
		      $p->[1] = $data;
		  }
	      }
#	      @$stag = @$node;
#	      print STDERR $stag->sxpr;
	      return $node;
#	      return 0;
	  }
      } @T;
    load_module("Data::Stag::BaseHandler");
    my $handler = Data::Stag::BaseHandler->new;
    $handler->trap_h(\%trap_h);
    $tree->events($handler);
    my $nu = $handler->stag;
    @$tree = @$nu;
    return;
}
*t = \&transform;

# transform stag into hash datastruct;
# stag keys become hash keys (unordered)
# single valued keys map to single value (itself a hash or primitive)
# multivalued map to arrayrefs
sub hash {
    my $tree = shift;
    my ($ev, $subtree) = @$tree;

    # make sure we have non-terminal
    if (ref($subtree)) {
	# make hash using stag keys
        my %h = ();
	foreach my $subnode (@$subtree) {