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   756524 use strict;
  42         173  
  42         1204  
2 42     42   203 use warnings;
  42         92  
  42         2016  
3             package YAML::PP::Common;
4              
5             our $VERSION = '0.036'; # VERSION
6              
7 42     42   310 use base 'Exporter';
  42         76  
  42         11382  
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         54027 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   337 };
  42         112  
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 5698     5698 1 42168 my ($event, $args) = @_;
68 5698         8556 my $ev = $event->{name};
69 5698         7277 my $string;
70 5698         7908 my $content = $event->{value};
71              
72 5698         7454 my $properties = '';
73 5698 100       10910 $properties .= " &$event->{anchor}" if defined $event->{anchor};
74 5698 100       10193 $properties .= " <$event->{tag}>" if defined $event->{tag};
75              
76 5698 100       21111 if ($ev eq 'document_start_event') {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
77 332         468 $string = "+DOC";
78 332 100       828 $string .= " ---" unless $event->{implicit};
79             }
80             elsif ($ev eq 'document_end_event') {
81 327         475 $string = "-DOC";
82 327 100       689 $string .= " ..." unless $event->{implicit};
83             }
84             elsif ($ev eq 'stream_start_event') {
85 267         400 $string = "+STR";
86             }
87             elsif ($ev eq 'stream_end_event') {
88 260         363 $string = "-STR";
89             }
90             elsif ($ev eq 'mapping_start_event') {
91 591         805 $string = "+MAP";
92 591 100 66     1574 if ($event->{style} and $event->{style} eq YAML_FLOW_MAPPING_STYLE) {
93 175 100       399 $string .= ' {}' if $args->{flow};
94             }
95 591         931 $string .= $properties;
96 591         691 if (0) {
97             # doesn't match yaml-test-suite format
98             }
99             }
100             elsif ($ev eq 'sequence_start_event') {
101 557         792 $string = "+SEQ";
102 557 100 66     1575 if ($event->{style} and $event->{style} eq YAML_FLOW_SEQUENCE_STYLE) {
103 198 100       476 $string .= ' []' if $args->{flow};
104             }
105 557         951 $string .= $properties;
106 557         685 if (0) {
107             # doesn't match yaml-test-suite format
108             }
109             }
110             elsif ($ev eq 'mapping_end_event') {
111 588         883 $string = "-MAP";
112             }
113             elsif ($ev eq 'sequence_end_event') {
114 557         813 $string = "-SEQ";
115             }
116             elsif ($ev eq 'scalar_event') {
117 2189         2977 $string = '=VAL';
118 2189         3727 $string .= $properties;
119              
120 2189         3985 $content =~ s/\\/\\\\/g;
121 2189         3304 $content =~ s/\t/\\t/g;
122 2189         3119 $content =~ s/\r/\\r/g;
123 2189         3068 $content =~ s/\n/\\n/g;
124 2189         2873 $content =~ s/[\b]/\\b/g;
125              
126             $string .= ' '
127             . $scalar_style_to_string{ $event->{style} }
128 2189         4948 . $content;
129             }
130             elsif ($ev eq 'alias_event') {
131 30         67 $string = "=ALI *$content";
132             }
133 5698         16044 return $string;
134             }
135              
136             sub test_suite_to_event {
137 30     30 1 118 my ($str) = @_;
138 30         45 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         3 $event->{name} = 'document_start_event';
147 1 50       5 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         3 $event->{name} = 'document_end_event';
156 1 50       3 if ($str =~ s/^ \.\.\.//) {
157 0         0 $event->{implicit} = 0;
158             }
159             else {
160 1         2 $event->{implicit} = 1;
161             }
162             }
163             elsif ($str =~ s/^\+SEQ//) {
164 3         7 $event->{name} = 'sequence_start_event';
165 3 50       10 if ($str =~ s/^ \&(\S+)//) {
166 0         0 $event->{anchor} = $1;
167             }
168 3 100       12 if ($str =~ s/^ <(\S+)>//) {
169 1         4 $event->{tag} = $1;
170             }
171             }
172             elsif ($str =~ s/^\-SEQ//) {
173 3         7 $event->{name} = 'sequence_end_event';
174             }
175             elsif ($str =~ s/^\+MAP//) {
176 5         11 $event->{name} = 'mapping_start_event';
177 5 100       13 if ($str =~ s/^ \&(\S+)//) {
178 1         9 $event->{anchor} = $1;
179             }
180 5 100       18 if ($str =~ s/^ <(\S+)>//) {
181 2         17 $event->{tag} = $1;
182             }
183             }
184             elsif ($str =~ s/^\-MAP//) {
185 5         10 $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       15 if ($str =~ s/^ [:'">|]//) {
193 4         9 $event->{style} = $1;
194             }
195 4 50       13 if ($str =~ s/^(.*)//) {
196 4         9 $event->{value} = $1;
197             }
198             }
199             elsif ($str =~ s/^=ALI//) {
200 6         13 $event->{name} = 'alias_event';
201 6 50       19 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         65 return $event;
209             }
210              
211              
212             1;
213              
214             __END__