XML-Writer

 view release on metacpan or  search on metacpan

Writer.pm  view on Meta::CPAN

    my $currentName = pop @elementStack;
    $name = $currentName unless $name;
    $elementLevel--;
    if ($dataMode && $hasElement) {
      $output->print("\n");
      $output->print($dataIndent x $elementLevel);
    }
    $output->print("</$name$nl>");
    if ($dataMode) {
      $hasData = pop @hasDataStack;
      $hasElement = pop @hasElementStack;
    }
  };

  my $SAFE_endTag = sub {
    my $name = $_[0];
    my $oldName = $elementStack[$#elementStack];
    if ($elementLevel <= 0) {
      croak("End tag \"$name\" does not close any open element");
    } elsif ($name && ($name ne $oldName)) {
      croak("Attempt to end element \"$oldName\" with \"$name\" tag");
    } else {
      &{$endTag};
    }
  };

  my $characters = sub {
    my $data = $_[0];
    if ($data =~ /[\&\<\>]/) {
      $data =~ s/\&/\&amp\;/g;
      $data =~ s/\</\&lt\;/g;
      $data =~ s/\>/\&gt\;/g;
    }
    &{$escapeEncoding}($data);
    $output->print($data);
    $hasData = 1;
  };

  my $SAFE_characters = sub {
    if ($elementLevel < 1) {
      croak("Attempt to insert characters outside of document element");
    } elsif ($dataMode && $hasElement) {
      croak("Mixed content not allowed in data mode: characters");
    } else {
      _croakUnlessDefinedCharacters($_[0]);
      &{$characters};
    }
  };

  my $raw = sub {
    $output->print($_[0]);
    # Don't set $hasData or any other information: we know nothing
    # about what was just written.
    #
  };

  my $SAFE_raw = sub {
    croak('raw() is only available when UNSAFE is set');
  };

  my $cdata = sub {
      my $data = $_[0];
      $data    =~ s/\]\]>/\]\]\]\]><!\[CDATA\[>/g;
      $output->print("<![CDATA[$data]]>");
      $hasData = 1;
  };

  my $SAFE_cdata = sub {
    if ($elementLevel < 1) {
      croak("Attempt to insert characters outside of document element");
    } elsif ($dataMode && $hasElement) {
      croak("Mixed content not allowed in data mode: characters");
    } else {
      _croakUnlessDefinedCharacters($_[0]);
      &{$checkUnencodedRepertoire}($_[0]);
      &{$cdata};
    }
  };

                                # Assign the correct closures based on
                                # the UNSAFE parameter
  if ($unsafe) {
    $self = {'END' => $end,
             'XMLDECL' => $xmlDecl,
             'PI' => $pi,
             'COMMENT' => $comment,
             'DOCTYPE' => $doctype,
             'STARTTAG' => $startTag,
             'EMPTYTAG' => $emptyTag,
             'ENDTAG' => $endTag,
             'CHARACTERS' => $characters,
             'RAW' => $raw,
             'CDATA' => $cdata
            };
  } else {
    $self = {'END' => $SAFE_end,
             'XMLDECL' => $SAFE_xmlDecl,
             'PI' => $SAFE_pi,
             'COMMENT' => $SAFE_comment,
             'DOCTYPE' => $SAFE_doctype,
             'STARTTAG' => $SAFE_startTag,
             'EMPTYTAG' => $SAFE_emptyTag,
             'ENDTAG' => $SAFE_endTag,
             'CHARACTERS' => $SAFE_characters,
             'RAW' => $SAFE_raw,               # This will intentionally fail
             'CDATA' => $SAFE_cdata
            };
  }

                                # Query methods
  $self->{'IN_ELEMENT'} = sub {
    my ($ancestor) = (@_);
    return $elementStack[$#elementStack] eq $ancestor;
  };

  $self->{'WITHIN_ELEMENT'} = sub {
    my ($ancestor) = (@_);
    my $el;
    foreach $el (@elementStack) {
      return 1 if $el eq $ancestor;
    }
    return 0;
  };

  $self->{'CURRENT_ELEMENT'} = sub {
    return $elementStack[$#elementStack];
  };

  $self->{'ANCESTOR'} = sub {
    my ($n) = (@_);
    if ($n < scalar(@elementStack)) {
      return $elementStack[$#elementStack-$n];
    } else {
      return undef;
    }
  };

                                # Set and get the output destination.
  $self->{'GETOUTPUT'} = sub {
    if (ref($output) ne 'XML::Writer::_PrintChecker') {
      return $output;
    } else {
      return $output->{HANDLE};
    }
  };

  $self->{'SETOUTPUT'} = sub {
    my $newOutput = $_[0];

    if (defined($newOutput) && !ref($newOutput)) {
      if ('self' eq $newOutput ) {
        $newOutput = \$selfcontained_output;
        $use_selfcontained_output = 1;
      } else {
        die "Output must be a handle, a reference or 'self'";
      }
    }

    if (ref($newOutput) eq 'SCALAR') {
      $output = XML::Writer::_String->new($newOutput);
    } else {
                                # If there is no OUTPUT parameter,
                                # use standard output
      $output = $newOutput || \*STDOUT;
      if ($outputEncoding && (ref($output) eq 'GLOB' || $output->isa('IO::Handle'))) {
        if (lc($outputEncoding) eq 'utf-8') {

Writer.pm  view on Meta::CPAN

# Write a processing instruction.
#
sub pi {
  my $self = shift;
  &{$self->{PI}};
}

#
# Write a comment.
#
sub comment {
  my $self = shift;
  &{$self->{COMMENT}};
}

#
# Write a DOCTYPE declaration.
#
sub doctype {
  my $self = shift;
  &{$self->{DOCTYPE}};
}

#
# Write a start tag.
#
sub startTag {
  my $self = shift;
  &{$self->{STARTTAG}};
}

#
# Write an empty tag.
#
sub emptyTag {
  my $self = shift;
  &{$self->{EMPTYTAG}};
}

#
# Write an end tag.
#
sub endTag {
  my $self = shift;
  &{$self->{ENDTAG}};
}

#
# Write a simple data element.
#
sub dataElement {
  my ($self, $name, $data, @atts) = (@_);
  $self->startTag($name, @atts);
  $self->characters($data);
  $self->endTag($name);
}

#
# Write a simple CDATA element.
#
sub cdataElement {
    my ($self, $name, $data, %atts) = (@_);
    $self->startTag($name, %atts);
    $self->cdata($data);
    $self->endTag($name);
}

#
# Write character data.
#
sub characters {
  my $self = shift;
  &{$self->{CHARACTERS}};
}

#
# Write raw, unquoted, completely unchecked character data.
#
sub raw {
  my $self = shift;
  &{$self->{RAW}};
}

#
# Write CDATA.
#
sub cdata {
    my $self = shift;
    &{$self->{CDATA}};
}

#
# Query the current element.
#
sub in_element {
  my $self = shift;
  return &{$self->{IN_ELEMENT}};
}

#
# Query the ancestors.
#
sub within_element {
  my $self = shift;
  return &{$self->{WITHIN_ELEMENT}};
}

#
# Get the name of the current element.
#
sub current_element {
  my $self = shift;
  return &{$self->{CURRENT_ELEMENT}};
}

#
# Get the name of the numbered ancestor (zero-based).
#
sub ancestor {
  my $self = shift;
  return &{$self->{ANCESTOR}};
}

#
# Get the current output destination.
#
sub getOutput {
  my $self = shift;
  return &{$self->{GETOUTPUT}};
}


#
# Set the current output destination.
#
sub setOutput {
  my $self = shift;
  return &{$self->{SETOUTPUT}};
}

#
# Set the current data mode (true or false).
#
sub setDataMode {
  my $self = shift;
  return &{$self->{SETDATAMODE}};
}

Writer.pm  view on Meta::CPAN

All start tags must eventually have matching end tags.

=item emptyTag($name [, $aname1 => $value1, ...])

Add an empty tag to an XML document.  Any arguments after the element
name are assumed to be name/value pairs for attributes (see startTag()
for details):

  $writer->emptyTag('img', 'src' => 'portrait.jpg',
                           'alt' => 'Portrait of Emma.');

=item endTag([$name])

Add an end tag to an XML document.  The end tag must match the closest
open start tag, and there must be a matching and properly-nested end
tag for every start tag:

  $writer->endTag('doc');

If the $name argument is omitted, then the module will automatically
supply the name of the currently open element:

  $writer->startTag('p');
  $writer->endTag();

=item dataElement($name, $data [, $aname1 => $value1, ...])

Print an entire element containing only character data.  This is
equivalent to

  $writer->startTag($name [, $aname1 => $value1, ...]);
  $writer->characters($data);
  $writer->endTag($name);

=item characters($data)

Add character data to an XML document.  All '<', '>', and '&'
characters in the $data argument will automatically be escaped using
the predefined XML entities:

  $writer->characters("Here is the formula: ");
  $writer->characters("a < 100 && a > 5");

You may invoke this method only within the document element
(i.e. after the first start tag and before the last end tag).

In data mode, you must not use this method to add whitespace between
elements.

=item raw($data)

Print data completely unquoted and unchecked to the XML document.  For
example C<raw('<')> will print a literal < character.  This
necessarily bypasses all well-formedness checking, and is therefore
only available in unsafe mode.

This can sometimes be useful for printing entities which are defined
for your XML format but the module doesn't know about, for example
&nbsp; for XHTML.

=item cdata($data)

As C<characters()> but writes the data quoted in a CDATA section, that
is, between <![CDATA[ and ]]>.  If the data to be written itself
contains ]]>, it will be written as several consecutive CDATA
sections.

=item cdataElement($name, $data [, $aname1 => $value1, ...])

As C<dataElement()> but the element content is written as one or more
CDATA sections (see C<cdata()>).

=item setOutput($output)

Set the current output destination, as in the OUTPUT parameter for the
constructor.

=item getOutput()

Return the current output destination, as in the OUTPUT parameter for
the constructor.

=item setDataMode($mode)

Enable or disable data mode, as in the DATA_MODE parameter for the
constructor.

=item getDataMode()

Return the current data mode, as in the DATA_MODE parameter for the
constructor.

=item setDataIndent($step)

Set the indent step for data mode, as in the DATA_INDENT parameter for
the constructor.

=item getDataIndent()

Return the indent step for data mode, as in the DATA_INDENT parameter
for the constructor.


=back

=head2 Querying XML

=over 4

=item in_element($name)

Return a true value if the most recent open element matches $name:

  if ($writer->in_element('dl')) {
    $writer->startTag('dt');
  } else {
    $writer->startTag('li');
  }

=item within_element($name)

Return a true value if any open element matches $name:

  if ($writer->within_element('body')) {
    $writer->startTag('h1');
  } else {
    $writer->startTag('title');
  }

=item current_element()