sub returnRecordHeadings { my ( $self, $xml ) = @_; return undef if ( not $xml ); undef $HEADER; # Reset the global HEADER var my @header; # Declare the header object my $rootnode; # Declare the starting point of the XML doc my $parser = new XML::DOM::Parser; # Create new DOM Parser object # Parse the file or the string representing it $parser = ( -e "$xml" ) ? $parser->parsefile("$xml") : $parser->parse("$xml"); ### Traverse, Breath first ### my $rootnodes = $parser->getElementsByTagName ( "ruleset" ); my $rn = $rootnodes->getLength; for ( my $i = 0; $i < $rn; $i++ ) { my $root = $rootnodes->item ($i); # Gather data for this root node my $rootname = $root->getAttributeNode ("name")->getValue; # Get the root element name printf "%s %s name=>%s is of type=>%s\n", $root->getNodeName(), $i, $rootname, $root->getNodeType if ( $DEBUG ); if ( $root->getNodeType =~ m/1|ELEMENT_NODE/i ) { # Check for correct elemet type before parsing push @{ $HEADER }, { "$rootname" => [] } if ( $rootname ); # Save rootname in HEADER if I have a rootname my $rootref = \$HEADER->[$i]; # update array ref print "---RootRef Dump---\n", Dumper( $rootref ), "\n" if ( $DEBUG ); ### iterate over the result nodes ### for my $elem ( $root->getElementsByTagName( "*" ) ) { if ( ( scalar( @{ $elem->getChildNodes() } ) > 1 ) and ( $elem->getParentNode()->getAttribute("name") eq "$rootname" ) ) { if ( $DEBUG ) { printf "Element=>%s\n", $elem; printf "Has kids=>%s\tHow many=>%s\n", ( $elem->hasChildNodes() ) ? "Yes" : "No", scalar( @{ $elem->getChildNodes() } ); printf "\t%s ::> %s\n", $root->getChildIndex( $elem ), $elem->getNodeName(); printf "\t\tname='%s'\n", $elem->getAttribute("name") || "No Child"; } &_traverse_element( $elem, $rootref, 2 ); print '*' x 5 . "\n" if ( $DEBUG ); } else { next } } } print '~*' x 10, "\n" if ( $DEBUG ); } # Avoid memory leaks - cleanup circular references for garbage collection $parser->dispose; return $HEADER; sub _traverse_element { my( $elem, $rootref, $count ) = @_; my $rootname = ( keys( %{ $$rootref } ) )[0] || "NO ROOT NAME!"; my $parent = $elem->getParentNode()->getAttribute("name"); my $grandparent = $elem->getParentNode()->getParentNode()->getAttribute("name"); my $current = $elem->getAttribute("name"); if ( $DEBUG ) { printf "\t" x $count . "Current node=>%s\n", $elem->getNodeName(); printf "\t" x $count . "Root Name=>%s\n", $rootname || "No Root Name Value"; printf "\t" x $count . "Current Parent=>%s\n", $parent || $grandparent || "No Parent"; printf "\t" x $count . "Current GrandParent=>%s\n", $grandparent|| "No Grandparent"; printf "\t" x $count . "Current Node=>%s\n", $current || "No Current node name"; } # If my parent is my root if ( $parent eq $rootname ) { printf "\t" x ++$count . "--->'%s' child element of '%s' which is a %s\n", $current, $rootname, $elem->getNodeName() if ( $DEBUG ); ### Decide where to place new element ### ### If current element has a name attribute ### ### Add current element to the array ref ### if ( $current ) { push @{ $$rootref->{"$parent"} }, { $current => [] } } printf "\t" x $count . "RootRef defined?=>%s\n", ( defined $$rootref->{"$parent"}->[$#{ $$rootref->{"$parent"} }] ) ? "Yes" : "No" if ( $DEBUG ); ### Update array ref to new location ### if ( ( defined $$rootref->{"$parent"}->[$#{ $$rootref->{"$parent"} }] ) and ( $current ) ) { $rootref = \$$rootref->{"$parent"}->[$#{ $$rootref->{"$parent"} }]; print "\t" x $count . "---Updated RootRef---\n" if ( $DEBUG ); } # If this element has kids, traverse them $count++; printf "\t" x $count . "Has kids=>%s\tHow many=>%s\n", ( $elem->hasChildNodes() ) ? "Yes" : "No", scalar @{ $elem->getChildNodes() } if ( $DEBUG ); for my $child ( $elem->getChildNodes() ) { if ( ( scalar @{ $child->getChildNodes() } > 1 ) and ( $child->getNodeName() !~ m/^radio|select|checkbox/i ) ) { ### Add current element to the array ref here, if not current ### if ( not $current ) { push @{ $$rootref->{"$parent"} }, { $child->getAttribute("name") => [] } } if ( $DEBUG ) { printf "\t" x $count . "%s :::> %s name='%s'\n", $elem->getChildIndex( $child ), $child->getNodeName(), $child->getAttribute("name") || "No Name"; printf "\t" x $count . "Has kids=>%s\tHow many=>%s\n", ( $child->hasChildNodes() ) ? "Yes" : "No", scalar @{ $child->getChildNodes() }; } # Update rootref, and pass &_traverse_element( $child, $rootref, $count ); print "\t" x $count . '*-' x 10, "\n" if ( $DEBUG ); } } } } } # End Sub