view release on metacpan or  search on metacpan

lib/XML/Simple.pm  view on Meta::CPAN

=head1 SYNOPSIS

PLEASE DO NOT USE THIS MODULE IN NEW CODE.  If you ignore this
warning and use it anyway, the C<qw(:strict)> mode will save you a little pain.

    use XML::Simple qw(:strict);

    my $ref = XMLin([<xml file or string>] [, <options>]);

    my $xml = XMLout($hashref [, <options>]);

Or the object oriented way:

    require XML::Simple qw(:strict);

    my $xs = XML::Simple->new([<options>]);

    my $ref = $xs->XMLin([<xml file or string>] [, <options>]);

    my $xml = $xs->XMLout($hashref [, <options>]);

(or see L<"SAX SUPPORT"> for 'the SAX way').

Note, in these examples, the square brackets are used to denote optional items
not to imply items should be supplied in arrayrefs.

=cut

# See after __END__ for more POD documentation


# Load essentials here, other modules loaded on demand later

use strict;
use warnings;
use warnings::register;
use Carp;
use Scalar::Util qw();
require Exporter;


##############################################################################
# Define some constants
#

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $PREFERRED_PARSER);

@ISA               = qw(Exporter);
@EXPORT            = qw(XMLin XMLout);
@EXPORT_OK         = qw(xml_in xml_out);

my %StrictMode     = ();

my @KnownOptIn     = qw(keyattr keeproot forcecontent contentkey noattr
                        searchpath forcearray cache suppressempty parseropts
                        grouptags nsexpand datahandler varattr variables
                        normalisespace normalizespace valueattr strictmode);

my @KnownOptOut    = qw(keyattr keeproot contentkey noattr
                        rootname xmldecl outputfile noescape suppressempty
                        grouptags nsexpand handler noindent attrindent nosort
                        valueattr numericescape strictmode);

my @DefKeyAttr     = qw(name key id);
my $DefRootName    = qq(opt);
my $DefContentKey  = qq(content);
my $DefXmlDecl     = qq(<?xml version='1.0' standalone='yes'?>);

my $xmlns_ns       = 'http://www.w3.org/2000/xmlns/';
my $bad_def_ns_jcn = '{' . $xmlns_ns . '}';     # LibXML::SAX workaround


##############################################################################
# Globals for use by caching routines
#

my %MemShareCache  = ();
my %MemCopyCache   = ();


##############################################################################
# Wrapper for Exporter - handles ':strict'
#

sub import {
  # Handle the :strict tag

  my($calling_package) = caller();
  _strict_mode_for_caller(1) if grep(/^:strict$/, @_);

  # Pass everything else to Exporter.pm

  @_ = grep(!/^:strict$/, @_);
  goto &Exporter::import;
}


##############################################################################
# Constructor for optional object interface.
#

sub new {
  my $class = shift;

  if(@_ % 2) {
    croak "Default options must be name=>value pairs (odd number supplied)";
  }

  my %known_opt;
  @known_opt{@KnownOptIn, @KnownOptOut} = ();

  my %raw_opt = @_;
  $raw_opt{strictmode} = _strict_mode_for_caller()
    unless exists $raw_opt{strictmode};
  my %def_opt;
  while(my($key, $val) = each %raw_opt) {
    my $lkey = lc($key);
    $lkey =~ s/_//g;
    croak "Unrecognised option: $key" unless(exists($known_opt{$lkey}));
    $def_opt{$lkey} = $val;
  }