Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

XML::Maker

by vadim_t (Acolyte)
on Oct 05, 2003 at 21:58 UTC ( #296796=sourcecode: print w/replies, xml ) Need Help??
Category: Miscellaneous
Author/Contact Info Vadim Trochinsky (vadim_t at teleline dot es)
Description: This is some code I wrote a while ago for generating XML. I hadn't heard of XML::Writer yet. Now that I tried XML::Writer I saw that it's missing a few features I want, and due to how it's written it'd be hard to add them. So I undusted this module, updated it, and added POD documentation.
#!/usr/bin/perl -w
# XML::Maker - A Perl module for generating XML
# Copyright (C) 2003 Vadim Trochinsky
#
# This program is free software; you can redistribute it
# and/or modify it under the terms of the GNU General
# Public License as published by# the Free Software
# Foundation; either version 2 of the License, or (at your
# option) any later version.

use Carp;
use strict;

package XML::Maker;

my $VERSION;
$VERSION = do { my @r = (q$Revision: 1.1 $ =~ /\d+/g);
sprintf"%d."."%02d" x $#r, @r };

sub new {
  my ($proto, $name, %params) = @_;
  my $self  = {};
  bless ($self, $proto);

  $self->name($name);
  $self->{separator}=", ";
  $self->{text}="";

  foreach my $key (keys %params) {
    $self->attribute($key, $params{$key});
  }

  return $self;
}


sub separator {
  my ($self, $new);

  my $old=$self->{separator};
  $self->{separator}=$new if defined $new;
  return $old;
}

sub remove {
  #This makes the tag empty. This is useful for two
  #purposes: freeing memory, and deleting a subtag.

  #NOTE: Tags don't disappear when user's reference goes out
  #of scope, because the root tag still has one. If you want
  #it to disappear, you need to call this.
  my ($self)=@_;

  $self->name("");
  $self->{subtag}={};

  if (defined $self->{parent}) {
    $self->{parent}->_remove_child($self);
  }
}

sub _parent {
  #DO NOT USE. This is only to be used internally.
  my ($self, $p)=@_;
  $self->{parent}=$p;
}

sub _curparent {
  #DO NOT USE. Returns current parent
  my ($self) = shift;
  return $self->{parent};
}

sub _remove_child {
  #DO NOT USE. This is only to be used internally.
  #This function is ineficent for large numbers of children.
  #If this is too slow, changing the module to use a hash
  # instead of an array should fix it.

  my ($self, $child)=@_;
  my ($tmp, $found, $i);

  for ($i=0;$i<=$#{$self->{subtag}};$i++) {
    $self->{subtag}[$i-1]=$self->{subtag}[$i] if $found;
    $found=1 if $self->{subtag}[$i] == $child;
  }

  unless($found) {
    confess("Internal error, can't remove inexistent child");
  }

  pop(@{$self->{subtag}});
}

sub name {
  #Gives a name to the tag.
  my ($self, $name)=@_;
  my $old = $self->{name};
  $self->{name}=$name if defined $name;

  return $old;
}

sub attribute {
  my ($self, $key, $value)=@_;
  my $old;

  if (defined $self->{params}->{$key}) {
    $old = $self->{params}->{$key};
  }

  if ( defined $value ) {
    $self->{params}->{$key} = _escape_attribute( $value );
  }

  return $old;
}

sub del_attribute {
  my ($self, $key)=@_;
  my $old;

  if (defined $self->{params}->{$key}) {
    $old = $self->{params}->{$key};
  }

  delete $self->{params}->{$key};

  return $old;
}

sub merge {
  #Works like set, except that for already defined
  #parameters it adds to them instead of replacing. For
  #example, for a parameter foo="bar", merge({foo => "baz"})
  #would change it  #to foo="bar, baz"

  my ($self, %params)=@_;
  my ($key);

  foreach $key (keys %params ) {
    if ( defined $self->{params} ) {
      $self->{params} .= $self->{separator}.$params{$key};
    } else {
      $self->{params} = $params{$key};
    }
  }
}

sub make {
  #Returns a text representation of the tag.
  #$tabs is the number of tabs to add. If this is not undef,
  #the tag will be printed with some pretty formatting.

  my ($self, $tabs)=@_;
  my ($ret, $key, $tmp, $subt, $i, $newtabs, $newid);

  #If the tag has been deleted, nothing to do.
  return "" if $self->{name} eq "";

  $ret="";
  $ret="\t" x $tabs if (defined $tabs);

  $ret.="<".$self->{name};  #Begin the tag: <tag

  foreach $key (keys(%{$self->{params}})) {
    #Add a key: key="value"
    #print "$key\n";
    $ret.=" ${key}=\"$self->{params}->{$key}\"";
  }

  $tmp="";
  if ($self->{text} ne "") {
    #Assume that if no text is present,
    # then the tag is of the form <tag/>
    $tmp=$self->{text};
  } elsif ($self->{subtag}) {
    #We've got subtags. We simply call make
    # for each of them, and add the results
    $i=0; $newtabs=$tabs;
    $newtabs++ if defined $newtabs;
    $tmp.="\n" if defined $tabs;

    foreach $subt (@{$self->{subtag}}) {
      $tmp.=$subt->make($newtabs);
    }
    $tmp.="\t" x $tabs if (defined $tabs);
  }

  if ($tmp) {
    #Add text and close: Text</message>
    $ret.=">$tmp</".$self->{name}.">";
  } else {
    #Close: />
    $ret.="/>";
  }
  $ret.="\n" if defined $tabs;
  return $ret;
}

sub addtext {
  my ($self, $text)=@_;
  error_exclusive() if defined $self->{subtag};
  $self->{text} .= _escape_text( $text );
}

sub text {
  my ($self, $text)=@_;
  my $old = $self->{text};

  $self->{text} = _escape_text( $text ) if defined $text;

  return $old;
}

sub subtag {
  my ($self,$name, %params)=@_;
  my ($subt);
  _error_exclusive() if $self->{text};
  $subt=XML::Maker->new($name, %params);
  $subt->_parent($self);
  push (@{$self->{subtag}},$subt);
  return $subt;
}

sub attach {
  my ($self, $subt)=@_;

  _error_exclusive() if $self->{text};
  $subt->_parent($self);
  push (@{$self->{subtag}},$subt);
  return $subt;
}

sub detach {
  my ($self, $subt) = @_;

  if ($subt->_curparent() == $self) {
    $self->_remove_child( $subt );
    $subt->_parent( undef );
  } else {
    confess("I can't detach a child that isn't mine");
  }

}


sub _error_exclusive {
  #This is just to avoid having 3 copies of the same message.
  confess("text and subtag/attach are mutually exclusive");
}

sub _escape_text {
  #Replaces unacceptable symbols in text
  my ($text)=@_;

  if ($text =~ /[\&\<\>]/) {
    $text =~ s/\&/\&amp\;/g;
    $text =~ s/\</\&lt\;/g;
    $text =~ s/\>/\&gt\;/g;
  }

  return $text;
}

sub _escape_attribute {
  #Replaces unacceptable symbols in attributes
  my ($text) = @_;

  if ($text =~ /[\&\<\>\"]/) {
    $text =~ s/\&/\&amp\;/g;
    $text =~ s/\</\&lt\;/g;
    $text =~ s/\>/\&gt\;/g;
    $text =~ s/\"/\&quot\;/g;
  }

  return $text;
}


1;
=head1 NAME

XML::Maker - OO Module for generating XML

=head1 SYNOPSIS

 #/usr/bin/perl -w

 use XML::Maker;

 my $root   = new XML::Maker("root");
 my $person = $root->subtag("person", name => 'Vadim',
                                      age => 22);
 my $info   = $person->subtag("info");
 $info->text("Perl programmer");

 print $root->make(0);



=head1 FEATURES

 * Easy and compact generation of XML
 * A function receiving an object can't change the parent.
 * It's impossible to make more than one root element
 * It's impossible to leave an element unclosed
 * Can print indented XML

=head1 DESCRIPTION

This module has been written to provide easy and safe
generation of XML. Unlike other modules, this one does not
produce output as soon as it can, but only when calling the
make() function. This is intentionally done to make sure
that it will always output well formatted XML.

One disadvantage of using this module is that everything is
kept in memory until you destroy the object. If your program
needs to generate a large amount of XML you should use
another module, for example see L<XML::Writer>.

Another intended feature is safety. If you pass a XML::Maker
object to a function it will be able to do whatever it wants
with it, but will not have access to its parent. This should
make it easier to find which part of the program is
generating bad output, but again, may not suit your needs.

For ease of use, XML closing tags are generated
automatically. If the resulting XML element contains a CDATA
area, then the output will contain opening and closing tags:

  <element key="value">text</element>

However, if there is no text, then an empty tag will be
generated:

  <element key="value"/>

Due to the design of this module, child objects will not go
out of scope as you might expect, see L</"remove()"> for an
explanation of this.

=head1 GET/SET METHODS

All the methods in this package that modify values provide
"get" and "set" functions at the same time. If passed a
value other than undef they will set the value to the passed
one.They will also return the old value of the parameter.
For example:

  # Set separator to |, and save the old one
  my $old_separator = $obj->separator("|");

  # (code)

  # Restore old separator
  $obj->separator( $old_separator );

=head1 METHODS

=head2 new(C<$name>, [C<%attributes>])

Create a new XML::Maker object. It is mandatory to pass a
C<$name> argument to indicate the name of this tag. C<new>
isnormally used to create the root element.

Optionally, you can pass a hash containing the attribute
names and values. The order in which they will be generated
in the resulting XML is undefined.

=head2 make([C<$tabs>])

Build a text representation of the object in the form of a
XML tree.The process will start at the object this is called
on, and extend to all of its children.

If C<$tabs> is defined, then the output will be indented,
starting with the specified number of tabs. You probably
want to use 0 here.

=head2 subtag(C<$name>, [C<%attributes>])

Create a child XML::Maker object. It works exactly the same
as new(), except that the new object will be linked to its
parent, instead of being independent.

Creating a new object with new, and then using attach() on
it has the same effect.

=head2 attach(C<$tag>)

Attach a XML::Maker object to another. The object attached
will become a child of the object being attached to. If the
child was a child of a XML::Maker object, then it will stop
being the child of that object.

=head2 detach(C<$tag>)

Detach a XML::Maker object. This only works if the object
being detached is a child of the object this method is
called on. The child object will then become independent
from its parent.

=head2 remove()

Empties the XML::Maker object, and calls to the parent to
remove its internal reference. This is done to completely
destroy a child object. For example, suppose this code:

  my $root = new XML::Maker('root');
  add_info( $root );
  print $root->make();

  sub add_info {
    my $obj = shift;
    my $tag = $obj->subtag('info', 'foo' => 'bar');
  }

Here, even though C<$tag> goes out of scope, it I<does not
disappear>, because C<$root> has an internal reference to
it. In order to make it vanish you need to call
C<$tag-E<gt>remove()>, or C<$obj-E<gt>detach($tag )> inside
the C<add_info> function. In the second case, $tag
will continue to exist until it goes out of scope.

=head2 separator([C<$value>])

Gets/sets the separator. The separator is used by the
C<merge>method, and by default is ", ".

=head2 name([C<$name>])

Gets/sets the name of the element.

=head2 attribute(C<$name>, [C<$value>])

Gets/sets an attribute of the element. This can't be used to
remove an attribute, use the L</"del_attribute()"> method
for that.

=head2 del_attribute(C<$name>)

Removes an attribute.

=head2 merge(C<$name>, C<$value>)

Appends the separator, then string to an attribute. For
example:

  $obj->attribute('meta', 'foo'); # Sets 'meta' to 'foo'
  $obj->merge('meta', 'bar');     # 'meta' is now 'foo, bar'

=head2 text([C<$text>])

Gets/sets the text of the current element. If you want to
remove the text simply pass an empty string ("")

=head2 addtext(C<$text>)

Adds a string to the text of the element.

=head1 NOTES

This module is not yet complete. Many XML features are
missing, for example:

 * Namespaces
 * DOCTYPE declarations
 * XML type declarations
 * Comments

I'm interested in feedback about this module, and comments
about new features,improvements or bug reports are welcome.

=head1 AUTHOR

Vadim Trochinsky (vadim_t at teleline dot es)

=head1 SEE ALSO

L<XML::Writer>

=head1 COPYRIGHT

XML::Maker - A Perl module for generating XML
Copyright (C) 2003 Vadim Trochinsky

This program is free software; you can redistribute it
and/or modify it under the terms of the GNU General Public
License as published by the Free Software Foundation; either
version 2 of the License, or(at your option) any later
version.

Updates:

Changed new() according to merlyn's suggestion.

Fixed example code in SYNOPSIS to set a text for the info tag, and not the person one

Replies are listed 'Best First'.
Re: XML::Maker
by jeffa (Bishop) on Oct 06, 2003 at 04:32 UTC
    This code inspired me to see how lazy i could get ... in a golfish way. It's crude and crufty, but it gets the job done. (CGI.pm can do this too, by the way ... search the docs for the -any pragma.)
    package XML::AUTOLOAD; use vars qw($AUTOLOAD); sub new {bless{},shift}; sub DESTROY {} sub AUTOLOAD { my ($self,$attr,@data) = @_; my ($tag) = $AUTOLOAD =~ /:(\w+)$/; my $out = "<$tag"; if (ref $attr eq 'HASH') { $out .= qq| $_="$attr->{$_}"| for keys %$attr; } elsif (defined $attr) { unshift @data,$attr; } $out .= @data ? ">@data</$tag>" : " />"; } 1; =head1 NAME XML::AUTOLOAD - Generates XML =head1 SYNOPSIS #!/usr/bin/perl use strict; use warnings; my $xml = XML::AUTOLOAD->new; print $xml->xml( $xml->foo({baz => 'qux'}, $xml->bar(0), $xml->baz({foo=>'bar'}), ), $xml->qux, ); =cut

    jeffa

    L-LL-L--L-LL-L--L-LL-L--
    -R--R-RR-R--R-RR-R--R-RR
    B--B--B--B--B--B--B--B--
    H---H---H---H---H---H---
    (the triplet paradiddle with high-hat)
    
      That's the main part of XML::Generator. :)

      Makeshifts last the longest.

      Nice!

      BTW, the idea behind this module is not just laziness. Yes, as a Lazy Perl programmer I saw no need to have one line of extra code per element that could be avoided. There's another issue: This code is much more fit for my server.

      XML::Writer generates code on the fly, that's nice and efficent, but inadequate for my needs. In my server, which uses XML I have basically this:

      my $root = new XML::Maker("data"); $parser->parse("message"); send_to_client($root->make());

      Here's how it works: The client sends one or more commands inside <data>. I make a <data> element, and start parsing, generating XML during the process. Then I send the whole reply at once.

      With XML::Writer there's the problem of that <data></data> will be sent if there's no output because it's impossible to determine whether XML has been generated or not. In my case, however, it's trivial to count the number of children.

      Another issue is rolling back XML generation. My parser works by calling callbacks for every registered command, which then may generate XML. A command might generate a tree and send it to the client. But, what happens when it's in the process of generating the tree and something suddenly goes wrong?

      XML::Writer will have already sent the partial output to the socket. The client will get incomplete data, or very possibly, invalid XML. Since the server will continue processing and try to reply to the next command, the client might not be able to parse it. Of course I could make it close all the elements, and then append an error message, but that's still not good. Parsing goes from top to bottom, so first it'd interpret the partial results, and only then get to the error message.

      My module lets me remove a subtree at any time I want. So I can start generating, remove the results I got so far, and put an error message in its place.

•Re: XML::Maker
by merlyn (Sage) on Oct 06, 2003 at 00:53 UTC

      Interesting, thanks for the link.

      That module is from a long time ago, btw, so I probably wrote that line without understanding what it does. Now I can definitely see that what you say makes a lot of sense.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://296796]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (3)
As of 2022-01-25 07:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:












    Results (65 votes). Check out past polls.

    Notices?