view release on metacpan or  search on metacpan

lib/Data/Sofu/SofuML.pm  view on Meta::CPAN

use strict;
use warnings;

our $VERSION="0.3";
#We are really going to need these modules:
use Encode;
use Carp qw/confess cluck/;
require Data::Sofu;

=head1 METHODS

Most of these Methods (except pack()) are ony for internal use.

=head2 new()

Creates a new C<Data::Sofu::SofuML> and returns it.

=cut 

sub new {
	my $self={};
	bless $self,shift;
	$self->{IDS} = {};
	$self->{ID} = 0;
	$self->{INDENT} = "\t";
	return $self;
}

=head2 whiteescape (STRING)

Escapes whitespace for use in XML

=cut

sub whiteescape {
	my $self=shift;
	my $data = shift;
	return $data if ($data eq " ");
	my $f = "";
	$data=~s/(.)/sprintf("&#x%X;",ord($1))/esg;
	
	return $f.$data;
}

=head2 XMLescapeOld(STRING,LEVEL)

Older version of XMLescape, still need by some.

=cut

sub XMLescapeOld {
	my $self=shift;
	my $string=shift;
	my $level=shift;
	$string =~ s/\&/&amp;/g;
	$string =~ s/\</&lt;/g;
	$string =~ s/\>/&gt;/g;
	$string =~ s/\"/&quot;/g;
	$string =~ s/\'/&apos;/g;
	$string=~s"^([\s\n\x0A]+)"join '',map {sprintf('&#x%X;' ,ord($_))} split //,$1"emg;
	$string=~s/([\s\n\x0A]+)$/join '',map {sprintf('&#x%X;' ,ord($_))} split m##,$1/emg;
	$string =~ s/([\s]+)/$self->whiteescape($1)/eg;
	$string=~s/([\ ]{2,})/join '',map {sprintf('&#x%X;' ,ord($_))} split m##,$1/eg;
	$string=~s/\n/"\n".$self->indent($level)/eg;
	#$string=~s/\n/$self->indent($level)."\n"/eg;
	return $string;
	#return $self->indent($level).$string; #makes bad Juju with XSLT
}

=head2 XMLescape(STRING,LEVEL)

Returns the (quite badly) escaped form of STRING

=cut

sub XMLescape {
	my $self=shift;
	my $string=shift;
	my $level=shift;
	$string =~ s/\&/&amp;/g;
	$string =~ s/\</&lt;/g;
	$string =~ s/\>/&gt;/g;
	$string =~ s/\"/&quot;/g;
	$string =~ s/\'/&apos;/g;
	$string=~s"^([\s\n\x0A]+)"join '',map {sprintf('&#x%X;' ,ord($_))} split //,$1"emg;
	$string=~s/([\s\n\x0A]+)$/join '',map {sprintf('&#x%X;' ,ord($_))} split m##,$1/emg;
	$string =~ s/([\s\n\x0A]+)/$self->whiteescape($1)/eg;
	#$string=~s/\n/$self->indent($level)."\n"/eg;
	return $string;
	#return $self->indent($level).$string; #makes bad Juju with XSLT
}

=head2 XMLunescape(STRING)

Inversion of XMLescape

=cut

sub XMLunescape {
	my $string=shift;
	$string =~ s/^\s+//g;
	$string =~ s/\s+$//g;
	$string =~ s/\s*\n\s*/\n/g;
	$string =~ s/[\s[^\n]]+/ /g;
	$string =~ s/&#x([\dabcdefABCDEF]+);/chr(hex($1))/eg;
	$string =~ s/&#([\dabcdefABCDEF]+);/chr($1)/eg;
	$string =~ s/&lt;/</g;
	$string =~ s/&gt;/>/g;
	$string =~ s/&quot;/"/g;
	$string =~ s/&apos;/'/g;
	$string =~ s/&amp;/&/g;
	return $string;
}

=head2 XMLunescapeRestrictive(STRING)

Like XMLunescape, but more restrictive (currently not used)

=cut

sub XMLunescapeRestrictive {
	my $string=shift;
	$string =~ s/^\s+//g;
	$string =~ s/\s+$//g;
	$string =~ s/\s*\n\s*/ /g;
	$string =~ s/[\s[^\n]]+/ /g;
	$string =~ s/&#x([\dabcdefABCDEF]+);/chr(hex($1))/eg;
	$string =~ s/&#([\dabcdefABCDEF]+);/chr($1)/eg;
	$string =~ s/&lt;/</g;
	$string =~ s/&gt;/>/g;
	$string =~ s/&quot;/"/g;
	$string =~ s/&apos;/'/g;
	$string =~ s/&amp;/&/g;
	return $string;
}

=head2 XMLKeyescape(KEY)

Returns the (quite badly) escaped form of KEY

=cut


sub XMLKeyescape {
	my $self=shift;
	my $string=shift;