I'm not familliar with the XML specification, but if you gave a true set of sample data, this quick hack would be able to produce that.
First the script:#!/usr/local/bin/perl -w #Script use strict; use OOXML; my $xmldoc = new OOXML("house"); my $groundfloor = $xmldoc->node("groundfloor"); my $kitchen = $groundfloor->node("room", name=>"kitchen"); my $lounge = $groundfloor->node("room", name=>"lounge"); $kitchen->tag("item",name=>"cooker", colour=>"white"); $lounge->tag("item",name=>"sofa",colour=>"turgid brown"); $kitchen->tag("item",name=>"sink",colour=>"silver"); $lounge->tag("item",name=>"chair",colour=>"lime green"); print "First example... Matches yours\n"; $xmldoc->write(); my $secfloor = $xmldoc->node("2ndfloor", level => 2); my $bedroom = $secfloor->node("room", name=>"Bedroom 1", size=>"400 sq + ft"); my $bathroom = $secfloor->node("room", name=>"Bathroom", size=>"1/2"); $bedroom->tag("furniture",name=>"bed",colour=>"mahogony"); $bedroom->tag("furniture",name=>"dresser", colour=>"black"); $bedroom->tag("fixture", name=>"ceiling fan", colour=>"gold", action=> +"rotation"); $bathroom->tag("item", name=>"washcloth",colour=>"blue"); $bathroom->tag("furniture",name=>"sink", colour=>"white"); $bathroom->tag("furniture",name=>"toilet", colour=>"white"); my $saying = $bathroom->text(nodename=>"walldecor", name=>"saying"); $saying->text(text =>"If at first you don't fricasee; fry, fry a hen." +); $saying->text(nodename=>"strong",text=>"!!!!"); $saying->text(text =>"After the strong tag"); print "\n\n\nSecond example... more functionality\n"; $xmldoc->write(); print "\n\n\nThird example... set the increase(10) and starting(5) ind +ent levels\n"; $xmldoc->write(10,5); print "\n\n\nFourth example... Going to a file \"out.xml\"\n"; $xmldoc->write('','',"out.xml");
And then the module
#!/usr/local/bin/perl -w # Module package OOXML; use strict; sub new { my ( $class, $root, %params ) = @_; my $self={}; $self->{name} = $root; $self->{nodes} = (); $self->{tags} = (); $self->{params} = {}; if ( defined %params ) { for my $param ( keys %params ) { $self->{params}{$param} = $params{$param}; } } $self->{params}{type} = "main" if ( ! exists $self->{params}{type} + ); return bless $self, $class; } sub node { my ( $self, $node, %params ) = @_; push @{$self->{nodes}}, $self->new($node,type =>"node",%params); return bless $self->{nodes}[-1]; } sub tag { my ( $self, $tag, %params ) = @_; push @{$self->{tags}}, $self->new($tag,type=>"tag",%params); return bless $self->{tags}[-1]; } sub text { my ( $self, %params ) = @_; push @{$self->{nodes}}, $self->new("textnode",type=>"text",%params +); return bless $self->{nodes}[-1]; } sub write { my ( $self, $levelup, $level,$doc,$class ) = @_; my $node; $level = 0 if ( ! defined $level ) || $level eq ""; $levelup = 4 if ( ! defined $levelup ) || $levelup eq ""; if ( defined $doc ) { open STDOUT, ">>$doc" || return (1,"Couldn't open output file: $!" +); } print "\n" if ( $self->{params}{type} ne "text" && defined $class +&& $class->{params}{type} eq "text" ) ; print " " x $level if ($self->{params}{type} !~ /^text$/); print " " x $level if ($self->{params}{type} eq "text" && $class-> +{name} ne "textnode"); if ( $self->{params}{type} eq "text" ) { if ( exists $self->{params}{nodename} ) { print "<$self->{params}{nodename}"; for my $param ( keys %{$self->{params}} ) { next if ( $param eq "type" || $param eq "nodename" || $param e +q "text" ); print " $param=\"$self->{params}{$param}\""; } print ">"; } print "$self->{params}{text}" if ( exists $self->{params}{text} ); }else { print "<$self->{name}"; for my $param ( keys %{$self->{params}} ) { next if $param eq "type"; print " $param=\"$self->{params}{$param}\""; } print ">\n"; } my $test = 0; my $lastnode; for $node ( @{$self->{nodes}} ) { bless $node; print "\n" if $node->{name} ne "textnode" and ($test == 12); $test = $node->write($levelup, $level+$levelup, $doc, $self); $lastnode = bless $node; } for my $tag ( @{$self->{tags}} ) { bless $tag; if ( defined $lastnode && $lastnode->{name} eq "textnode" ) { print "\n"; undef $lastnode; } print " " x ( $level + $levelup) . "<$tag->{name}"; for my $param ( keys %{$tag->{params}} ) { next if $param eq "type"; print " $param=\"$tag->{params}{$param}\""; } print ">\n"; } if ( $self->{params}{type} eq "text") { if ( exists $self->{params}{nodename} ) { print "</$self->{params}{nodename}>"; } return 12; } else { print "\n" if ( defined $node && $node->{name} eq "textnode"); print " " x $level . "</$self->{name}>\n"; } return 0; } 1;
Course it would be stupid to use this when there are peer reviewed/tried and true modules out there, that probably also adhere to the standard ( which this doesn't... lets you do pretty much whatever you want )... but it only took m a few minutes to throw together, so...
In reply to (raflach sample module) Re: Using Perl to create XML
by raflach
in thread Using Perl to create XML
by Speedfreak
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |