|
|
| (8 intermediate revisions by 2 users not shown) |
| Line 1: |
Line 1: |
| − | #!/usr/bin/perl
| + | {{lowercase}}{{svn|tools|xml.pl}} |
| − | # A snipit for reading/writing nodal XML files
| + | [[Category:Tools]][[Category:PERL]] |
| − | # - It can handle: Attributes, Mixed content
| |
| − | # - It cannot handle: Badly formed XML, CDATA sections
| |
| − | use strict;
| |
| − | | |
| − | # The XML is parse into a tree
| |
| − | # - each node in the tree is a hash of attributes plus .name and .content keys
| |
| − | # - each .content value is a ref to a list of ordered nodes/texts
| |
| − | # - only one root is allowed
| |
| − | sub xmlParse {
| |
| − |
| |
| − | # First convert XML into a list split at every tag, ie. <tag> </tag> or <tag/>
| |
| − | # - Each tag is five list items (first /, name, atts, second /, text between this and next)
| |
| − | @_ = shift =~ /<\s*(\/?)([-a-z0-9_:]+)\s*(.*?)\s*(\/)?>\s*(.*?)\s*(?=<|$)/gi;
| |
| − |
| |
| − | # Loop through all the tags and compile them into a tree
| |
| − | my $ptr = my $root = {};
| |
| − | my @path = ();
| |
| − | while ( $#_ >= 0 ) {
| |
| − | my ( $close, $name, $atts, $leaf, $text ) = ( shift, shift, shift, shift, shift );
| |
| − | # Create a new node in the current content and update ptr if <tag/> or <tag>
| |
| − | # - Includes hash of atts: /PATTERN/g returns a key,val list which can be treated as a hash
| |
| − | unless ($close) {
| |
| − | my $node = { '.name' => $name, $atts =~ /([-a-z0-9_:]+)\s*=\s*"(.*?)"/gi };
| |
| − | push @{$$ptr{'.content'}}, $node; # Push the node onto the current content list
| |
| − | push @path, $ptr; # Move current focus into the new node
| |
| − | $ptr = $node;
| |
| − | }
| |
| − | $ptr = pop @path if $close or $leaf; # Move ptr up one level is </tag> or <tag/>
| |
| − | push @{$$ptr{'.content'}}, $text if $text; # Add the after-node-content part to the current level
| |
| − | }
| |
| − | | |
| − | return $root;
| |
| − | }
| |
| − | | |
| − | | |
| − | # Construct XML text from passed hash tree
| |
| − | sub xmlBuild {
| |
| − | my ($level, $ptr) = @_;
| |
| − | my $indent;
| |
| − | $indent .= ' ' for 1..$level;
| |
| − | my $name = $$ptr{'.name'};
| |
| − | print "$indent$name\n" if $name;
| |
| − | for ( @{$$ptr{'.content'}} ) {
| |
| − | xmlBuild( $level+1, $_ ) if ref eq 'HASH';
| |
| − | }
| |
| − | }
| |
| − | | |
| − |
| |
| − | # Test
| |
| − | xmlBuild 1, xmlParse '
| |
| − | <test>hello</test>
| |
| − | <properties a="1" b="1" >
| |
| − | content
| |
| − | <test2 b="eee"/>xxx
| |
| − | <properties a="1" b="1" >
| |
| − | content
| |
| − | <test2 b="eee"/>xxx
| |
| − | </properties>
| |
| − | </properties>
| |
| − | <associations a="1" b="ddd"/>
| |
| − | ';
| |
