Sofu
view release on metacpan or search on metacpan
lib/Data/Sofu.pm view on Meta::CPAN
foreach my $key (keys %$comment) {
my $wkey=$key;
$wkey=~s/^->//;
$wkey="" if $key eq "=";
$tree->storeComment($wkey,$comment->{$key});
}
return $tree;
}
sub from { #deprecated but still in use requires to runs through the tree :(((
require Data::Sofu::Object;
my $self=shift;
my $file=shift;
if (ref $file and ref $file ne "GLOB") {
carp("Can't call \"from\" on an Object, it is used to create an object tree: my \$tree=Data::Sofu::from(\$file)!");
}
Data::Sofu::Object->clear();
#$self->object(1); #Use the object parser;
my $tree=$self->read($file);
$tree=Data::Sofu::Object->new($tree);
my $c=$self->comment;
foreach my $key (keys %$c) {
#print "Key = $key Comment = @{$c->{$key}}\n";
my $wkey=$key;
$wkey=~s/^->//;
$wkey="" if $key eq "=";
$tree->storeComment($wkey,$c->{$key});
}
return $tree;
}
sub wasbinary {
my $self=shift;
if (@_) {
$self->{BINARY}=shift;
}
return $self->{BINARY};
}
sub load {
my $self=shift;
#TODO pure Object Based Parser!! NOT really possible to hack in with Ref-Detection and stuff (Complete rewrite needed, lex based like Sofud)
#return $self->from(@_);
require Data::Sofu::Object;
#my $self=shift;
local $_;
my $file=shift;
my $fh;
$$self{TREE}="";
$self->{OBJECT}=1;
$$self{CURRENT}=0;
$$self{References}=[];
$self->{Commentary}={};
%{$$self{Ref}}=();
my $guess=0;
unless (ref $file) {
$$self{CurFile}=$file;
open $fh,"<:raw",$$self{CurFile} or die "Sofu error open: $$self{CurFile} file: $!";
$guess=1;
binmode $fh;
#eval {require File::BOM;my ($e,$sp)=File::BOM::defuse($fh);$$self{Ret}.=$sp;$e=$e;};undef $@;
}
elsif (ref $file eq "SCALAR") {
$$self{CurFile}="Scalarref";
open $fh,"<:utf8",$file or die "Can't open perlIO: $!" if utf8::is_utf8($$file);
open $fh,"<",$file or die "Can't open perlIO: $!" if !utf8::is_utf8($$file);;
}
elsif (ref $file eq "GLOB") {
$$self{CurFile}="FileHandle";
$fh=$file;
}
else {
$self->warn("The argument to load or loadfile has to be a filename, reference to a scalar or filehandle");
return;
}
my $text=do {local $/,<$fh>};
{
my $b = substr($text,0,2);
my $c= substr($text,2,1);
if ($b eq "So") {
$b=substr($text,0,4);
if ($b eq "Sofu") {
$b=substr($text,4,2);
$c=substr($text,6,1);
}
}
if (($b eq "\x{00}\x{00}" or $b eq "\x{01}\x{00}" or $b eq "\x{00}\x{01}") and $c ne "\x{FE}") { #Assume Binary
require Data::Sofu::Binary;
$bdriver = Data::Sofu::Binary->new() unless $bdriver;
my $tree = $bdriver->load(\$text);
$self->wasbinary(1);
if (wantarray) {
return %{$tree};
}
return $tree;
}
}
if ($guess) {
my $enc=guess_encoding($text);
$text=$enc->decode($text) if ref $enc;
$text=Encode::decode("UTF-8",$text) unless ref $enc;
}
substr($text,0,1,"") if substr($text,0,1) eq chr(65279); # UTF-8 BOM (Why ain't it removed ?)
close $fh if ref $file;
$$self{CurFile}="";
my $u=$self->unpack($text);
$self->{OBJECT}=0;
return $u;
}
sub noComments {
my $self=shift;
$$self{PreserveCommentary}=0;
}
sub object {
my $self=shift;
$$self{OBJECT}=shift;
}
sub comment {
my $self=shift;
my $data=undef;
if ($_[0]) {
if (ref $_[0] eq "HASH") {
$data=shift;
}
else {
$data={@_};
}
}
$$self{Commentary}=$data if $data;;
return $self->{Commentary};
}
sub comments {
my $self=shift;
my $data=undef;
if ($_[0]) {
if (ref $_[0] eq "HASH") {
$data=shift;
}
else {
$data={@_};
}
}
$$self{Commentary}=$data if $data;;
return $self->{Commentary};
}
sub setIndent {
my $self=shift;
local $_;
$$self{SetIndent}=shift;
}
sub setWarnings {
my $self=shift;
local $_;
$$self{WARN}=shift;
}
sub allWarn {
my $self=shift;
local $_;
$$self{WARN}=1;
}
sub noWarn {
my $self=shift;
lib/Data/Sofu.pm view on Meta::CPAN
$$self{CurFile}="Scalarref";
utf8::upgrade($$file);
open $fh,">:utf8",$file or die "Can't open perlIO: $!";
}
elsif (ref $file eq "GLOB") {
$$self{CurFile}="FileHandle";
$fh=$file;
}
else {
$self->warn("The argument to read or write has to be a filename, reference to a scalar or filehandle");
return;
}
my $ref=shift;
#use Data::Dumper;
#print Data::Dumper->Dump([$ref]);
$self->{Commentary}={};
$self->comment(@_);
$$self{Indent}="\t" unless $$self{SetIndent};
$$self{Libsofucompat}=1;
%{$$self{Ref}}=();
#$self->{Ref}->{$ref}="->";
print $fh $self->commentary,"\n";
unless (ref $ref) {
print $fh "Value=".$self->escape($ref);
}
elsif (ref $ref eq "HASH") {
print $fh $self->writeMap(0,$ref);
}
elsif (ref $ref eq "ARRAY") {
print $fh "Value=".$self->writeList(0,$ref);
}
else {
$self->warn("non Sofu reference");
return "";
}
$$self{Libsofucompat}=0;
$$self{Indent}="";
#close $fh if ref $file;
$$self{CurFile}="";
return 1;
}
sub read {
my $self=shift;
local $_;
my $file=shift;
my $fh;
$$self{TREE}="";
$$self{OBJECT}=0;
$$self{CURRENT}=0;
$$self{References}=[];
$self->{Commentary}={};
%{$$self{Ref}}=();
my $guess=0;
unless (ref $file) {
$$self{CurFile}=$file;
open $fh,$$self{CurFile} or die "Sofu error open: $$self{CurFile} file: $!";
$guess=1;
binmode $fh;
#eval {require File::BOM;my ($e,$sp)=File::BOM::defuse($fh);$$self{Ret}.=$sp;$e=$e;};undef $@;
}
elsif (ref $file eq "SCALAR") {
$$self{CurFile}="Scalarref";
open $fh,"<:utf8",$file or die "Can't open perlIO: $!" if utf8::is_utf8($$file);
open $fh,"<",$file or die "Can't open perlIO: $!" if !utf8::is_utf8($$file);
}
elsif (ref $file eq "GLOB") {
$$self{CurFile}="FileHandle";
$fh=$file;
}
else {
$self->warn("The argument to read or write has to be a filename, reference to a scalar or filehandle");
return;
}
my $text=do {local $/,<$fh>};
{
my $b = substr($text,0,2);
my $u = substr($text,2,1);
if ($b eq "So") {
$b=substr($text,0,4);
if ($b eq "Sofu") {
$b=substr($text,4,2);
$u=substr($text,6,1);
}
}
if (($b eq "\x{00}\x{00}" or $b eq "\x{01}\x{00}" or $b eq "\x{00}\x{01}") and $u ne "\x{fe}") { #Assume Binary
require Data::Sofu::Binary;
$bdriver = Data::Sofu::Binary->new() unless $bdriver;
my ($tree,$c) = $bdriver->read(\$text);
$self->comment($c);
$self->wasbinary(1);
if (wantarray) {
return %{$tree};
}
return $tree;
}
}
if ($guess) {
my $enc=guess_encoding($text);
$text=$enc->decode($text) if ref $enc;
$text=Encode::decode("UTF-8",$text) unless ref $enc;
}
close $fh if ref $file;
$$self{CurFile}="";
substr($text,0,1,"") if substr($text,0,1) eq chr(65279); # UTF-8 BOM (Why ain't it removed ?)
my $u=$self->unpack($text);
#print Data::Dumper->Dump([$u]);
if (wantarray) {
return () unless $u;
return %{$u} if ref $u eq "HASH";
return (Value=>$u);
}
return unless $u;
return $u if ref $u eq "HASH";
return {Value=>$u};
# $self->warn("Unpack error: $u") unless ref $u;
# return %{$u};
}
sub pack {
my $self=shift;
my $ref=shift;
local $_;
$self->{Commentary}={};
$self->comment(@_);
$$self{TREE}="";
%{$$self{Ref}}=();
#$self->{Ref}->{$ref}="->";
$$self{Indent}=$$self{SetIndent} if $$self{SetIndent};
$$self{Counter}=0;
unless (ref $ref) {
return $self->commentary.$self->escape($ref);
}
elsif (ref $ref eq "HASH") {
return $self->commentary.$self->writeMap(0,$ref);
}
elsif (ref $ref eq "ARRAY") {
return $self->commentary.$self->writeList(0,$ref);
}
else {
$self->warn("non Sofu reference");
return "";
}
}
sub unpack($) {
my $self=shift;
local $_;
$$self{TREE}="";
$$self{Counter}=0;
($self->{Escape},$self->{String},$self->{COUNT})=(0,0,0);
$$self{Line}=1;
$$self{READLINE}=shift()."\n";
$$self{LENGTH}=length $$self{READLINE};
%{$$self{Ref}}=();
$$self{CURRENT}=0;
$$self{References}=[];
$self->{Commentary}={};
my $c;
my $bom=chr(65279);
1 while ($c=$self->get() and ($c =~ m/\s/ or $c eq $bom));
return unless defined $c;
if ($c eq "{") {
my $result;
$result=$self->parsMap;
$$self{Ref}->{""}=$result;
lib/Data/Sofu.pm view on Meta::CPAN
=head2 postprocess()
Corrects references and puts comments into the objects (if load/loadSofu is used)
=head2 refe()
Tests if the input is a reference.
=head2 storeComment()
Stores a comment into the database while reading a sofu file.
=head2 wasbinary()
True when the read file was binary.
=head2 writeList()
Used to pack/write a sofu list.
=head2 writeMap()
Used to pack/write a sofu map.
=head1 CHANGES
Keys are now automatically escaped according to the new sofu specification.
Double used references will now be converted to Sofu-References.
read, load, readSofu, loadSofu and Data::Sofu::loaFile now detect binary sofu (and load Data::Sofu::Binary)
read, load, readSofu, loadSofu, Data::Sofu::loaFile, unpackSofu and unpack detect SofuML (and load Data::Sofu::SofuML)
=head1 BUGS
Comments written after an object will be rewritten at the top of an object:
foo = { # Comment1
Bar = "Baz"
} # Comment2
will get to:
foo = { # Comment1
# Comment 2
Bar = "Baz"
}
=head1 NOTE on Unicode
Sofu File are normally written in a Unicode format. C<Data::Sofu> is trying to guess which format to read (usually works, thanks to Encode::Guess).
On the other hand the output defaults to UTF-16 (UNIX) (like SofuD). If you need other encoding you will have to prepare the filehandle yourself and give it to the write() funktions...
open my $fh,">:encoding(latin1)","out.sofu";
writeSofu($fh,$data);
Warning: UTF32 BE is not supported without BOM (looks too much like Binary);
Notes:
As for Encodings under Windows you should always have a :raw a first layer, but to make them compatible with Windows programs you will have to access special tricks:
open my $fh,">:raw:encoding(UTF-16):crlf:utf8","out.sofu" #Write Windows UTF-16 Files
open my $fh,">:raw:encoding(UTF-16)","out.sofu" #Write Unix UTF-16 Files
#Same goes for UTF32
#UTF-8: Don't use :utf8 or :raw:utf8 alone here,
#Perl has a different understanding of utf8 and UTF-8 (utf8 allows some errors).
open my $fh,">:raw:encoding(UTF-8)","out.sofu" #Unix style UTF-8
open my $fh,">:raw:encoding(UTF-8):crlf:utf8","out.sofu" #Windows style UTF-8
#And right after open():
print $fh chr(65279); #Print UTF-8 Byte Order Mark (Some programs want it, some programs die on it...)
One last thing:
open my $out,">:raw:encoding(UTF-16BE):crlf:utf8","out.sofu";
print $out chr(65279); #Byte Order Mark
#Now you can write out UTF16 with BOM in BigEndian (even if you machine in Little Endian)
=head1 SEE ALSO
perl(1),L<http://sofu.sf.net>
For Sofud compatible Object Notation: L<Data::Sofu::Object>
For Sofu Binary: L<Data::Sofu::Binary>
For SofuML L<Data::Sofu::SofuML>
=cut
1;
( run in 0.710 second using v1.01-cache-2.11-cpan-995e09ba956 )