File Coverage

blib/lib/YAML/PP/Common.pm
Criterion Covered Total %
statement 81 85 95.2
branch 68 76 89.4
condition 4 6 66.6
subroutine 6 6 100.0
pod 2 2 100.0
total 161 175 92.0


line stmt bran cond sub pod time code
1 42     42   756184 use strict;
  42         173  
  42         1229  
2 42     42   213 use warnings;
  42         82  
  42         1989  
3             package YAML::PP::Common;
4              
5             our $VERSION = '0.036_002'; # TRIAL VERSION
6              
7 42     42   280 use base 'Exporter';
  42         86  
  42         11058  
8              
9             my @p = qw/
10             PRESERVE_ALL PRESERVE_ORDER PRESERVE_SCALAR_STYLE PRESERVE_FLOW_STYLE
11             PRESERVE_ALIAS
12             /;
13             my @s = qw/
14             YAML_ANY_SCALAR_STYLE YAML_PLAIN_SCALAR_STYLE
15             YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE
16             YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
17             YAML_QUOTED_SCALAR_STYLE
18              
19             YAML_ANY_SEQUENCE_STYLE
20             YAML_BLOCK_SEQUENCE_STYLE YAML_FLOW_SEQUENCE_STYLE
21              
22             YAML_ANY_MAPPING_STYLE
23             YAML_BLOCK_MAPPING_STYLE YAML_FLOW_MAPPING_STYLE
24             /;
25             our @EXPORT_OK = (@s, @p);
26              
27             our %EXPORT_TAGS = (
28             PRESERVE => [@p],
29             STYLES => [@s],
30             );
31              
32             use constant {
33 42         54266 YAML_ANY_SCALAR_STYLE => 0,
34             YAML_PLAIN_SCALAR_STYLE => 1,
35             YAML_SINGLE_QUOTED_SCALAR_STYLE => 2,
36             YAML_DOUBLE_QUOTED_SCALAR_STYLE => 3,
37             YAML_LITERAL_SCALAR_STYLE => 4,
38             YAML_FOLDED_SCALAR_STYLE => 5,
39             YAML_QUOTED_SCALAR_STYLE => 'Q', # deprecated
40              
41             YAML_ANY_SEQUENCE_STYLE => 0,
42             YAML_BLOCK_SEQUENCE_STYLE => 1,
43             YAML_FLOW_SEQUENCE_STYLE => 2,
44              
45             YAML_ANY_MAPPING_STYLE => 0,
46             YAML_BLOCK_MAPPING_STYLE => 1,
47             YAML_FLOW_MAPPING_STYLE => 2,
48              
49             PRESERVE_ORDER => 2,
50             PRESERVE_SCALAR_STYLE => 4,
51             PRESERVE_FLOW_STYLE => 8,
52             PRESERVE_ALIAS => 16,
53              
54             PRESERVE_ALL => 31,
55 42     42   365 };
  42         98  
