File Coverage

blib/lib/Data/Sofu.pm
Criterion Covered Total %
statement 659 884 74.5
branch 285 482 59.1
condition 51 101 50.5
subroutine 53 68 77.9
pod 23 58 39.6
total 1071 1593 67.2


line stmt bran cond sub pod time code
1             ###############################################################################
2             #Sofu.pm
3             #Last Change: 2008-02-18
4             #Copyright (c) 2006 Marc-Seabstian "Maluku" Lucksch
5             #Version 0.29
6             ####################
7             #This file is part of the sofu.pm project, a parser library for an all-purpose
8             #ASCII file format. More information can be found on the project web site
9             #at http://sofu.sourceforge.net/ .
10             #
11             #sofu.pm is published under the terms of the MIT license, which basically means
12             #"Do with it whatever you want". For more information, see the license.txt
13             #file that should be enclosed with libsofu distributions. A copy of the license
14             #is (at the time of this writing) also available at
15             #http://www.opensource.org/licenses/mit-license.php .
16             ###############################################################################
17              
18             package Data::Sofu;
19 5     5   188835 use strict;
  5         13  
  5         195  
20 5     5   28 use warnings;
  5         7  
  5         138  
21 5     5   942 use utf8;
  5         21  
  5         34  
22             require Exporter;
23 5     5   220 use Carp qw/croak confess/;
  5         9  
  5         491  
24             $Carp::Verbose=1;
25 5     5   29 use vars qw($VERSION @EXPORT @ISA @EXPORT_OK %EXPORT_TAGS);
  5         8  
  5         562  
26             @ISA = qw/Exporter/;
27 5     5   3786 use Encode;
  5         29574  
  5         675  
28 5     5   6346 use Encode::Guess qw/UTF-16BE UTF-16LE UTF-32LE UTF-32BE latin1/;
  5         39938  
  5         36  
