File Coverage

blib/lib/XML/Easy/ProceduralWriter.pm

Criterion	Covered	Total	%
statement	41	44	93.1
branch	10	16	62.5
condition	2	6	33.3
subroutine	10	11	90.9
pod	5	5	100.0
total	68	82	82.9

package XML::Easy::ProceduralWriter;
use base qw(Exporter);

use strict;
use warnings;

our @EXPORT;
our $VERSION = "1.00";

use XML::Easy qw(xml10_write_document);
use Scalar::Util qw(blessed);
use Carp qw(croak);

=head1 NAME

XML::Easy::ProceduralWriter - even easier writing of XML

=head1 SYNOPSIS

  use XML::Easy::ProceduralWriter;

  my $octlets = xml_bytes {
    element "flintstones", contains {
      element "family", surname => "flintstone", contains {
        element "person", hair => "black", contains {
          text "Fred";
        };
        element "person", hair => "blonde", contains {
          text "Wilma";
        };
        element "person", hair => "red", contains {
          text "Pebbles";
        };
      };
      element "family", surname => "rubble", contains {
        my %h = ("Barney" => "blonde", "Betty" => "black", "BamBam" => "white");
        foreach (qw( Barney Betty BamBam )) {
          element "person" hair => $h{$_}, contains { text $_ };
        }
      }
    };
  };

  # outputs

  FredWilmaPebblesBarneyBettyBamBam

=head1 DESCRIPTION

A procedural wrapper around XML::Easy to provide an alternative way of writing XML

=head2 Tutorial

You can use this module to write standard XML.  You start by saying you want some xml_bytes:

  my $octlets = xml_bytes {
    ...
  };

The C command adds a 'tag' to the output.  The simpliest form is:

  xml_bytes {
    element "a";
  };

Which outputs



Note that xml_bytes taks a block - not a data structure - so you can put anything code
you want inside block.

  xml_bytes {
    if ($foo) { element "a"; }
    else      { element "b"; }
  }

(This is what we mean by "Procedural Writer")

You can also use attributes:

  xml_bytes {
    element "a", href => "nojs.html", onclick => "openpopup()";
  }

Which outputs



You can use the C keyword to add content to the XML node.

  element "a", href => "nojs.html", onclick => "openpopup()", contains {
    # ... content here ...
  };

The content can be other tags, text, and any other valid Perl:

  element "a" href => "nojs.html", onclick => "openpopup()", contains {
    text "Click ";
    element "strong", contains {
      text "Here ";
      element "em", contains { text "NOW" };
    };
    text " please" if $polite;
    text " $name" if $name;
  }

Which outputs

  Click Here NOW please Mark

=head2 Functions

This module exports several functions into your namespace by default.  You
can use standard Exporter parameters to control which of these are imported
into your namespace

=over

=item xml_element { ... }

Takes a codeblock.  The code inside the codeblock should call "element" at
least once.  The XML::Easy::Element created by that element command is
returned.

You don't normally want to call this function directly, using either C
to create something you can print out or C to create individual xml "tags".
The one occasion that it might make sense to use this function is where you want
to use an encoding other than UTF-8:

  use XML::Easy qq(xml10_write_document);
  print xml10_write_document(xml_element {
    element "song", title => "Green Bottles", contains {
      foreach my $bottles (reverse (1..10)) {
        element "verse", contains {
          element "line", contains {
            text "$bottles green bottle";
            text "s" unless $bottles == 1;
            text " hanging on the wall";
          } for (1..2);
          element "line", contains {
            text "if 1 green bottle should accidentally fall";
          };
          element "line", contains {
            text "then they'd be ".($bottles > 1 ? $bottles-1 : "no")." green bottle";
            text "s" unless $bottles-1 == 1;
            text " hanging on the wall";
          };
        };
      }
    }, "UTF-16BE");

=cut

sub xml_element(&) {

  # create a temporary place to store whatever we're putting
  local @XML::Easy::ProceduralWriter::stuff = ();
  shift->();

  croak "No root node specified"
    unless @XML::Easy::ProceduralWriter::stuff;

  croak "More than one root node specified"
    if @XML::Easy::ProceduralWriter::stuff > 3;

  croak "Text before root node!"
    unless $XML::Easy::ProceduralWriter::stuff[0] eq "";

  croak "Text after root node!"
    if defined($XML::Easy::ProceduralWriter::stuff[2]) && $XML::Easy::ProceduralWriter::stuff[2] ne "";

  return $XML::Easy::ProceduralWriter::stuff[1]
}
push @EXPORT, "xml_element";


=item xml_bytes { ... }

The same as xml_element, but returns a scalar containing octlets that have a UTF-8
encoded representation of the character representation of the string (i.e. this is
what you want to use to create something you can pass to C)

=cut

sub xml_bytes(&) {
  my $data = shift;
  local $Carp::CarpLevel = $Carp::CarpLevel + 1;
  return xml10_write_document(&xml_element($data), "UTF-8"); ## no critic Subroutines::ProhibitAmpersandSigils
}
push @EXPORT, "xml_bytes";

=item element $element_name, $key => $value, $key => $value, $block

Create an XML::Easy::Element element and add it to the enclosing element.

=cut

sub element($;@) {
  my $tag_name = shift;

  my @stuff;
  if (ref $_[-1] && ref $_[-1] eq "CODE") {
    local @XML::Easy::ProceduralWriter::stuff = ();
    (pop)->();
    @stuff = @XML::Easy::ProceduralWriter::stuff;
  }
  push @stuff, "" unless @stuff % 2;
  push @XML::Easy::ProceduralWriter::stuff, "" unless @XML::Easy::ProceduralWriter::stuff % 2;
  push @XML::Easy::ProceduralWriter::stuff, XML::Easy::Element->new($tag_name, {@_}, \@stuff);
  return;
}
push @EXPORT, "element";

=item text $text

Create text and add it to the enclosing element.

=cut

# simply takes it's argument and appends it to @XML::Easy::ProceduralWriter::stuff
sub text($) {
  my $text = shift;
  if (@XML::Easy::ProceduralWriter::stuff % 2)
    { $XML::Easy::ProceduralWriter::stuff[-1] .= $text }
  else
    { push @XML::Easy::ProceduralWriter::stuff, $text }
  return;
}
push @EXPORT, "text";

=item contains { ... }

Syntatic sugar for "sub { ... }"

=cut

# syntatic sugar to allows us to write "contains { ... }" rather than "sub { ... }"
sub contains (&) {
  return $_[0]
}
push @EXPORT, "contains";

=back

=head1 AUTHOR

Mark Fowler .  Developed by Photoways whist working
on the Photobox website.

Copyright (C) Photoways Ltd 2008, all rights reserved.

If you send me an email about this module, there's a good chance my overly
agressive spam filter will never let me see it.  Please use http://rt.cpan.org/
to report bugs and request new features instead.

=head1 LICENSE

This module is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 BUGS

Chucks a lot of stuff into your namespace.

Some people might consider it a bug that this module does not produce
a C<< > declaration when we convert to bytes.  I consider this
a feature.

=head1 SEE ALSO

L

=cut

1;