File Coverage

blib/lib/YAML/PP/Ref/Parser.pm
Criterion Covered Total %
statement 56 58 96.5
branch 23 26 88.4
condition n/a
subroutine 9 9 100.0
pod 0 1 0.0
total 88 94 93.6


line stmt bran cond sub pod time code
1             package YAML::PP::Ref::Parser;
2 1     1   8 use strict;
  1         3  
  1         32  
3 1     1   5 use warnings;
  1         3  
  1         45  
4              
5             our $VERSION = '0.01_002'; # TRIAL VERSION
6              
7 1     1   6 use Scalar::Util qw/ openhandle /;
  1         2  
  1         43  
8 1     1   792 use YAML::Parser;
  1         81718  
  1         73  
9 1         76 use YAML::PP::Common qw(
10             YAML_PLAIN_SCALAR_STYLE
11             YAML_SINGLE_QUOTED_SCALAR_STYLE YAML_DOUBLE_QUOTED_SCALAR_STYLE
12             YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
13             YAML_BLOCK_SEQUENCE_STYLE YAML_FLOW_SEQUENCE_STYLE
14             YAML_BLOCK_MAPPING_STYLE YAML_FLOW_MAPPING_STYLE
15 1     1   12 );
  1         2  
16              
17 1     1   6 use base 'YAML::PP::Parser';
  1         2  
  1         573  
18              
19             my %style_map = (
20             plain => YAML_PLAIN_SCALAR_STYLE,
21             single => YAML_SINGLE_QUOTED_SCALAR_STYLE,
22             double => YAML_DOUBLE_QUOTED_SCALAR_STYLE,
23             literal => YAML_LITERAL_SCALAR_STYLE,
24             folded => YAML_FOLDED_SCALAR_STYLE,
25             );
26              
27             sub parse {
28 4     4 0 10762 my ($self) = @_;
29 4         17 my $reader = $self->reader;
30 4         24 my $string;
31 4 100       33 if ($reader->can('open_handle')) {
32 2 100       11 if (openhandle($reader->input)) {
33 1         8 $string = do { local $/; $reader->open_handle->getline };
  1         7  
  1         5  
34             }
35             else {
36 1     1   57 open my $fh, '<:encoding(UTF-8)', $reader->input;
  1         3  
  1         6  
  1         14  
37 1         1358 $string = do { local $/; <$fh> };
  1         6  
  1         47  
38 1         44 close $fh;
39             }
40             }
41             else {
42 2         9 $string = $reader->read;
43             }
44 4         10165 my $co = $self->receiver;
45              
46             my $cb = sub {
47 51     51   2917376 my ($info) = @_;
48             # Transform events becayse YAML::Parser uses something
49             # very differnt from libyaml and YAML::PP
50 51         180 my $event = (delete $info->{event}) . '_event';
51 51 100       233 if ($event eq 'alias_event') {
    100          
    100          
    100          
    100          
    100          
52 1         4 $info->{value} = delete $info->{name};
53             }
54             elsif ($event eq 'scalar_event') {
55 16         45 my $style = $style_map{ $info->{style} };
56 16         32 $info->{style} = $style;
57             }
58             elsif ($event eq 'document_start_event') {
59 4 50       19 $info->{implicit} = delete $info->{explicit} ? 0 : 1;
60             }
61             elsif ($event eq 'document_end_event') {
62 4 100       14 $info->{implicit} = delete $info->{explicit} ? 0 : 1;
63             }
64             elsif ($event eq 'sequence_start_event') {
65 4 50       16 if (delete $info->{flow}) {
66 4         38 $info->{style} = YAML_FLOW_SEQUENCE_STYLE;
67             }
68             else {
69 0         0 $info->{style} = YAML_BLOCK_SEQUENCE_STYLE;
70             }
71             }
72             elsif ($event eq 'mapping_start_event') {
73 5 100       18 if (delete $info->{flow}) {
74 1         10 $info->{style} = YAML_FLOW_MAPPING_STYLE;
75             }
76             else {
77 4         34 $info->{style} = YAML_BLOCK_MAPPING_STYLE;
78             }
79             }
80 51         160 $info->{name} = $event;
81 51 50       110 if (ref $co eq 'CODE') {
82 0         0 $co->($self, $event, $info);
83             }
84             else {
85 51         261 return $co->$event($info);
86             }
87 4         46 };
88 4         45 my $refrec = PerlYamlReferenceParserReceiver->new(
89             callback => $cb,
90             );
91 4         75 my $p = YAML::Parser->new(receiver => $refrec);
92 4         73 $p->parse($string);
93             }
94              
95             1;