56              
57             my %scalar_style_to_string = (
58             YAML_PLAIN_SCALAR_STYLE() => ':',
59             YAML_SINGLE_QUOTED_SCALAR_STYLE() => "'",
60             YAML_DOUBLE_QUOTED_SCALAR_STYLE() => '"',
61             YAML_LITERAL_SCALAR_STYLE() => '|',
62             YAML_FOLDED_SCALAR_STYLE() => '>',
63             );
64              
65              
66             sub event_to_test_suite {
67 48327     48327 1 373657 my ($event, $args) = @_;
68 48327         77892 my $ev = $event->{name};
69 48327         61549 my $string;
70 48327         73404 my $content = $event->{value};
71              
72 48327         65415 my $properties = '';
73 48327 100       95495 $properties .= " &$event->{anchor}" if defined $event->{anchor};
74 48327 100       86478 $properties .= " <$event->{tag}>" if defined $event->{tag};
75              
76 48327 100       177764 if ($ev eq 'document_start_event') {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
77 4610         6633 $string = "+DOC";
78 4610 100       10533 $string .= " ---" unless $event->{implicit};
79             }
80             elsif ($ev eq 'document_end_event') {
81 4524         6135 $string = "-DOC";
82 4524 100       9027 $string .= " ..." unless $event->{implicit};
83             }
84             elsif ($ev eq 'stream_start_event') {
85 4198         6253 $string = "+STR";
86             }
87             elsif ($ev eq 'stream_end_event') {
88 4102         6228 $string = "-STR";
89             }
90             elsif ($ev eq 'mapping_start_event') {
91 4049         5941 $string = "+MAP";
92 4049 100 66     10448 if ($event->{style} and $event->{style} eq YAML_FLOW_MAPPING_STYLE) {
93 1029 100       2250 $string .= ' {}' if $args->{flow};
94             }
95 4049         6641 $string .= $properties;
96 4049         5045 if (0) {
97             # doesn't match yaml-test-suite format
98             }
99             }
100             elsif ($ev eq 'sequence_start_event') {
101 2628         3884 $string = "+SEQ";
102 2628 100 66     7376 if ($event->{style} and $event->{style} eq YAML_FLOW_SEQUENCE_STYLE) {
103 734 100       1692 $string .= ' []' if $args->{flow};
104             }
105 2628         4574 $string .= $properties;
106 2628         3460 if (0) {
107             # doesn't match yaml-test-suite format
108             }
109             }
110             elsif ($ev eq 'mapping_end_event') {
111 3998         5899 $string = "-MAP";
112             }
113             elsif ($ev eq 'sequence_end_event') {
114 2604         4148 $string = "-SEQ";
115             }
116             elsif ($ev eq 'scalar_event') {
117 17303         25657 $string = '=VAL';
118 17303         28539 $string .= $properties;
119              
120 17303         38164 $content =~ s/\\/\\\\/g;
121 17303         30245 $content =~ s/\t/\\t/g;
122 17303         25108 $content =~ s/\r/\\r/g;
123 17303         26887 $content =~ s/\n/\\n/g;
124 17303         24126 $content =~ s/[\b]/\\b/g;
125              
126             $string .= ' '
127             . $scalar_style_to_string{ $event->{style} }
128 17303         42793 . $content;
129             }
130             elsif ($ev eq 'alias_event') {
131 311         636 $string = "=ALI *$content";
132             }
133 48327         140911 return $string;
134             }
135              
136             sub test_suite_to_event {
137 30     30 1 119 my ($str) = @_;
138 30         43 my $event = {};
139 30 100       223 if ($str =~ s/^\+STR//) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
140 1         3 $event->{name} = 'stream_start_event';
141             }
142             elsif ($str =~ s/^\-STR//) {
143 1         2 $event->{name} = 'stream_end_event';
144             }
145             elsif ($str =~ s/^\+DOC//) {
146 1         4 $event->{name} = 'document_start_event';
147 1 50       4 if ($str =~ s/^ ---//) {
148 1         3 $event->{implicit} = 0;
149             }
150             else {
151 0         0 $event->{implicit} = 1;
152             }
153             }
154             elsif ($str =~ s/^\-DOC//) {
155 1         6 $event->{name} = 'document_end_event';
156 1 50       3 if ($str =~ s/^ \.\.\.//) {
157 0         0 $event->{implicit} = 0;
158             }
159             else {
160 1         3 $event->{implicit} = 1;
161             }
162             }
163             elsif ($str =~ s/^\+SEQ//) {
164 3         8 $event->{name} = 'sequence_start_event';
165 3 50       8 if ($str =~ s/^ \&(\S+)//) {
166 0         0 $event->{anchor} = $1;
167             }
168 3 100       10 if ($str =~ s/^ <(\S+)>//) {
169 1         4 $event->{tag} = $1;
170             }
171             }
172             elsif ($str =~ s/^\-SEQ//) {
173 3         6 $event->{name} = 'sequence_end_event';
174             }
175             elsif ($str =~ s/^\+MAP//) {
176 5         12 $event->{name} = 'mapping_start_event';
177 5 100       14 if ($str =~ s/^ \&(\S+)//) {
178 1         4 $event->{anchor} = $1;
179             }
180 5 100       15 if ($str =~ s/^ <(\S+)>//) {
181 2         6 $event->{tag} = $1;
182             }
183             }
184             elsif ($str =~ s/^\-MAP//) {
185 5         12 $event->{name} = 'mapping_end_event';
186             }
187             elsif ($str =~ s/^=VAL//) {
188 4         10 $event->{name} = 'scalar_event';
189 4 100       12 if ($str =~ s/^ <(\S+)>//) {
190 1         3 $event->{tag} = $1;
191             }
192 4 50       13 if ($str =~ s/^ [:'">|]//) {
193 4         10 $event->{style} = $1;
194             }
195 4 50       12 if ($str =~ s/^(.*)//) {
196 4         10 $event->{value} = $1;
197             }
198             }
199             elsif ($str =~ s/^=ALI//) {
200 6         12 $event->{name} = 'alias_event';
201 6 50       22 if ($str =~ s/^ \*(.*)//) {
202 6         18 $event->{value} = $1;
203             }
204             }
205             else {
206 0         0 die "Could not parse event '$str'";
207             }
208 30         53 return $event;
209             }
210              
211              
212             1;
213              
214             __END__