view release on metacpan or  search on metacpan

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

This Module is pure OO, exports nothing

=cut

package Data::Sofu::SofuML;
use strict;
use warnings;

our $VERSION="0.29";
#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 C<XMLescape(STRING,LEVEL)>

Returns the (quite badly) escaped form of STRING

=cut

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

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]+)/$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
}

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/&lt;/</g;
	$string =~ s/&gt;/>/g;
	$string =~ s/&quot;/"/g;
	$string =~ s/&apos;/'/g;
	$string =~ s/&amp;/&/g;
	return $string;
}

=head2 C<XMLKeyescape(KEY)>

Returns the (quite badly) escaped form of KEY

=cut


sub XMLKeyescape {
	my $self=shift;
	my $string=shift;
	$string =~ s/\&/&amp;/g;
	$string =~ s/\</&lt;/g;
	$string =~ s/\>/&gt;/g;
	$string =~ s/\"/&quot;/g;
	$string =~ s/\'/&apos;/g;
	$string =~ s/([^[:print:]])/sprintf("&#x%X;",ord($1))/eg;
	return $string;
}

=head2 genID() 

Returns a new unqiue ID

=cut

sub genID {
	my $self=shift;
	return $self->{ID}++;
}

=head2 indent(LEVEL)

Returns the indentation for LEVEL

=cut

sub indent {
	my $self=shift;
	my $level = shift;