29              
30             @EXPORT= qw/readSofu writeSofu getSofucomments writeSofuBinary writeBinarySofu writeSofuML loadSofu/;
31             @EXPORT_OK= qw/readSofu writeSofu getSofucomments writeSofuBinary writeBinarySofu packBinarySofu packSofu unpackSofu getSofu packSofuBinary SofuloadFile getSofuComments writeSofuML packSofuML loadSofu/;
32             %EXPORT_TAGS=("all"=>[@EXPORT_OK]);
33              
34             $VERSION="0.29";
35             my $sofu;
36             my $bdriver; #Binary Interface (new File)
37             my $mldriver; #SofuML Interface
38              
39             sub refe {
40 960     960 0 1441 my $ref=shift;
41 960 100       3058 return 0 unless ref $ref;
42 173 100       583 return 1 if ref $ref eq "SCALAR";
43 72 100       175 return 1 if ref $ref eq "Data::Sofu::Reference";
44 57         173 return 0;
45             }
46              
47             sub readSofu {
48 58 100   58 1 25760 $sofu=Data::Sofu->new() unless $sofu;
49 58 50       166 if (wantarray) {
50 0         0 return $sofu->read(@_);
51             }
52             else {
53 58         276 return scalar $sofu->read(@_);
54             }
55             }
56             sub getSofu {
57 2 50   2 0 17 $sofu=Data::Sofu->new() unless $sofu;
58 2         18 return $sofu->from(@_);
59             }
60             sub loadSofu {
61 35 100   35 1 63673 $sofu=Data::Sofu->new() unless $sofu;
62 35         189 return $sofu->load(@_);
63             }
64             sub SofuloadFile {
65 0 0   0 0 0 $sofu=Data::Sofu->new() unless $sofu;
66 0         0 return $sofu->load(@_);
67             }
68              
69             sub writeSofu {
70 24 100   24 1 4358 $sofu=Data::Sofu->new() unless $sofu;
71 24         171 return $sofu->write(@_);
72             }
73              
74             sub writeSofuML {
75 2 50   2 1 3611 $sofu=Data::Sofu->new() unless $sofu;
76 2         10 return $sofu->writeML(@_);
77             }
78              
79             sub loadFile {
80 0 0   0 1 0 $sofu=Data::Sofu->new() unless $sofu;
81 0         0 my $class=shift;
82 0 0       0 if ($class eq "Data::Sofu") {
83 0         0 return $sofu->load(@_);
84             }
85             #croak ("Usage: Data::Sofu->loadFile(\$file)\nFile can be: Filehandle, Filename or reference to a scalar") if (ref $class or $class ne "Data::Sofu");
86 0         0 return $sofu->load($class,@_);
87              
88             }
89             sub getSofucomments {
90 0 0   0 1 0 $sofu->warn("Can't get comments: No File read") unless $sofu;
91 0         0 return $sofu->comments;
92             }
93              
94             sub getSofuComments {
95 24 50   24 0 125 $sofu->warn("Can't get comments: No File read") unless $sofu;
96 24         95 return $sofu->comments;
97             }
98              
99             sub packSofu {
100 1 50   1 1 4 $sofu=Data::Sofu->new() unless $sofu;
101 1         5 return $sofu->pack(@_);
102             }
103              
104             sub packSofuML {
105 2 50   2 0 1906 $sofu=Data::Sofu->new() unless $sofu;
106 2         11 return $sofu->packML(@_);
107             }
108              
109             sub writeBinarySofu {
110 44 50   44 0 4022 $sofu=Data::Sofu->new() unless $sofu;
111 44         453 return $sofu->writeBinary(@_);
112             }
113              
114             sub writeSofuBinary {
115 0 0   0 1 0 $sofu=Data::Sofu->new() unless $sofu;
116 0         0 return $sofu->writeBinary(@_);
117             }
118              
119             sub packSofuBinary {
120 0 0   0 0 0 $sofu=Data::Sofu->new() unless $sofu;
121 0         0 return $sofu->packBinary(@_);
122             }
123              
124             sub packBinarySofu {
125 8 50   8 0 37 $sofu=Data::Sofu->new() unless $sofu;
126 8         44 return $sofu->packBinary(@_);
127             }
128              
129             sub unpackSofu {
130 2 50   2 1 779 $sofu=Data::Sofu->new() unless $sofu;
131 2         10 return $sofu->unpack(@_);
132             }
133              
134             sub new {
135 5     5 1 17 my $self={};
136 5         13 shift;
137 5         20 $$self{CurFile}="";
138 5         14 $$self{Counter}=0;
139 5         14 $$self{WARN}=1;
140 5         14 $$self{Debug}=0;
141 5         15 $$self{Ref}={};
142 5         16 $$self{Indent}="";
143 5         13 $self->{String}=0;
144 5         18 $self->{Escape}=0;
145 5         16 $$self{SetIndent}="";
146 5         13 $$self{READLINE}="";
147 5         11 $self->{COUNT}=0;
148 5         10 $$self{Libsofucompat}=0;
149 5         14 $$self{Commentary}={};
150 5         14 $$self{PreserveCommentary}=1;
151 5         10 $$self{TREE}="";
152 5         25 $$self{OBJECT}="";
153 5         14 $self->{COMMENT}=[];
154 5         10 bless $self;
155 5         12 return $self;
156             }
157              
158             sub toObjects {
159 0     0 1 0 my $self=shift;
160 0         0 my $data=shift;
161 0         0 my $comment=shift;
162 0         0 Data::Sofu::Object->clear();
163 0         0 my $tree=Data::Sofu::Object->new($data);
164 0         0 foreach my $key (keys %$comment) {
165 0         0 my $wkey=$key;
166 0         0 $wkey=~s/^->//;
167 0 0       0 $wkey="" if $key eq "=";
168 0         0 $tree->storeComment($wkey,$comment->{$key});
169             }
170 0         0 return $tree;
171             }
172              
173             sub from { #deprecated but still in use requires to runs through the tree :(((
174 2     2 1 1241 require Data::Sofu::Object;
175 2         6 my $self=shift;
176 2         5 my $file=shift;
177 2 50 33     11 if (ref $file and ref $file ne "GLOB") {
178 0         0 carp("Can't call \"from\" on an Object, it is used to create an object tree: my \$tree=Data::Sofu::from(\$file)!");
179             }
180 2         19 Data::Sofu::Object->clear();
181             #$self->object(1); #Use the object parser;
182 2         11 my $tree=$self->read($file);
183 2         33 $tree=Data::Sofu::Object->new($tree);
184 2         8 my $c=$self->comment;
185 2         12 foreach my $key (keys %$c) {
186             #print "Key = $key Comment = @{$c->{$key}}\n";
187 8         13 my $wkey=$key;
188 8         34 $wkey=~s/^->//;
189 8 100       22 $wkey="" if $key eq "=";
190 8         34 $tree->storeComment($wkey,$c->{$key});
191             }
192 2         15 return $tree;
193             }
194              
195             sub wasbinary {
196 58     58 0 156 my $self=shift;
197 58 50       913 if (@_) {
198 58         136 $self->{BINARY}=shift;
199             }
200 58         122 return $self->{BINARY};
201             }
202              
203             sub load {
204 35     35 1 68 my $self=shift;
205             #TODO pure Object Based Parser!! NOT really possible to hack in with Ref-Detection and stuff (Complete rewrite needed, lex based like Sofud)
206             #return $self->from(@_);
207 35         2244 require Data::Sofu::Object;
208             #my $self=shift;
209 35         82 local $_;
210 35         101 my $file=shift;
211 35         66 my $fh;
212 35         143 $$self{TREE}="";
213 35         86 $self->{OBJECT}=1;
214 35         5356 $$self{CURRENT}=0;
215 35         122 $$self{References}=[];
216 35         141 $self->{Commentary}={};
217 35         347 %{$$self{Ref}}=();
  35         142  
218 35         62 my $guess=0;
219 35 100       179 unless (ref $file) {
    50          
    0          
220 23         81 $$self{CurFile}=$file;
221 23 50       1944 open $fh,"<:raw",$$self{CurFile} or die "Sofu error open: $$self{CurFile} file: $!";
222 23         54 $guess=1;
223 23         87 binmode $fh;
224             #eval {require File::BOM;my ($e,$sp)=File::BOM::defuse($fh);$$self{Ret}.=$sp;$e=$e;};undef $@;
225             }
226             elsif (ref $file eq "SCALAR") {
227 12         47 $$self{CurFile}="Scalarref";
228 12 50 0     70 open $fh,"<:utf8",$file or die "Can't open perlIO: $!" if utf8::is_utf8($$file);
229 12 50 50     1211 open $fh,"<",$file or die "Can't open perlIO: $!" if !utf8::is_utf8($$file);;
230             }
231             elsif (ref $file eq "GLOB") {
232 0         0 $$self{CurFile}="FileHandle";
233 0         0 $fh=$file;
234             }
235             else {
236 0         0 $self->warn("The argument to load or loadfile has to be a filename, reference to a scalar or filehandle");
237 0         0 return;
238             }
239 35         72 my $text=do {local $/,<$fh>};
  35         999  
240             {
241 35         89 my $b = substr($text,0,2);
  35         108  
242 35         309 my $c= substr($text,2,1);
243 35 100       135 if ($b eq "So") {
244 28         69 $b=substr($text,0,4);
245 28 50       113 if ($b eq "Sofu") {
246 28         60 $b=substr($text,4,2);
247 28         61 $c=substr($text,6,1);
248             }
249             }
250 35 100 100     481 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
      66        
251 32         212 require Data::Sofu::Binary;
252 32 50       144 $bdriver = Data::Sofu::Binary->new() unless $bdriver;
253 32         1083 my $tree = $bdriver->load(\$text);
254 32         186 $self->wasbinary(1);
255 32 50       96 if (wantarray) {
256 0         0 return %{$tree};
  0         0  
257             }
258 32         4822 return $tree;
259             }
260              
261             }
262 3 50       13 if ($guess) {
263 3         18 my $enc=guess_encoding($text);
264 3 50       273 $text=$enc->decode($text) if ref $enc;
265 3 50       15 $text=Encode::decode("UTF-8",$text) unless ref $enc;
266             }
267 3 50       34 substr($text,0,1,"") if substr($text,0,1) eq chr(65279); # UTF-8 BOM (Why ain't it removed ?)
268 3 50       10 close $fh if ref $file;
269 3         8 $$self{CurFile}="";
270 3         17 my $u=$self->unpack($text);
271 3         9 $self->{OBJECT}=0;
272 3         121 return $u;
273             }
274              
275             sub noComments {
276 0     0 0 0 my $self=shift;
277 0         0 $$self{PreserveCommentary}=0;
278             }
279             sub object {
280 0     0 0 0 my $self=shift;
281 0         0 $$self{OBJECT}=shift;
282             }
283             sub comment {
284 53     53 0 107 my $self=shift;
285 53         94 my $data=undef;
286 53 100       309 if ($_[0]) {
287 29 50       101 if (ref $_[0] eq "HASH") {
288 29         56 $data=shift;
289             }
290             else {
291 0         0 $data={@_};
292             }
293             }
294 53 100       379 $$self{Commentary}=$data if $data;;
295 53         146 return $self->{Commentary};
296             }
297             sub comments {
298 24     24 1 43 my $self=shift;
299 24         38 my $data=undef;
300 24 50       72 if ($_[0]) {
301 0 0       0 if (ref $_[0] eq "HASH") {
302 0         0 $data=shift;
303             }
304             else {
305 0         0 $data={@_};
306             }
307             }
308 24 50       81 $$self{Commentary}=$data if $data;;
309 24         176 return $self->{Commentary};
310             }
311             sub setIndent {
312 0     0 1 0 my $self=shift;
313 0         0 local $_;
314 0         0 $$self{SetIndent}=shift;
315             }
316             sub setWarnings {
317 0     0 1 0 my $self=shift;
318 0         0 local $_;
319 0         0 $$self{WARN}=shift;
320             }
321             sub allWarn {
322 0     0 0 0 my $self=shift;
323 0         0 local $_;
324 0         0 $$self{WARN}=1;
325             }
326             sub noWarn {
327 0     0 0 0 my $self=shift;
328 0         0 local $_;
329 0         0 $$self{WARN}=0;
330             }
331             sub iKnowWhatIAmDoing {
332 0     0 0 0 my $self=shift;
333 0         0 local $_;
334 0         0 $$self{WARN}=0;
335             }
336             sub iDontKnowWhatIAmDoing {
337 0     0 0 0 my $self=shift;
338 0         0 local $_;
339 0         0 $$self{WARN}=1;
340             }
341             sub commentary {
342 801     801 0 1063 my $self=shift;
343 801 50       1815 return "" unless $self->{PreserveCommentary};
344 801         1196 my $tree=$self->{TREE};
345 801 100       1420 $tree="=" unless $tree;
346 801 100       1866 if ($self->{Commentary}->{$tree}) {
347 7         7 my $res;
348 7 100       19 $res=" " if $self->{TREE};
349 7         9 foreach (@{$self->{Commentary}->{$tree}}) {
  7         19  
350             # print ">>$_<<\n";
351 7 50 66     27 $res.="\n" if $res and $res ne " ";
352 7         25 $res.="# $_";
353             }
354 7         31 return $res;
355             }
356 794         3656 return "";
357             }
358             sub writeList {
359 150     150 0 191 my $self=shift;
360 150         166 local $_;
361 150         167 my $deep=shift;
362 150         190 my $ref=shift;
363 150         197 my $res="";
364 150         312 my $tree=$self->{TREE};
365 150 50 33     511 if ($$self{Ref}->{$ref} and $self->{TREE}) {
366             #confess($tree);
367 0         0 $res.="@".$$self{Ref}->{$ref}."\n";
368             #$self->warn("Cross-reference ignored");
369 0         0 return $res;
370             }
371 150   50     571 $$self{Ref}->{$ref}=($tree || "->");
372 150         288 $res.="(".$self->commentary."\n";
373 150         252 my $i=0;
374 150         167 foreach my $r (@{$ref}) {
  150         311  
375 600         1670 $self->{TREE}=$tree."->$i";
376 600 100       1229 if (not ref($r)) {
    100          
    50          
377 500         1355 $res.=$$self{Indent} x $deep.$self->escape($r).$self->commentary."\n";
378             }
379             elsif (ref $r eq "HASH") {
380 50         106 $res.=$$self{Indent} x $deep;
381 50         233 $res.=$self->writeMap($deep+1,$r);
382             }
383             elsif (ref $r eq "ARRAY") {
384 50         182 $res.=$$self{Indent} x $deep;
385 50         152 $res.=$self->writeList($deep+1,$r);
386             }
387             else {
388 0         0 $self->warn("Non sofu reference");
389             }
390 600         1376 $i++;
391            
392             }
393 150         880 return $res.$$self{Indent} x --$deep.")\n";
394             }
395             sub writeMap {
396 150     150 0 204 my $self=shift;
397 150         164 local $_;
398 150         178 my $deep=shift;
399 150         185 my $ref=shift;
400 150         262 my $tree=$self->{TREE};
401 150         192 my $res="";
402             #print Data::Dumper->Dump([$$self{Ref}]);
403 150 100 66     627 if ($$self{Ref}->{$ref} and $self->{TREE}) {
404             #confess();
405 50         188 $res.="@".$$self{Ref}->{$ref}."\n";
406             #$self->warn("Cross-reference ignored");
407 50         200 return $res;
408             }
409 100   100     457 $$self{Ref}->{$ref}=($tree || "->");
410 100 100 100     583 $res.="{".$self->commentary."\n" if $deep or not $$self{Libsofucompat};
411 100         152 foreach (sort keys %{$ref}) {
  100         507  
412 225         491 my $wkey=$self->keyescape($_);
413 225 50 33     1407 $self->warn("Impossible Name for a Map-Entry: \"$wkey\"") if not $wkey or $wkey=~m/[\=\"\}\{\(\)\s\n]/;
414 225         554 $self->{TREE}=$tree."->$_";
415 225 100       874 unless (ref $$ref{$_}) {
    100          
    50          
416 50         212 $res.=$$self{Indent} x $deep."$wkey = ".$self->escape($$ref{$_}).$self->commentary."\n";
417             }
418             elsif (ref $$ref{$_} eq "HASH") {
419 75         280 $res.=$$self{Indent} x $deep."$wkey = ";
420 75         262 $res.=$self->writeMap($deep+1,$$ref{$_});
421             }
422             elsif (ref $$ref{$_} eq "ARRAY") {
423 100         284 $res.=$$self{Indent} x $deep."$wkey = ";
424 100         424 $res.=$self->writeList($deep+1,$$ref{$_});
425             }
426             else {
427 0         0 $self->warn("non Sofu reference");
428             }
429            
430             }
431 100 100 100     493 $res.=$$self{Indent} x --$deep."}\n" if $deep or not $$self{Libsofucompat};
432 100         464 return $res;
433             }
434             sub write {
435 24     24 1 46 my $self=shift;
436 24         47 local $_;
437 24         54 my $file=shift;
438 24         44 my $fh;
439 24         71 $$self{TREE}="";
440 24 100       220 unless (ref $file) {
    100          
    50          
441 1         3 $$self{CurFile}=$file;
442 1 50       148 open $fh,">:raw:encoding(UTF-16)",$$self{CurFile} or die "Sofu error open: $$self{CurFile} file: $!";
443             }
444             elsif (ref $file eq "SCALAR") {
445 1         9 $$self{CurFile}="Scalarref";
446 1         4 utf8::upgrade($$file);
447 1 50   1   12 open $fh,">:utf8",$file or die "Can't open perlIO: $!";
  1         3  
  1         7  
  1         48  
448             }
449             elsif (ref $file eq "GLOB") {
450 22         74 $$self{CurFile}="FileHandle";
451 22         44 $fh=$file;
452             }
453             else {
454 0         0 $self->warn("The argument to read or write has to be a filename, reference to a scalar or filehandle");
455 0         0 return;
456             }
457 24         1518 my $ref=shift;
458             #use Data::Dumper;
459             #print Data::Dumper->Dump([$ref]);
460 24         125 $self->{Commentary}={};
461 24         123 $self->comment(@_);
462 24 50       117 $$self{Indent}="\t" unless $$self{SetIndent};
463 24         57 $$self{Libsofucompat}=1;
464 24         36 %{$$self{Ref}}=();
  24         514  
465             #$self->{Ref}->{$ref}="->";
466 24         102 print $fh $self->commentary,"\n";
467 24 50       137 unless (ref $ref) {
    50          
    0          
468 0         0 print $fh "Value=".$self->escape($ref);
469             }
470             elsif (ref $ref eq "HASH") {
471 24         116 print $fh $self->writeMap(0,$ref);
472             }
473             elsif (ref $ref eq "ARRAY") {
474 0         0 print $fh "Value=".$self->writeList(0,$ref);
475             }
476             else {
477 0         0 $self->warn("non Sofu reference");
478 0         0 return "";
479             }
480 24         62 $$self{Libsofucompat}=0;
481 24         46 $$self{Indent}="";
482             #close $fh if ref $file;
483 24         55 $$self{CurFile}="";
484 24         203 return 1;
485             }
486              
487              
488             sub read {
489 60     60 1 102 my $self=shift;
490 60         101 local $_;
491 60         132 my $file=shift;
492 60         89 my $fh;
493 60         178 $$self{TREE}="";
494 60         120 $$self{OBJECT}=0;
495 60         118 $$self{CURRENT}=0;
496 60         183 $$self{References}=[];
497 60         184 $self->{Commentary}={};
498 60         155 %{$$self{Ref}}=();
  60         416  
499 60         123 my $guess=0;
500 60 100       228 unless (ref $file) {
    50          
    0          
501 48         148 $$self{CurFile}=$file;
502 48 50       2432 open $fh,$$self{CurFile} or die "Sofu error open: $$self{CurFile} file: $!";
503 48         110 $guess=1;
504 48         163 binmode $fh;
505             #eval {require File::BOM;my ($e,$sp)=File::BOM::defuse($fh);$$self{Ret}.=$sp;$e=$e;};undef $@;
506             }
507             elsif (ref $file eq "SCALAR") {
508 12         40 $$self{CurFile}="Scalarref";
509 12 100 50     104 open $fh,"<:utf8",$file or die "Can't open perlIO: $!" if utf8::is_utf8($$file);
510 12 50 50     221 open $fh,"<",$file or die "Can't open perlIO: $!" if !utf8::is_utf8($$file);
511             }
512             elsif (ref $file eq "GLOB") {
513 0         0 $$self{CurFile}="FileHandle";
514 0         0 $fh=$file;
515             }
516             else {
517 0         0 $self->warn("The argument to read or write has to be a filename, reference to a scalar or filehandle");
518 0         0 return;
519             }
520 60         113 my $text=do {local $/,<$fh>};
  60         2052  
521             {
522 60         117 my $b = substr($text,0,2);
  60         232  
523 60         136 my $u = substr($text,2,1);
524 60 100       214 if ($b eq "So") {
525 23         59 $b=substr($text,0,4);
526 23 50       83 if ($b eq "Sofu") {
527 23         40 $b=substr($text,4,2);
528 23         51 $u=substr($text,6,1);
529             }
530             }
531 60 100 100     690 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
      100        
532 26         241 require Data::Sofu::Binary;
533 26 50       89 $bdriver = Data::Sofu::Binary->new() unless $bdriver;
534 26         178 my ($tree,$c) = $bdriver->read(\$text);
535 26         237 $self->comment($c);
536 26         122 $self->wasbinary(1);
537 26 50       249 if (wantarray) {
538 0         0 return %{$tree};
  0         0  
539             }
540 26         687 return $tree;
541             }
542              
543             }
544 34 100       107 if ($guess) {
545 30         258 my $enc=guess_encoding($text);
546 30 100       11876 $text=$enc->decode($text) if ref $enc;
547 30 100       141 $text=Encode::decode("UTF-8",$text) unless ref $enc;
548             }
549 34 100       267 close $fh if ref $file;
550 34         77 $$self{CurFile}="";
551 34 100       253 substr($text,0,1,"") if substr($text,0,1) eq chr(65279); # UTF-8 BOM (Why ain't it removed ?)
552 34         190 my $u=$self->unpack($text);
553             #print Data::Dumper->Dump([$u]);
554 34 50       103 if (wantarray) {
555 0 0       0 return () unless $u;
556 0 0       0 return %{$u} if ref $u eq "HASH";
  0         0  
557 0         0 return (Value=>$u);
558             }
559 34 50       76 return unless $u;
560 34 50       1634 return $u if ref $u eq "HASH";
561 0         0 return {Value=>$u};
562             # $self->warn("Unpack error: $u") unless ref $u;
563             # return %{$u};
564             }
565              
566             sub pack {
567 1     1 1 3 my $self=shift;
568 1         2 my $ref=shift;
569 1         1 local $_;
570 1         3 $self->{Commentary}={};
571 1         4 $self->comment(@_);
572 1         2 $$self{TREE}="";
573 1         2 %{$$self{Ref}}=();
  1         11  
574             #$self->{Ref}->{$ref}="->";
575 1 50       5 $$self{Indent}=$$self{SetIndent} if $$self{SetIndent};
576 1         2 $$self{Counter}=0;
577 1 50       6 unless (ref $ref) {
    50          
    0          
578 0         0 return $self->commentary.$self->escape($ref);
579             }
580             elsif (ref $ref eq "HASH") {
581 1         4 return $self->commentary.$self->writeMap(0,$ref);
582             }
583             elsif (ref $ref eq "ARRAY") {
584 0         0 return $self->commentary.$self->writeList(0,$ref);
585             }
586             else {
587 0         0 $self->warn("non Sofu reference");
588 0         0 return "";
589             }
590             }
591             sub unpack($) {
592 39     39 1 63 my $self=shift;
593 39         67 local $_;
594 39         88 $$self{TREE}="";
595 39         79 $$self{Counter}=0;
596 39         186 ($self->{Escape},$self->{String},$self->{COUNT})=(0,0,0);
597 39         203 $$self{Line}=1;
598 39         187 $$self{READLINE}=shift()."\n";
599 39         223 $$self{LENGTH}=length $$self{READLINE};
600 39         63 %{$$self{Ref}}=();
  39         129  
601 39         72 $$self{CURRENT}=0;
602 39         88 $$self{References}=[];
603 39         84 $self->{Commentary}={};
604 39         70 my $c;
605 39         85 my $bom=chr(65279);
606 39   66     149 1 while ($c=$self->get() and ($c =~ m/\s/ or $c eq $bom));
      33        
607 39 50       105 return unless defined $c;
608 39 100       444 if ($c eq "{") {
    50          
    50          
    50          
    50          
609 2         4 my $result;
610 2         11 $result=$self->parsMap;
611 2         13 $$self{Ref}->{""}=$result;
612 2         11 $self->postprocess();
613 2   66     9 1 while ($c=$self->get() and $c =~ m/\s/);
614 2 50       9 if ($c=$self->get()) {
615 0         0 $self->warn("Trailing Characters: $c");
616             }
617 2         18 return $result;
618             }
619             elsif ($c eq "(") {
620 0         0 my $result;
621 0         0 $result=$self->parsList;
622 0         0 $$self{Ref}->{""}=$result;
623 0         0 $self->postprocess();
624 0   0     0 1 while ($c=$self->get() and $c =~ m/\s/);
625 0 0       0 if ($c=$self->get()) {
626 0         0 $self->warn("Trailing Characters: $c");
627             }
628 0         0 return $result;
629            
630             }
631             elsif ($c eq "\"") {
632 0         0 my $result;
633 0         0 $result=$self->parsValue;
634 0         0 $$self{Ref}->{""}=$result;
635 0         0 $self->postprocess();
636 0   0     0 1 while ($c=$self->get() and $c =~ m/\s/);
637 0 0       0 if ($c=$self->get()) {
638 0         0 $self->warn("Trailing Characters: $c");
639             }
640 0         0 return $result;
641             }
642             elsif ($c eq "<") {
643 0         0 my $x;
644 0   0     0 1 while ($x=$self->get() and $x =~ m/\s/);
645 0 0 0     0 if ($x eq "!" or $x eq "S" or $x eq "?") { #
      0        
646 0         0 require Data::Sofu::SofuML;
647 0 0       0 $mldriver=Data::Sofu::SofuML->new unless $mldriver;
648 0 0       0 if ($$self{OBJECT}) {
649 0         0 return $mldriver->load($$self{READLINE});
650             }
651 0         0 my ($r,$c) = $mldriver->read($$self{READLINE});
652 0         0 $self->{Commentary}=$c;
653 0         0 return $r;
654             }
655             else {
656 0         0 $self->{COUNT}=0;
657 0         0 my $result=$self->parsMap;
658 0         0 $$self{Ref}->{""}=$result;
659 0         0 $self->postprocess();
660 0   0     0 1 while ($c=$self->get() and $c =~ m/\s/);
661 0 0       0 if ($c=$self->get()) {
662 0         0 $self->warn("Trailing Characters: $c");
663             }
664 0         0 return $result;
665             }
666             }
667             elsif ($c!~m/[\=\"\}\{\(\)\s\n]/) {
668 37         94 $$self{Ret}=$c;
669 37         52 my $result;
670 37         146 $result=$self->parsMap;
671 37         117 $$self{Ref}->{""}=$result;
672 37         138 $self->postprocess();
673 37   66     105 1 while ($c=$self->get() and $c =~ m/\s/);
674 37 50       89 if ($c=$self->get()) {
675 0         0 $self->warn("Trailing Characters: $c");
676             }
677 37         127 return $result;
678             }
679             else {
680 0         0 $self->warn("Nothing to unpack: $c");
681 0         0 return 0;
682             }
683             }
684             sub get() {
685 17802     17802 0 20817 my $self=shift;
686 17802         17454 local $_;
687 17802 100       35508 if ($$self{Ret}) {
688 98         358 my $ch=substr($$self{Ret},0,1,"");
689 98         338 return $ch;
690             }
691 17704 0 33     29734 return shift if @_ and $_[0] and $_[0]!="";
      0        
692 17704 50       32363 $self->{LENGTH}=length $$self{READLINE} unless $self->{LENGTH};
693 17704 100 50     35223 $self->storeComment and return undef if $self->{COUNT}>=$self->{LENGTH};
694 17566         35740 my $c=substr($$self{READLINE},$self->{COUNT}++,1);
695 17566 50       33651 print "GET '$c'\n" if $$self{Debug};
696             #print "DEBUG: $self->{COUNT}=$c\n";
697 17566 100       31548 if ($c eq "\"") {
698 1536 50       4191 $self->{String}=!$self->{String} unless $self->{Escape};
699             }
700 17566 100       27742 if ($c eq "\\") {
701 240         418 $self->{Escape}=!$self->{Escape};
702             }
703             else {
704 17326         22145 $self->{Escape}=0;
705             }
706 17566 50 66     35959 if ($c eq "#" and not $self->{String} and not $self->{Escape}){
      66        
707 78         427 my $i=index($$self{READLINE},"\n",$self->{COUNT});
708 78         237 my $comm = substr($$self{READLINE},$self->{COUNT},$i-$self->{COUNT});
709 78         146 chomp $comm;
710 78         150 $comm=~s/\r//g; #I hate Windows...!
711             #die $comm;
712 78         84 push @{$self->{COMMENT}},$comm;
  78         196  
713             #push @{$self->{COMMENT}},substr($$self{READLINE},$self->{COUNT},$i-$self->{COUNT});
714             #print "DEBUG JUMPING FROM $self->{COUNT} to INDEX=$i";
715 78         146 $self->{COUNT}=$i+1;
716 78         118 $c="\n";
717             }
718 17566         22082 ++$$self{Counter};
719 17566 100 100     76095 if ($c and $c eq "\n") {
720 1678         7940 $$self{Counter}=0;
721 1678         2015 $$self{Line}++;
722             }
723 17566 50 33     35194 print "END" if not defined $c and $$self{Debug} ;
724 17566         57974 return $c;
725             }
726             sub storeComment {
727 2653     2653 0 3165 my $self=shift;
728             #if ($$self{OBJECT}) {
729             # $$self{Ref}->{$self->{TREE}}->appendComment($self->{COMMENT});
730             #}
731 2653         4207 my $tree=$self->{TREE};
732 2653 100       4568 $tree="=" unless $tree;
733             #print "DEBUG: $tree, @{$self->{COMMENT}} , ".join(" | ",caller())."\n";
734 2653 100       2656 push @{$self->{Commentary}->{$tree}},@{$self->{COMMENT}} if @{$self->{COMMENT}};
  73         211  
  73         174  
  2653         6264  
735 2653         6253 $self->{COMMENT}=[];
736             }
737              
738             sub postprocess {
739 39     39 0 62 my $self=shift;
740 39         202 $self->{Ref}->{"="} = $self->{Ref}->{"->"} = $self->{Ref}->{""};
741 39 100       98 if ($$self{OBJECT}) {
742 3         5 foreach my $e (@{$$self{References}}) {
  3         12  
743 15 50       20 next if ${$e}->valid();
  15         64  
744 15         18 my $target = ${$e}->follow()."";
  15         43  
745 15 100 66     116 $target="->".$target if $target and $target !~ m/^->/;
746 15 50       54 ${$e}->dangle($self->{Ref}->{$target}) if $self->{Ref}->{$target};
  15         69  
747             }
748 3         6 foreach my $key (keys %{$$self{Commentary}}) {
  3         15  
749 12 50       148 $self->{Ref}->{$key}->setComment($$self{Commentary}->{$key}) if $self->{Ref}->{$key};
750             }
751             }
752             else {
753 36         57 foreach my $e (@{$$self{References}}) {
  36         156  
754 101         180 my $target = $$$e;
755 101 100 66     598 $target="->".$target if $target and $target !~ m/^->/;
756 101         128 $$e = undef;
757 101 50       974 $$e = $self->{Ref}->{$target} if $self->{Ref}->{$target};
758             }
759             }
760             }
761             sub warn {
762 5     5   69218 no warnings;
  5         15  
  5         23217  
763 0     0 0 0 my $self=shift;
764 0         0 local $_;
765 0         0 confess "Sofu warning: \"".shift(@_)."\" File: $$self{CurFile}, Line : $$self{Line}, Char : $$self{Counter}, Caller:".join(" ",caller);
766 0         0 1;
767             }
768             sub escape {
769 550     550 0 558 shift;
770 550         667 my $text=shift;
771 550         868 return Sofuescape($text);
772             }
773             sub Sofuescape {
774 607     607 0 755 my $text=shift;
775 607 100       1699 return "UNDEF" unless defined $text; #TODO: UNDEF = Undefined
776 582         924 $text=~s/\\/\\\\/g;
777 582         827 $text=~s/\n/\\n/g;
778 582         728 $text=~s/\r/\\r/g;
779 582         671 $text=~s/\"/\\\"/g;
780 582         2237 return "\"$text\"";
781             }
782             sub deescape {
783 960     960 0 1266 my $self=shift;
784 960         893 local $_;
785 960         1135 my $text="";
786 960         1153 my $ttext=shift;
787 960         979 my $noescape=shift;
788 960 100       1519 if ($noescape) {
789 192 100       772 if ($ttext =~ m/^\@(.+)$/) {
790             #return $$self{Ref}->{$1} || $self->warn("Can't find reference to $1.. References must first defined then called. You can't reference a string or number")
791 116 100       301 if ($$self{OBJECT}) {
792 15         102 return Data::Sofu::Reference->new($1);
793             }
794 101         307 my $text=$1;
795 101         680 return \$text;
796              
797             }
798 76 100       370 if ($$self{OBJECT}) {
799 15 100       64 return Data::Sofu::Undefined->new() if $ttext eq "UNDEF";
800 12         48 return Data::Sofu::Value->new($ttext);
801             }
802 61 100       471 return undef if $ttext eq "UNDEF";
803 24         141 return $ttext;
804             }
805             else {
806 768         735 my $char;
807 768         855 my $escape=0;
808 768         784 my $count=0;
809 768         1284 my $len=length $ttext;
810 768         1452 while ($count <= $len) {
811 7043         9427 my $char=substr($ttext,$count++,1);
812 7043 100       9865 if ($char eq "\\") {
813 240 50       414 $text.="\\" if $escape;
814 240         491 $escape=!$escape;
815             }
816             else {
817 6803 100       8902 if ($escape) {
818 240 100       510 if (lc($char) eq "n") {
    50          
    0          
819 200         264 $text.="\n";
820             }
821             elsif (lc($char) eq "r") {
822 40         91 $text.="\r";
823             }
824             elsif (lc($char) eq "\"") {
825 0         0 $text.="\"";
826             }
827             else {
828 0         0 $self->warn("Deescape: Can't deescape: \\$char");
829             }
830 240         476 $escape=0;
831             }
832             else {
833 6563         12608 $text.=$char;
834             }
835             }
836             }
837 768 100       1614 return Data::Sofu::Value->new($text) if $self->{OBJECT};;
838 726         2523 return $text;
839             }
840             }
841             sub parsMap {
842 159     159 0 222 my $self=shift;
843 159         180 local $_;
844 159         196 my %result;
845 159         229 my $comp="";
846 159         192 my $eq=0;
847 159         158 my $char;
848 159         263 my $tree=$self->{TREE};
849 159         242 my @order;
850 159         340 while (defined($char=$self->get())) {
851 4584 50       11151 print "ParsCompos $char\n" if $$self{Debug};
852 4584 100       21968 if ($char!~m/[\=\"\}\{\(\)\s\n]/s) {
    100          
    100          
    100          
    100          
    100          
    50          
853 2123 100       3139 if ($eq) {
854 43         120 $self->storeComment;
855 43         107 my $keyu = $self->keyunescape($comp);
856 43         136 $self->{TREE}=$tree."->".$comp;
857             #print ">> > >> > > > > DEBUG: tree=$self->{TREE}\n";
858 43         139 $result{$keyu}=$self->getSingleValue($char);
859 43         99 push @order,$keyu;
860 43 50       151 push @{$$self{References}},\$result{$keyu} if refe $result{$keyu};
  43         143  
861 43         69 $comp="";
862 43         129 $eq=0;
863             }
864             else {
865 2080         4740 $comp.=$char;
866             }
867             }
868             elsif ($char eq "=") {
869 360 50       685 $self->warn("MapEntry unnamed!") if ($comp eq "");
870 360         5775 $self->storeComment;
871 360         941 $self->{TREE}=$tree."->".$comp;
872 360         844 $eq=1;
873             }
874             elsif ($char eq "{") {
875 80 50       205 $self->warn("Missing \"=\"!") unless $eq;
876 80 50       207 $self->warn("MapEntry unnamed!") if ($comp eq "");
877 80         229 $self->storeComment;
878 80         225 $self->{TREE}=$tree."->".$comp;
879 80         136 my $res={};
880 80         252 $res=$self->parsMap();
881 80         321 $$self{Ref}->{$self->{TREE}}=$res;
882 80         167 my $kkey=$self->keyunescape($comp);
883 80         136 push @order,$kkey;
884 80         213 $result{$kkey} = $res;
885 80         111 $comp="";
886 80         239 $eq=0;
887             }
888             elsif ($char eq "}") {
889 124         271 $self->storeComment;
890 124         288 $self->{TREE}=$tree;
891 124 100       352 return Data::Sofu::Map->new(\%result,[@order]) if $self->{OBJECT};
892 115         405 return \%result;
893             }
894             elsif ($char eq "\"") {
895 77 50       203 if (not $eq) {
896 0         0 $self->warn("Unclear Structure detected: was the last entry a value or a key (maybe you forgot either \"=\" before this or the \'\"\' around the value");
897 0         0 $eq=1;
898             }
899 77         157 $self->storeComment;
900 77         199 $self->{TREE}=$tree."->".$comp;
901             #print ">>>>>>>>>>>>>>>>>>>>>>>>DEBUG: tree=$self->{TREE}\n";
902 77 50       174 $self->warn("Missing \"=\"!") unless $eq;
903 77 50       188 $self->warn("MapEntry unnamed!") if ($comp eq "");
904            
905 77         171 my $kkey=$self->keyunescape($comp);
906 77         139 push @order,$kkey;
907 77         245 $result{$kkey}=$self->parsValue();
908 77         135 $comp="";
909 77         198 $eq=0;
910             }
911             elsif ($char eq "(") {
912 160 50       345 if (not $eq) {
913 0         0 return $self->parsList();
914             }
915 160 50       281 $self->warn("Missing \"=\"!") unless $eq;
916 160 50       326 $self->warn("MapEntry unnamed!") if ($comp eq "");
917 160         463 $self->storeComment;
918 160         426 $self->{TREE}=$tree."->".$comp;
919 160         247 my $res=[];
920 160         478 $res=$self->parsList();
921 160         679 $$self{Ref}->{$self->{TREE}}=$res;
922 160         466 my $kkey=$self->keyunescape($comp);
923 160         330 push @order,$kkey;
924 160         455 $result{$kkey} = $res;
925 160         235 $comp="";
926 160         455 $eq=0;
927             }
928             elsif ($char eq ")") {
929 0         0 $self->warn("What's a \"$char\" doing here?");
930             }
931             }
932 35 100       140 return Data::Sofu::Map->new(\%result,[@order]) if $self->{OBJECT};
933 32         236 return \%result;
934             }
935             sub parsValue {
936 77     77 0 104 my $self=shift;
937 77         87 local $_;
938 77         122 my @result;
939 77         109 my $cur="";
940 77         97 my $in=1;
941 77         89 my $escape=0;
942 77         94 my $char;
943 77         85 my $i=0;
944 77         124 my $tree=$self->{TREE};
945 77         106 my $starttree=$self->{TREE};
946 77         171 $self->storeComment;
947 77         203 $self->{TREE}=$tree."->0";
948 77         203 while (defined($char=$self->get())) {
949 917 50       1900 print "ParsValue $char\n" if $$self{Debug};
950 917 100       1350 if ($in) {
951 739 100       1490 if ($char eq "\"") {
    50          
952 77 50       148 if ($escape) {
953 0         0 $escape=0;
954 0         0 $cur.=$char;
955             }
956             else {
957 77         205 push @result,$self->deescape($cur,0);
958 77 50       226 push @{$$self{References}},\$result[-1] if refe $result[-1];
  0         0  
959 77         193 $self->storeComment;
960 77         303 $self->{TREE}=$tree."->".$i++;
961 77         293 $$self{Ref}->{$self->{TREE}}=$result[-1];
962 77         95 $cur="";
963 77         214 $in=0;
964             }
965             }
966             elsif ($char eq "\\") {
967 0 0       0 if ($escape) {
968 0         0 $escape=0;
969             }
970             else {
971 0         0 $escape=1;
972             }
973 0         0 $cur.=$char;
974             }
975             else {
976 662         665 $escape=0;
977 662         1435 $cur.=$char;
978             }
979              
980             }
981             else {
982 178 100       1556 if ($char!~m/[\=\"\}\{\(\)\s\n]/s) {
    50          
    50          
    50          
    100          
    50          
    50          
983 13         28 $$self{Ret}=$char;
984 13 50       65 if (@result>1) {
    50          
985 0         0 $self->{TREE}=$tree."->$#result";
986 0         0 $self->storeComment;
987 0         0 my $res=[@result];
988 0 0       0 $res=Data::Sofu::List->new($res) if $self->{OBJECT};
989 0         0 $$self{Ref}->{$tree}=$res;
990 0         0 return $res;
991             }
992             elsif (@result) {
993 13         27 $self->{TREE}=$tree;
994 13         35 $self->storeComment;
995 13         45 $$self{Ref}->{$tree}=\$result[0];
996 13         58 return $result[0];
997             }
998             else { #This can't happen
999 0         0 return undef;
1000             }
1001             }
1002             elsif ($char eq "=") {
1003 0         0 $self->warn("What's a \"$char\" doing here?");
1004             }
1005             elsif ($char eq "\"") {
1006 0         0 $in=1;
1007             }
1008             elsif ($char eq "{") {
1009 0         0 $self->storeComment;
1010 0         0 $self->{TREE}=$tree."->".++$i;
1011 0         0 my $res={};
1012 0         0 %{$res}=$self->parsMap();
  0         0  
1013 0         0 $$self{Ref}->{$self->{TREE}}=$res;
1014 0         0 push @result,$res;
1015             }
1016             elsif ($char=~m/[\}\)]/) {
1017 39         94 $$self{Ret}=$char;
1018 39 50       87 if ($cur ne "") {
1019 0 0       0 $cur=Data::Sofu::Value->new($cur) if $self->{OBJECT};
1020 0 0       0 if (@result) {
1021 0         0 $self->{TREE}=$tree."->".$#result+1;
1022 0         0 $self->storeComment;
1023 0         0 my $res={@result,$cur};
1024 0 0       0 $res=Data::Sofu::List->new($res) if $self->{OBJECT};
1025 0         0 $$self{Ref}->{$tree}=$res;
1026 0         0 return $res;
1027             }
1028             else {
1029 0         0 $self->{TREE}=$tree;
1030 0         0 $self->storeComment;
1031             #$self{Ref}->{$tree}=\$cur;
1032 0         0 $$self{Ref}->{$tree}=$cur;
1033 0         0 return $cur;
1034             }
1035             }
1036             else {
1037 39 50       149 if (@result>1) {
    50          
1038 0         0 $self->{TREE}=$tree."->$#result";
1039 0         0 $self->storeComment;
1040 0         0 my $res=[@result];
1041 0 0       0 $res=Data::Sofu::List->new($res) if $self->{OBJECT};
1042 0         0 $$self{Ref}->{$tree}=$res;
1043 0         0 return $res;
1044             }
1045             elsif (@result) {
1046 39         90 $self->{TREE}=$tree;
1047 39         86 $self->storeComment;
1048             #$$self{Ref}->{$tree}=\$result[0];
1049 39         493 $$self{Ref}->{$tree}=$result[0];
1050 39         169 return $result[0];
1051             }
1052             else {
1053             #$$self{Ref}->{$tree}=\$cur;
1054 0 0       0 $cur=Data::Sofu::Value->new($cur) if $self->{OBJECT};
1055 0         0 $$self{Ref}->{$tree}=$cur;
1056 0         0 return $cur;
1057             }
1058             }
1059             }
1060             elsif ($char eq "(") {
1061 0         0 $self->storeComment;
1062 0         0 $self->{TREE}=$tree."->".++$i;
1063 0         0 my $res=[];
1064 0         0 $res=$self->parsList();
1065 0         0 $$self{Ref}->{$self->{TREE}}=$res;
1066 0         0 push @result,$res;
1067             }
1068             elsif ($char eq ")") {
1069 0         0 $self->warn("What's a \"$char\" doing here?");
1070             }
1071             }
1072             }
1073 25 50       84 if ($cur ne "") {
1074 0 0       0 $cur=Data::Sofu::Value->new($cur) if $self->{OBJECT};
1075 0 0       0 if (@result) {
1076 0         0 $self->{TREE}=$tree."->".$#result+1;
1077 0         0 $self->storeComment;
1078 0         0 push @result,$cur;
1079 0         0 my $res=[@result];
1080 0 0       0 $res=Data::Sofu::List->new($res) if $self->{OBJECT};
1081 0         0 $$self{Ref}->{$tree}=$res;
1082 0         0 return $res;
1083             }
1084             else {
1085 0         0 $self->{TREE}=$tree;
1086             #$$self{Ref}->{$tree}=\$cur;
1087 0         0 $$self{Ref}->{$tree}=$cur;
1088 0         0 $self->storeComment;
1089 0         0 return $cur;
1090             }
1091             }
1092             else {
1093 25 50       112 if (@result>1) {
    50          
1094 0         0 $self->{TREE}=$tree."->$#result";
1095 0         0 $self->storeComment;
1096 0         0 my $res=[@result];
1097 0 0       0 $res=Data::Sofu::List->new($res) if $self->{OBJECT};
1098 0         0 $$self{Ref}->{$tree}=$res;
1099 0         0 return $res;
1100             }
1101             elsif (@result) {
1102 25         50 $self->{TREE}=$tree;
1103 25         60 $self->storeComment;
1104             #$$self{Ref}->{$tree}=\$result[0];
1105 25         104 $$self{Ref}->{$tree}=$result[0];
1106 25         100 return $result[0];
1107             }
1108             else {
1109 0 0       0 $cur=Data::Sofu::Value->new($cur) if $self->{OBJECT};
1110 0         0 $$self{Ref}->{$tree}=$cur;
1111 0         0 return $cur;
1112             }
1113             }
1114             }
1115             sub getSingleValue {
1116 192     192 0 240 my $self=shift;
1117 192         211 local $_;
1118 192         233 my $res="";
1119 192 50       477 $res=shift if @_;
1120 192         202 my $char;
1121 192         412 while (defined($char=$self->get())) {
1122 1417 50       2991 print "ParsSingle $char\n" if $$self{Debug};
1123 1417 100       7617 if ($char!~m/[\=\"\}\{\(\)\s]/) {
    50          
    100          
    50          
1124 1225         2861 $res.=$char;
1125             }
1126             elsif ($char=~m/[\=\"\{\(]/) {
1127 0         0 $self->warn("What's a \"$char\" doing here?");
1128             }
1129             elsif ($char=~m/[\}\)]/) {
1130 9         24 $$self{Ret}=$char;
1131 9         35 return $$self{Ref}->{$self->{TREE}}=$self->deescape($res,1);
1132             }
1133             elsif ($char=~m/\s/) {
1134 183         445 return $$self{Ref}->{$self->{TREE}}=$self->deescape($res,1);
1135 0         0 return $res;
1136             }
1137             }
1138 0         0 $self->warn ("Unexpected EOF");
1139 0         0 return $$self{Ref}->{$self->{TREE}}=$self->deescape($res,1);
1140             }
1141             sub parsList {
1142 240     240 0 473 my $self=shift;
1143 240         254 local $_;
1144 240         276 my @result;
1145 240         319 my $cur="";
1146 240         666 my $in=0;
1147 240         286 my $escape=0;
1148 240         227 my $char;
1149 240         238 my $i=0;
1150 240         363 my $tree=$self->{TREE};
1151 240         464 $self->storeComment;
1152             #$self->{TREE}=$tree."->0";
1153 240         561 while (defined($char=$self->get())) {
1154 10649 50       29826 print "ParsList $char\n" if $$self{Debug};
1155 10649 100       16060 if ($in) {
1156 6304 100       12428 if ($char eq "\"") {
    100          
1157 691 50       1171 if ($escape) {
1158 0         0 $escape=0;
1159 0         0 $cur.=$char;
1160             }
1161             else {
1162 691         1529 push @result,$self->deescape($cur,0);
1163 691 50       1572 push @{$$self{References}},\$result[-1] if refe $result[-1];
  0         0  
1164 691         1470 $self->storeComment;
1165 691         2207 $self->{TREE}=$tree."->".$i++;
1166 691         2436 $$self{Ref}->{$self->{TREE}}=$result[-1];
1167 691         919 $cur="";
1168 691         1618 $in=0;
1169             }
1170             }
1171             elsif ($char eq "\\") {
1172 240 50       363 if ($escape) {
1173 0         0 $escape=0;
1174             }
1175             else {
1176 240         381 $escape=1;
1177             }
1178 240         512 $cur.=$char;
1179             }
1180             else {
1181 5373         11383 $escape=0;
1182 5373         11156 $cur.=$char;
1183             }
1184              
1185             }
1186             else {
1187 4345 100       28491 if ($char!~m/[\=\"\}\{\(\)\s\n]/) {
    50          
    100          
    100          
    50          
    100          
    100          
1188 149         307 $self->storeComment;
1189 149         685 $self->{TREE}=$tree."->".$i++;
1190 149         494 push @result,$self->getSingleValue($char);
1191 149 100       358 push @{$$self{References}},\$result[-1] if refe $result[-1];
  73         314  
1192             }
1193             elsif ($char eq "=") {
1194 0         0 $self->warn("What's a \"$char\" doing here?");
1195             }
1196             elsif ($char eq "\"") {
1197 691         1580 $in=1;
1198             }
1199             elsif ($char eq "{") {
1200 40         97 $self->storeComment;
1201 40         148 $self->{TREE}=$tree."->".$i++;
1202 40         75 my $res={};
1203 40         171 $res=$self->parsMap();
1204 40         160 $$self{Ref}->{$self->{TREE}}=$res;
1205 40         152 push @result,$res;
1206             }
1207             elsif ($char eq "}") {
1208 0         0 $self->warn("What's a \"$char\" doing here?");
1209             }
1210             elsif ($char eq "(") {
1211 80         184 $self->storeComment;
1212 80         298 $self->{TREE}=$tree."->".$i++;
1213 80         149 my $res=[];
1214 80         245 $res=$self->parsList();
1215 80         299 $$self{Ref}->{$self->{TREE}}=$res;
1216 80         250 push @result,$res;
1217             }
1218             elsif ($char eq ")") {
1219 240         526 $self->storeComment;
1220 240         422 $self->{TREE}=$tree;
1221 240 100       620 return Data::Sofu::List->new(\@result) if $self->{OBJECT};
1222 222         697 return \@result;
1223             }
1224             }
1225             }
1226 0         0 $self->warn ("Unexpected EOF");
1227 0 0       0 push @result,$cur if ($cur ne "");
1228 0 0       0 return Data::Sofu::List->new(\@result) if $self->{OBJECT};
1229 0         0 return \@result;
1230             }
1231             sub Sofukeyescape { #Other escaping (can be parsed faster and is Sofu 0.1 compatible)
1232 1341     1341 0 2570 my $key=shift;
1233 1341 50       3356 return "" unless defined $key;
1234 1341 50       2831 return "<>" unless $key;
1235 1341         4784 $key=~s/([[:^print:]\s\<\>\=\"\}\{\(\)])/sprintf("\<\%x\>",ord($1))/eg;
  149         4713  
1236 1341         4890 return $key;
1237             }
1238              
1239             sub Sofukeyunescape { #Other escaping (can be parsed faster)
1240 370     370 0 525 my $key=shift;
1241 370 50       738 return "" if $key eq "<>";
1242 370 50       663 return undef if $key eq "";
1243 370         995 $key=~s/\<([0-9abcdef]*)\>/chr(hex($1))/egi;
  42         330  
1244 370         963 return $key;
1245             }
1246             sub keyescape { #Other escaping (can be parsed faster and is Sofu 0.1 compatible)
1247 225     225 0 283 my $self=shift;
1248 225         411 return Sofukeyescape(@_);
1249             }
1250              
1251             sub keyunescape { #Other escaping (can be parsed faster)
1252 360     360 0 574 my $self=shift;
1253 360         745 return Sofukeyunescape(@_);
1254             }
1255              
1256             sub packBinary {
1257 8     8 0 19 my $self=shift;
1258 8         95 require Data::Sofu::Binary;
1259 8 50       30 $bdriver = Data::Sofu::Binary->new() unless $bdriver;
1260 8         54 return $bdriver->pack(@_);
1261             }
1262              
1263             sub writeML {
1264 2     2 1 4 my $self=shift;
1265 2         2 my $file=shift;
1266 2         3 my $fh;
1267 2         895 require Data::Sofu::SofuML;
1268 2 100       16 $mldriver = Data::Sofu::SofuML->new() unless $mldriver;
1269 2 50       14 unless (ref $file) {
    50          
    0          
1270 0 0       0 open $fh,">:encoding(UTF-8)",$file or die "Sofu error open: $$self{CurFile} file: $!";
1271             }
1272             elsif (ref $file eq "SCALAR") {
1273 2 50   1   52 open $fh,">:utf8",$file or die "Can't open perlIO: $!";
  1         10  
  1         3  
  1         10  
1274             }
1275             elsif (ref $file eq "GLOB") {
1276 0         0 $fh=$file;
1277             }
1278             else {
1279 0         0 $self->warn("The argument to writeML has to be a filename, reference to a scalar or filehandle");
1280 0         0 return;
1281             }
1282 2         1270 binmode $fh;
1283 2         9 print $fh $mldriver->pack(@_);
1284             #$fh goes out of scope here!
1285             }
1286              
1287             sub packML {
1288 2     2 1 13 require Data::Sofu::SofuML;
1289 2         4 my $self=shift;
1290 2 50       7 $mldriver = Data::Sofu::SofuML->new() unless $mldriver;
1291 2         5 $mldriver->{INDENT} = "";
1292 2         7 my $a=$mldriver->pack(@_);
1293 2         6 $mldriver->{INDENT} = "\t";
1294 2         10 return $a;
1295             }
1296              
1297             sub writeBinary {
1298 44     44 1 187 my $self=shift;
1299 44         83 my $file=shift;
1300 44         69 my $fh;
1301 44         3500 require Data::Sofu::Binary;
1302 44 100       238 $bdriver = Data::Sofu::Binary->new() unless $bdriver;
1303 44 100       191 unless (ref $file) {
    50          
    0          
1304 36 50       27591 open $fh,">:raw",$file or die "Sofu error open: $$self{CurFile} file: $!";
1305             }
1306             elsif (ref $file eq "SCALAR") {
1307 8 50       223 open $fh,">",$file or die "Can't open perlIO: $!";
1308             }
1309             elsif (ref $file eq "GLOB") {
1310 0         0 $fh=$file;
1311             }
1312             else {
1313 0         0 $self->warn("The argument to writeBinary has to be a filename, reference to a scalar or filehandle");
1314 0         0 return;
1315             }
1316 44         298 binmode $fh;
1317 44         350 print $fh $bdriver->pack(@_);
1318             #$fh goes out of scope here!
1319             }
1320              
1321             =head1 NAME
1322              
1323             Data::Sofu - Perl extension for Sofu data
1324              
1325             =head1 Synopsis
1326              
1327             use Data::Sofu;
1328             %hash=readSofu("file.sofu");
1329             ...
1330             writeSofu("file.sofu",\%hash);
1331            
1332             Or a litte more complex:
1333             use Data::Sofu qw/packSofu unpackSofu/;
1334             %hash=readSofu("file.sofu");
1335             $comments=getSofucomments;
1336             open fh,">:UTF16-LE","file.sofu";
1337             writeSofu(\*fh,\$hash,$comments);
1338             close fh;
1339             $texta=packSofu($arrayref);
1340             $texth=packSofu($hashref);
1341             $arrayref=unpackSofu($texta);
1342             $arrayhash=unpackSofu($texth);
1343              
1344             =head1 Synopsis - oo-style
1345              
1346             require Data::Sofu;
1347             my $sofu=new Sofu;
1348             %hash=$sofu->read("file.sofu");
1349             $comments=$sofu->comments;
1350             $sofu->write("file.sofu",$hashref);
1351             open fh,">:UTF16-LE",file.sofu";
1352             $sofu->write(\*fh,$hashref,$comments);
1353             close fh;
1354             $texta=$sofu->pack($arrayref);
1355             $texth=$sofu->pack($hashref);
1356             $arrayref=$sofu->unpack($texta);
1357             $arrayhash=$sofu->unpack($texth);
1358              
1359             =head1 DESCRIPTION
1360              
1361             This Module provides the ability to read and write sofu files of the versions 0.1 and 0.2. Visit L for a description about sofu.
1362              
1363             It can also read not-so-wellformed sofu files and correct their errors.
1364              
1365             Additionally it provides the ability to pack HASHes and ARRAYs to sofu strings and unpack those.
1366              
1367             The comments in a sofu file can be preserved if they're saved with $sofu->comment or getSofucomments or if loadFile/load is used.
1368              
1369             It also provides a compatibility layer for sofud via Data::Sofu::Object and Data::Sofu->loadFile();
1370              
1371             Data::Sofu::Binary provides an experimental interface to Binary Sofu (.bsofu) files and streams.
1372              
1373             =head1 SYNTAX
1374              
1375             This module can either be called using object-orientated notation or using the funtional interface.
1376              
1377             Some features are only avaiable when using OO.
1378              
1379             =head1 FUNCTIONS
1380              
1381             =head2 getSofucomments()
1382              
1383             Gets the comments of the last file read
1384              
1385             =head2 writeSofu(FILE,DATA,[COMMENTS])
1386              
1387             Writes a sofu file with the name FILE.
1388              
1389             FILE can be:
1390              
1391             A reference to a filehandle with the right encoding set or
1392              
1393             a filename or
1394              
1395             a reference to a scalar (Data will be read from a scalar)
1396              
1397             An existing file of this name will be overwritten.
1398              
1399             DATA can be a scalar, a hashref or an arrayref.
1400              
1401             The top element of sofu files must be a hash, so any other datatype is converted to {Value=>DATA}.
1402            
1403             @a=(1,2,3);
1404             $sofu->write("Test.sofu",\@a);
1405             %data=$sofu->read("Test.sofu");
1406             @a=@{$data->{Value}}; # (1,2,3)
1407              
1408             COMMENTS is a reference to hash with comments like the one retuned by comments()
1409              
1410             =head2 readSofu(FILE)
1411              
1412             Reads the sofu file FILE and returns a hash with the data.
1413              
1414             FILE can be:
1415              
1416             A reference to a filehandle with the right encoding set or
1417              
1418             a filename or
1419              
1420             a reference to a scalar (Data will be read from a scalar)
1421              
1422              
1423             These methods are not exported by default:
1424              
1425             =head2 loadSofu(FILE)
1426              
1427             Reads a .sofu file and converts it to Sofud compatible objects
1428              
1429             FILE can be:
1430              
1431             A reference to a filehandle with the right encoding set or
1432              
1433             a filename or
1434              
1435             a reference to a scalar (Data will be read from a scalar)
1436              
1437              
1438             Returns a C
1439              
1440             =head2 packSofu(DATA,[COMMENTS])
1441              
1442             Packs DATA to a sofu string.
1443              
1444             DATA can be a scalar, a hashref or an arrayref.
1445              
1446             This is different from a normal write(), because the lines are NOT indented and there will be placed brackets around the topmost element. (Which is not Sofu 0.2 conform, please use write(\$scalar,$data) instead).
1447              
1448             COMMENTS is a reference to hash with comments like the one retuned by comments().
1449              
1450             =head2 C
1451              
1452             This function unpacks SOFU STRING and returns a scalar, which can be either a string or a reference to a hash or a reference to an array.
1453              
1454             Can read Sofu and SofuML files but not binary Sofu files
1455              
1456             Note you can also read packed Data with readSofu(\):
1457              
1458             my $packed = packSofu($tree,$comments);
1459             my $tree2 = unpackSofu($packed);
1460             my $tree3 = readSofu(\$packed);
1461             # $tree2 has the same data as $tree3 (and $tree of course)
1462              
1463             =head2 C
1464              
1465             Writes the Data as a binary file.
1466              
1467             FILE can be:
1468              
1469             A reference to a filehandle with raw encoding set or
1470              
1471             a filename or
1472              
1473             a reference to a scalar (Data will be read from a scalar)
1474              
1475             DATA has to be a reference to a Hash or Data::Sofu::Object
1476              
1477             COMMENTS is a reference to hash with comments like the one retuned by comments
1478              
1479             More info on the other parameters in Data::Sofu::Binary
1480              
1481             To write other Datastructures use this:
1482              
1483             writeSofuBinary("1.sofu",{Value=>$data});
1484              
1485             =head2 C
1486              
1487             Writes the Data as an XML file (for postprocessing with XSLT or CSS)
1488              
1489             FILE can be:
1490              
1491             A reference to a filehandle with some encoding set or
1492              
1493             a filename or
1494              
1495             a reference to a scalar (Data will be read from a scalar)
1496              
1497             DATA has to be a reference to a Hash or Data::Sofu::Object
1498              
1499             COMMENTS is a reference to hash with comments like the one retuned by comments, only used when DATA is not a Data::Sofu::Object
1500              
1501             HEADER can be an costum file header, (defaults to C<< qq(\n\n) >> );
1502              
1503             Default output (when given a filename) is UTF-8.
1504              
1505             =head1 CLASS-METHODS
1506              
1507             =head2 loadFile(FILE)
1508              
1509             Reads a .sofu file and converts it to Sofud compatible objects.
1510              
1511             FILE can be:
1512              
1513             A reference to a filehandle with the right encoding set or
1514              
1515             a filename or
1516              
1517             a reference to a scalar (Data will be read from a scalar)
1518              
1519              
1520             Returns a C
1521              
1522             my $tree=Data::Sofu->loadFile("1.sofu");
1523             print $tree->list("Foo")->value(5);
1524             $tree->list("Foo")->appendElement(new Data::Sofu::Value(8));
1525             $tree->write("2.sofu");
1526              
1527             =head1 METHODS (OO)
1528              
1529             =head2 new()
1530              
1531             Creates a new Data::Sofu object.
1532              
1533             =head2 setIndent(INDENT)
1534              
1535             Sets the indent to INDENT. Default indent is "\t".
1536              
1537             =head2 C
1538              
1539             Enables/Disables sofu syntax warnings.
1540              
1541             =head2 comments()
1542              
1543             Gets/sets the comments of the last file read
1544              
1545             =head2 write(FILE,DATA,[COMMENTS])
1546              
1547             Writes a sofu file with the name FILE.
1548              
1549             FILE can be:
1550              
1551             A reference to a filehandle with the right encoding set or
1552              
1553             a filename or
1554              
1555             a reference to a scalar (Data will be read from a scalar)
1556              
1557             An existing file of this name will be overwritten.
1558              
1559             DATA can be a scalar, a hashref or an arrayref.
1560              
1561             The top element of sofu files must be a hash, so any other datatype is converted to {Value=>DATA}.
1562            
1563             @a=(1,2,3);
1564             $sofu->write("Test.sofu",\@a);
1565             %data=$sofu->read("Test.sofu");
1566             @a=@{$data->{Value}}; # (1,2,3)
1567              
1568             COMMENTS is a reference to hash with comments like the one retuned by comments()
1569              
1570             =head2 read(FILE)
1571              
1572             Reads the sofu file FILE and returns a hash with the data.
1573              
1574             FILE can be:
1575              
1576             A reference to a filehandle with the right encoding set or
1577              
1578             a filename or
1579              
1580             a reference to a scalar (Data will be read from a scalar)
1581              
1582              
1583             =head2 C
1584              
1585             Packs DATA to a sofu string.
1586              
1587             DATA can be a scalar, a hashref or an arrayref.
1588              
1589             COMMENTS is a reference to hash with comments like the one retuned by comments
1590              
1591             This is different from a normal write(), because the lines are NOT indented and there will be placed brackets around the topmost element. (Which is not Sofu 0.2 conform, please use write(\$scalar,$data) instead).
1592              
1593             =head2 C
1594              
1595             This function unpacks SOFU STRING and returns a scalar, which can be either a string or a reference to a hash or a reference to an array.
1596              
1597             =head2 load(FILE)
1598              
1599             Reads a .sofu file and converts it to Sofud compatible objects
1600              
1601             FILE can be:
1602              
1603             A reference to a filehandle with the right encoding set or
1604              
1605             a filename or
1606              
1607             a reference to a scalar (Data will be read from a scalar)
1608              
1609             Returns a C
1610              
1611             =head2 C
1612              
1613             Builds a Sofu Object Tree from a perl data structure
1614              
1615             DATA can be a scalar, a hashref or an arrayref.
1616              
1617             COMMENTS is a reference to hash with comments like the one retuned by comments
1618              
1619             Returns a C
1620              
1621             =head2 C
1622              
1623             Writes the Data as a binary file.
1624              
1625             FILE can be:
1626              
1627             A reference to a filehandle with raw encoding set or
1628              
1629             a filename or
1630              
1631             a reference to a scalar (Data will be read from a scalar)
1632              
1633             DATA has to be a reference to a Hash or Data::Sofu::Object
1634              
1635             COMMENTS is a reference to hash with comments like the one retuned by comments
1636              
1637             More info on the other parameters in C
1638              
1639             To write other Datastructures use this:
1640              
1641             $sofu->writeBinary("1.sofu",{Value=>$data});
1642              
1643             =head2 C
1644              
1645             Writes the Data as an XML file (for postprocessing with XSLT or CSS)
1646              
1647             FILE can be:
1648              
1649             A reference to a filehandle with some encoding set or
1650              
1651             a filename or
1652              
1653             a reference to a scalar (Data will be read from a scalar)
1654              
1655             DATA has to be a reference to a Hash or Data::Sofu::Object
1656              
1657             COMMENTS is a reference to hash with comments like the one retuned by comments, only used when DATA is not a Data::Sofu::Object
1658              
1659             HEADER can be an costum file header, (defaults to C<< qq(\n\n) >> );
1660              
1661             Default output (when given a filename) is UTF-8.
1662              
1663             =head2 packML (DATA, COMMENTS,[HEADER])
1664              
1665             Returns DATA as an XML file (for postprocessing with XSLT or CSS) with no Indentation
1666              
1667             DATA has to be a reference to a Hash or Data::Sofu::Object
1668              
1669             COMMENTS is a reference to hash with comments like the one retuned by comments, only used when DATA is not a Data::Sofu::Object
1670              
1671             HEADER can be an costum file header, (defaults to C<< qq(\n\n) >> );
1672              
1673             Those are not (quite) the same:
1674              
1675             $string = $sofu->packML($tree,$comments) #Will not indent.
1676             $sofu->writeML(\$string,$tree,$comments)# Will indent.
1677              
1678             =head1 CHANGES
1679              
1680             Kyes are now automatically escaped according to the new sofu specification.
1681              
1682             Double used references will now be converted to Sofu-References.
1683              
1684             read, load, readSofu, loadSofu and Data::Sofu::loaFile now detect binary sofu (and load Data::Sofu::Binary)
1685              
1686             read, load, readSofu, loadSofu, Data::Sofu::loaFile, unpackSofu and unpack detect SofuML (and load Data::Sofu::SofuML)
1687              
1688             =head1 BUGS
1689              
1690             Comments written after an object will be rewritten at the top of an object:
1691              
1692             foo = { # Comment1
1693             Bar = "Baz"
1694             } # Comment2
1695              
1696             will get to:
1697              
1698             foo = { # Comment1
1699             # Comment 2
1700             Bar = "Baz"
1701             }
1702              
1703              
1704             =head1 NOTE on Unicode
1705              
1706             Sofu File are normally written in a Unicode format. C is trying to guess which format to read (usually works, thanks to Encode::Guess).
1707              
1708             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...
1709              
1710             open my $fh,">:encoding(latin1)","out.sofu";
1711             writeSofu($fh,$data);
1712              
1713             Warning: UTF32 BE is not supported without BOM (looks too much like Binary);
1714              
1715             Notes:
1716              
1717             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:
1718              
1719             open my $fh,">:raw:encoding(UTF-16):crlf:utf8","out.sofu" #Write Windows UTF-16 Files
1720             open my $fh,">:raw:encoding(UTF-16)","out.sofu" #Write Unix UTF-16 Files
1721             #Same goes for UTF32
1722            
1723             #UTF-8: Don't use :utf8 or :raw:utf8 alone here,
1724             #Perl has a different understanding of utf8 and UTF-8 (utf8 allows some errors).
1725             open my $fh,">:raw:encoding(UTF-8)","out.sofu" #Unix style UTF-8
1726             open my $fh,">:raw:encoding(UTF-8):crlf:utf8","out.sofu" #Windows style UTF-8
1727              
1728             #And right after open():
1729             print $fh chr(65279); #Print UTF-8 Byte Order Mark (Some programs want it, some programs die on it...)
1730            
1731             One last thing:
1732              
1733             open my $out,">:raw:encoding(UTF-16BE):crlf:utf8","out.sofu";
1734             print $out chr(65279); #Byte Order Mark
1735             #Now you can write out UTF16 with BOM in BigEndian (even if you machine in Little Endian)
1736              
1737              
1738             =head1 SEE ALSO
1739              
1740             perl(1),L
1741              
1742             For Sofud compatible Object Notation: L
1743              
1744             For Sofu Binary: L
1745              
1746             For SofuML L
1747              
1748             =cut
1749              
1750             1;
1751