view release on metacpan or  search on metacpan

lib/Data/Dump/XML/Parser.pm  view on Meta::CPAN

		
		$blesser ? &$blesser ($$ref, $parent_class) : bless ($$ref, $parent_class)
			if defined $parent_class;

		
	} elsif ($tag eq $ref_element) {
		my $value = undef;
		$$ref = \$value;
		
		$$ref = ${$p->{'id'}->[$attr{'to'}]}
			if (defined $attr{'to'});
		
		push @{$p->{'stack'}}, $$ref;
	
	} elsif ($tag eq $undef) {
	
		$$ref = undef;
		push @{$p->{'stack'}}, undef;
	
	} elsif ($tag eq $empty_hash) {
	
		$$ref = {};
		push @{$p->{'stack'}}, undef;
	
	} elsif ($tag eq $empty_array) {
	
		$$ref = [];
		push @{$p->{'stack'}}, undef;
	
	} elsif ($key_as_hash_element or ($tag eq $hash_element and exists $attr{$d->{hash_element_attribute_name}})) {
		#$$ref = {}
		#	if $defined_parent;
		
		my $key = $tag;
		$key = delete $attr{$d->{hash_element_attribute_name}}
			if exists $attr{$d->{hash_element_attribute_name}};
		
		die "hash element '$key' must appear in hash context" 
			if defined $$ref and Data::Dump::XML::reftype ($$ref) ne 'HASH';
		
		unless (defined $$ref) {
			# copy all attributes except _*
			foreach my $k (keys %$parent_attr) {
				# next if substr ($k, 0, 1) eq '_';
				$$ref->{"\@$k"} = $parent_attr->{$k};
			}
		}
		
		die "hash element '$key' already present" 
			if exists $$ref->{$key};
		$$ref->{$key} = undef;
		
		push @{$p->{stack}}, \(${$ref}->{$key});
		
		$blesser ? &$blesser ($$ref, $parent_class) : bless ($$ref, $parent_class)
			if defined $parent_class;
	} else {
		warn "found unknown element $tag";
	}
	
	# mix of pcdata and elements not allowed, ignore chars
	$p->{char} = '';
	
	$p->{id}->[$parent_id] = $ref
		if ($parent_id);
}

sub characters {
	my ($p, $str) = @_;
	$p->{'char'} .= $str->{'Data'}
		if defined $str->{'Data'};
}

sub end_element {
	my ($p, $element) = @_;
	
	my $d = $p->{defaults};
	
	my $tag = $element->{'LocalName'};
	
	my $depth = \$p->{depth};
	my $str = $p->{'char'};
	my $ref = pop @{$p->{'stack'}};
	
	$p->{'char'} = '';
	
	my $attr = pop @{$p->{'attr'}};
	my $attributed_keys = {map {$_ => $attr->{$_}} grep {!/^_/} keys %$attr};
	
	my $has_attrs = scalar keys %$attributed_keys;
	
	if( $$depth < $p->{max_depth}) {
		#print ' 'x $$depth, "- this element had children\n";
	} else {
		# here processing for empty tags
		
		#my $key = $tag;
		#$key = delete $attr{$d->{hash_element_attribute_name}}
		#	if exists $attr{$d->{hash_element_attribute_name}};


		if (
			# ($tag eq $d->{array_element} or $tag eq $d->{hash_element}) and
			$has_attrs
		) {
			$$ref->{'#text'} = $str
				if defined $str and $str ne '';
	
			foreach my $k (keys %$attributed_keys) {
				$$ref->{"\@$k"} = $attributed_keys->{$k};
			}
	
		} elsif ($tag ne $d->{'undef'}) {
			if ($tag eq $d->{ref_element} and $attr->{'to'}) {
	#	  print "'", $p->{'attr'}->[0]->{'to'}, "'\n";
	#	  my $place = $p->{'attr'}->[0]->{'to'};
	#	  
	#	  $$ref = ${$p->{'id'}->[$place]}
	#	   if (defined $place);
		  
			} else {