1# ABSTRACT: Construct data structure from Parser Events 2use strict; 3use warnings; 4package YAML::PP::Constructor; 5 6our $VERSION = '0.020'; # VERSION 7 8use YAML::PP; 9use Scalar::Util qw/ reftype /; 10 11use constant DEBUG => ($ENV{YAML_PP_LOAD_DEBUG} or $ENV{YAML_PP_LOAD_TRACE}) ? 1 : 0; 12use constant TRACE => $ENV{YAML_PP_LOAD_TRACE} ? 1 : 0; 13 14my %cyclic_refs = qw/ allow 1 ignore 1 warn 1 fatal 1 /; 15 16sub new { 17 my ($class, %args) = @_; 18 19 my $default_yaml_version = delete $args{default_yaml_version}; 20 my $cyclic_refs = delete $args{cyclic_refs} || 'allow'; 21 die "Invalid value for cyclic_refs: $cyclic_refs" 22 unless $cyclic_refs{ $cyclic_refs }; 23 my $schemas = delete $args{schemas}; 24 25 if (keys %args) { 26 die "Unexpected arguments: " . join ', ', sort keys %args; 27 } 28 29 my $self = bless { 30 default_yaml_version => $default_yaml_version, 31 schemas => $schemas, 32 cyclic_refs => $cyclic_refs, 33 }, $class; 34 $self->init; 35 return $self; 36} 37 38sub clone { 39 my ($self) = @_; 40 my $clone = { 41 schemas => $self->{schemas}, 42 schema => $self->{schema}, 43 default_yaml_version => $self->{default_yaml_version}, 44 cyclic_refs => $self->cyclic_refs, 45 }; 46 return bless $clone, ref $self; 47} 48 49sub init { 50 my ($self) = @_; 51 $self->set_docs([]); 52 $self->set_stack([]); 53 $self->set_anchors({}); 54 $self->set_yaml_version($self->default_yaml_version); 55 $self->set_schema($self->schemas->{ $self->yaml_version } ); 56} 57 58sub docs { return $_[0]->{docs} } 59sub stack { return $_[0]->{stack} } 60sub anchors { return $_[0]->{anchors} } 61sub set_docs { $_[0]->{docs} = $_[1] } 62sub set_stack { $_[0]->{stack} = $_[1] } 63sub set_anchors { $_[0]->{anchors} = $_[1] } 64sub schemas { return $_[0]->{schemas} } 65sub schema { return $_[0]->{schema} } 66sub set_schema { $_[0]->{schema} = $_[1] } 67sub cyclic_refs { return $_[0]->{cyclic_refs} } 68sub set_cyclic_refs { $_[0]->{cyclic_refs} = $_[1] } 69sub yaml_version { return $_[0]->{yaml_version} } 70sub set_yaml_version { $_[0]->{yaml_version} = $_[1] } 71sub default_yaml_version { return $_[0]->{default_yaml_version} } 72 73sub document_start_event { 74 my ($self, $event) = @_; 75 my $stack = $self->stack; 76 if ($event->{version_directive}) { 77 my $version = $event->{version_directive}; 78 if ($self->{schemas}->{ $version }) { 79 $self->set_yaml_version($version); 80 $self->set_schema($self->schemas->{ $version }); 81 } 82 else { 83 $self->set_yaml_version($self->default_yaml_version); 84 $self->set_schema($self->schemas->{ $self->default_yaml_version }); 85 } 86 } 87 my $ref = []; 88 push @$stack, { type => 'document', ref => $ref, data => $ref, event => $event }; 89} 90 91sub document_end_event { 92 my ($self, $event) = @_; 93 my $stack = $self->stack; 94 my $last = pop @$stack; 95 $last->{type} eq 'document' or die "Expected mapping, but got $last->{type}"; 96 if (@$stack) { 97 die "Got unexpected end of document"; 98 } 99 my $docs = $self->docs; 100 push @$docs, $last->{ref}->[0]; 101 $self->set_anchors({}); 102 $self->set_stack([]); 103} 104 105sub mapping_start_event { 106 my ($self, $event) = @_; 107 my ($data, $on_data) = $self->schema->create_mapping($self, $event); 108 my $ref = { 109 type => 'mapping', 110 ref => [], 111 data => $data, 112 event => $event, 113 on_data => $on_data, 114 }; 115 my $stack = $self->stack; 116 117 push @$stack, $ref; 118 if (defined(my $anchor = $event->{anchor})) { 119 $self->anchors->{ $anchor } = { data => $ref->{data} }; 120 } 121} 122 123sub mapping_end_event { 124 my ($self, $event) = @_; 125 my $stack = $self->stack; 126 127 my $last = pop @$stack; 128 my ($ref, $data) = @{ $last }{qw/ ref data /}; 129 $last->{type} eq 'mapping' or die "Expected mapping, but got $last->{type}"; 130 131 my @merge_keys; 132 my @ref; 133 for (my $i = 0; $i < @$ref; $i += 2) { 134 my $key = $ref->[ $i ]; 135 if (ref $key eq 'YAML::PP::Type::MergeKey') { 136 my $merge = $ref->[ $i + 1 ]; 137 if ((reftype($merge) || '') eq 'HASH') { 138 push @merge_keys, $merge; 139 } 140 elsif ((reftype($merge) || '') eq 'ARRAY') { 141 for my $item (@$merge) { 142 if ((reftype($item) || '') eq 'HASH') { 143 push @merge_keys, $item; 144 } 145 else { 146 die "Expected hash for merge key"; 147 } 148 } 149 } 150 else { 151 die "Expected hash or array for merge key"; 152 } 153 } 154 else { 155 push @ref, $key, $ref->[ $i + 1 ]; 156 } 157 } 158 for my $merge (@merge_keys) { 159 for my $key (keys %$merge) { 160 unless (exists $data->{ $key }) { 161 $data->{ $key } = $merge->{ $key }; 162 } 163 } 164 } 165 my $on_data = $last->{on_data} || sub { 166 my ($self, $hash, $items) = @_; 167 for (my $i = 0; $i < @$items; $i += 2) { 168 my ($key, $value) = @$items[ $i, $i + 1 ]; 169 $key = '' unless defined $key; 170 if (ref $key) { 171 $key = $self->stringify_complex($key); 172 } 173 $$hash->{ $key } = $value; 174 } 175 }; 176 $on_data->($self, \$data, \@ref); 177 push @{ $stack->[-1]->{ref} }, $data; 178 if (defined(my $anchor = $last->{event}->{anchor})) { 179 $self->anchors->{ $anchor }->{finished} = 1; 180 } 181 return; 182} 183 184sub sequence_start_event { 185 my ($self, $event) = @_; 186 my ($data, $on_data) = $self->schema->create_sequence($self, $event); 187 my $ref = { 188 type => 'sequence', 189 ref => [], 190 data => $data, 191 event => $event, 192 on_data => $on_data, 193 }; 194 my $stack = $self->stack; 195 196 push @$stack, $ref; 197 if (defined(my $anchor = $event->{anchor})) { 198 $self->anchors->{ $anchor } = { data => $ref->{data} }; 199 } 200} 201 202sub sequence_end_event { 203 my ($self, $event) = @_; 204 my $stack = $self->stack; 205 my $last = pop @$stack; 206 $last->{type} eq 'sequence' or die "Expected mapping, but got $last->{type}"; 207 my ($ref, $data) = @{ $last }{qw/ ref data /}; 208 209 my $on_data = $last->{on_data} || sub { 210 my ($self, $array, $items) = @_; 211 push @$$array, @$items; 212 }; 213 $on_data->($self, \$data, $ref); 214 push @{ $stack->[-1]->{ref} }, $data; 215 if (defined(my $anchor = $last->{event}->{anchor})) { 216 $self->anchors->{ $anchor }->{finished} = 1; 217 } 218 return; 219} 220 221sub stream_start_event {} 222 223sub stream_end_event {} 224 225sub scalar_event { 226 my ($self, $event) = @_; 227 DEBUG and warn "CONTENT $event->{value} ($event->{style})\n"; 228 my $value = $self->schema->load_scalar($self, $event); 229 if (defined (my $name = $event->{anchor})) { 230 $self->anchors->{ $name } = { data => $value, finished => 1 }; 231 } 232 my $last = $self->stack->[-1]; 233 push @{ $last->{ref} }, $value; 234} 235 236sub alias_event { 237 my ($self, $event) = @_; 238 my $value; 239 my $name = $event->{value}; 240 if (my $anchor = $self->anchors->{ $name }) { 241 # We know this is a cyclic ref since the node hasn't 242 # been constructed completely yet 243 unless ($anchor->{finished} ) { 244 my $cyclic_refs = $self->cyclic_refs; 245 if ($cyclic_refs ne 'allow') { 246 if ($cyclic_refs eq 'fatal') { 247 die "Found cyclic ref"; 248 } 249 if ($cyclic_refs eq 'warn') { 250 $anchor = { data => undef }; 251 warn "Found cyclic ref"; 252 } 253 elsif ($cyclic_refs eq 'ignore') { 254 $anchor = { data => undef }; 255 } 256 } 257 } 258 $value = $anchor->{data}; 259 } 260 my $last = $self->stack->[-1]; 261 push @{ $last->{ref} }, $value; 262} 263 264sub stringify_complex { 265 my ($self, $data) = @_; 266 require Data::Dumper; 267 local $Data::Dumper::Quotekeys = 0; 268 local $Data::Dumper::Terse = 1; 269 local $Data::Dumper::Indent = 0; 270 local $Data::Dumper::Useqq = 0; 271 local $Data::Dumper::Sortkeys = 1; 272 my $string = Data::Dumper->Dump([$data], ['data']); 273 $string =~ s/^\$data = //; 274 return $string; 275} 276 2771; 278 279__END__ 280 281=pod 282 283=encoding utf-8 284 285=head1 NAME 286 287YAML::PP::Constructor - Constructing data structure from parsing events 288 289=head1 METHODS 290 291=over 292 293=item new 294 295The Constructor constructor 296 297 my $constructor = YAML::PP::Constructor->new( 298 schema => $schema, 299 cyclic_refs => $cyclic_refs, 300 ); 301 302=item init 303 304Resets any data being used during construction. 305 306 $constructor->init; 307 308=item document_start_event, document_end_event, mapping_start_event, mapping_end_event, sequence_start_event, sequence_end_event, scalar_event, alias_event, stream_start_event, stream_end_event 309 310These methods are called from L<YAML::PP::Parser>: 311 312 $constructor->document_start_event($event); 313 314=item anchors, set_anchors 315 316Helper for storing anchors during construction 317 318=item docs, set_docs 319 320Helper for storing resulting documents during construction 321 322=item stack, set_stack 323 324Helper for storing data during construction 325 326=item cyclic_refs, set_cyclic_refs 327 328Option for controlling the behaviour when finding circular references 329 330=item schema, set_schema 331 332Holds a L<YAML::PP::Schema> object 333 334=item stringify_complex 335 336When constructing a hash and getting a non-scalar key, this method is 337used to stringify the key. 338 339It uses a terse Data::Dumper output. Other modules, like L<YAML::XS>, use 340the default stringification, C<ARRAY(0x55617c0c7398)> for example. 341 342=back 343 344=cut 345