File Coverage

blib/lib/YAML/PP/Emitter.pm

Criterion	Covered	Total	%
statement	545	566	96.2
branch	351	378	92.8
condition	91	92	98.9
subroutine	36	37	97.3
pod	17	25	68.0
total	1040	1098	94.7

use strict;
use warnings;
package YAML::PP::Emitter;

our $VERSION = '0.036_002'; # TRIAL VERSION
use Data::Dumper;

use YAML::PP::Common qw/
    YAML_PLAIN_SCALAR_STYLE YAML_SINGLE_QUOTED_SCALAR_STYLE
    YAML_DOUBLE_QUOTED_SCALAR_STYLE
    YAML_LITERAL_SCALAR_STYLE YAML_FOLDED_SCALAR_STYLE
    YAML_FLOW_SEQUENCE_STYLE YAML_FLOW_MAPPING_STYLE
/;

use constant DEBUG => $ENV{YAML_PP_EMIT_DEBUG} ? 1 : 0;
use constant DEFAULT_WIDTH => 80;

sub new {
    my ($class, %args) = @_;
    my $self = bless {
        indent => $args{indent} || 2,
        writer => $args{writer},
        width => $args{width} || DEFAULT_WIDTH,
    }, $class;
    $self->init;
    return $self;
}

sub clone {
    my ($self) = @_;
    my $clone = {
        indent => $self->indent,
    };
    return bless $clone, ref $self;
}

sub event_stack { return $_[0]->{event_stack} }
sub set_event_stack { $_[0]->{event_stack} = $_[1] }
sub indent { return $_[0]->{indent} }
sub width { return $_[0]->{width} }
sub line { return $_[0]->{line} }
sub column { return $_[0]->{column} }
sub set_indent { $_[0]->{indent} = $_[1] }
sub writer { $_[0]->{writer} }
sub set_writer { $_[0]->{writer} = $_[1] }
sub tagmap { return $_[0]->{tagmap} }
sub set_tagmap { $_[0]->{tagmap} = $_[1] }

sub init {
    my ($self) = @_;
    unless ($self->writer) {
        $self->set_writer(YAML::PP::Writer->new);
    }
    $self->set_tagmap({
        'tag:yaml.org,2002:' => '!!',
    });
    $self->{open_ended} = 0;
    $self->{line} = 0;
    $self->{column} = 0;
    $self->writer->init;
}

sub mapping_start_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_start_event\n";
    my ($self, $info) = @_;
    my $stack = $self->event_stack;
    my $last = $stack->[-1];
    my $indent = $last->{indent};
    my $new_indent = $indent;
    my $yaml = '';

    my $props = '';
    my $anchor = $info->{anchor};
    my $tag = $info->{tag};
    if (defined $anchor) {
        $anchor = "&$anchor";
    }
    if (defined $tag) {
        $tag = $self->_emit_tag('map', $tag);
    }
    $props = join ' ', grep defined, ($anchor, $tag);

    my $flow = $last->{flow} || 0;
    $flow++ if ($info->{style} || 0) eq YAML_FLOW_MAPPING_STYLE;

    my $newline = 0;
    if ($flow > 1) {
        if ($last->{type} eq 'SEQ') {
            if ($last->{newline}) {
                $yaml .= ' ';
            }
            if ($last->{index} == 0) {
                $yaml .= "[";
            }
            else {
                $yaml .= ",";
            }
        }
        elsif ($last->{type} eq 'MAP') {
            if ($last->{newline}) {
                $yaml .= ' ';
            }
            if ($last->{index} == 0) {
                $yaml .= "{";
            }
            else {
                $yaml .= ",";
            }
        }
        elsif ($last->{type} eq 'MAPVALUE') {
            if ($last->{index} == 0) {
                die "Should not happen (index 0 in MAPVALUE)";
            }
            $yaml .= ": ";
        }
        if ($props) {
            $yaml .= " $props ";
        }
        $new_indent .= ' ' x $self->indent;
    }
    else {
        if ($last->{type} eq 'DOC') {
            $newline = $last->{newline};
        }
        else {
            if ($last->{newline}) {
                $yaml .= "\n";
                $last->{column} = 0;
            }
            if ($last->{type} eq 'MAPVALUE') {
                $new_indent .= ' ' x $self->indent;
                $newline = 1;
            }
            else {
                $new_indent = $indent;
                if (not $props and $self->indent == 1) {
                    $new_indent .= ' ' x 2;
                }
                else {
                    $new_indent .= ' ' x $self->indent;
                }

                if ($last->{column}) {
                    my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
                    $yaml .= $space;
                }
                else {
                    $yaml .= $indent;
                }
                if ($last->{type} eq 'SEQ') {
                    $yaml .= '-';
                }
                elsif ($last->{type} eq 'MAP') {
                    $yaml .= "?";
                    $last->{type} = 'COMPLEX';
                }
                elsif ($last->{type} eq 'COMPLEXVALUE') {
                    $yaml .= ":";
                }
                else {
                    die "Should not happen ($last->{type} in mapping_start)";
                }
                $last->{column} = 1;
            }
            $last->{newline} = 0;
        }
        if ($props) {
            $yaml .= $last->{column} ? ' ' : $indent;
            $yaml .= $props;
            $newline = 1;
        }
    }
    $self->_write($yaml);
    my $new_info = {
        index => 0, indent => $new_indent, info => $info,
        newline => $newline,
        column => $self->column,
        flow => $flow,
    };
    $new_info->{type} = 'MAP';
    push @{ $stack }, $new_info;
    $last->{index}++;
    $self->{open_ended} = 0;
}

sub mapping_end_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ mapping_end_event\n";
    my ($self, $info) = @_;
    my $stack = $self->event_stack;

    my $last = pop @{ $stack };
    if ($last->{index} == 0) {
        my $indent = $last->{indent};
        my $zero_indent = $last->{zero_indent};
        if ($last->{zero_indent}) {
            $indent .= ' ' x $self->indent;
        }
        if ($self->column) {
            $self->_write(" {}\n");
        }
        else {
            $self->_write("$indent\{}\n");
        }
    }
    elsif ($last->{flow}) {
        my $yaml = "}";
        if ($last->{flow} == 1) {
            $yaml .= "\n";
        }
        $self->_write("$yaml");
    }
    $last = $stack->[-1];
    $last->{column} = $self->column;
    if ($last->{type} eq 'SEQ') {
    }
    elsif ($last->{type} eq 'MAP') {
        $last->{type} = 'MAPVALUE';
    }
    elsif ($last->{type} eq 'MAPVALUE') {
        $last->{type} = 'MAP';
    }
    elsif ($last->{type} eq 'COMPLEX') {
        $last->{type} = 'COMPLEXVALUE';
    }
    elsif ($last->{type} eq 'COMPLEXVALUE') {
        $last->{type} = 'MAP';
    }
}

sub sequence_start_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_start_event\n";
    my ($self, $info) = @_;
    my $stack = $self->event_stack;
    my $last = $stack->[-1];
    my $indent = $last->{indent};
    my $new_indent = $indent;
    my $yaml = '';

    my $props = '';
    my $anchor = $info->{anchor};
    my $tag = $info->{tag};
    if (defined $anchor) {
        $anchor = "&$anchor";
    }
    if (defined $tag) {
        $tag = $self->_emit_tag('seq', $tag);
    }
    $props = join ' ', grep defined, ($anchor, $tag);

    my $flow = $last->{flow} || 0;
    $flow++ if $flow or ($info->{style} || 0) eq YAML_FLOW_SEQUENCE_STYLE;
    my $newline = 0;
    my $zero_indent = 0;
    if ($flow > 1) {
        if ($last->{type} eq 'SEQ') {
            if ($last->{newline}) {
                $yaml .= ' ';
            }
            if ($last->{index} == 0) {
                $yaml .= "[";
            }
            else {
                $yaml .= ",";
            }
        }
        elsif ($last->{type} eq 'MAP') {
            if ($last->{newline}) {
                $yaml .= ' ';
            }
            if ($last->{index} == 0) {
                $yaml .= "{";
            }
            else {
                $yaml .= ",";
            }
        }
        elsif ($last->{type} eq 'MAPVALUE') {
            if ($last->{index} == 0) {
                die "Should not happen (index 0 in MAPVALUE)";
            }
            $yaml .= ": ";
        }
        if ($props) {
            $yaml .= " $props ";
        }
        $new_indent .= ' ' x $self->indent;
    }
    else {
        if ($last->{type} eq 'DOC') {
            $newline = $last->{newline};
        }
        else {
            if ($last->{newline}) {
                $yaml .= "\n";
                $last->{column} = 0;
            }
            if ($last->{type} eq 'MAPVALUE') {
                $zero_indent = 1;
                $newline = 1;
            }
            else {
                if (not $props and $self->indent == 1) {
                    $new_indent .= ' ' x 2;
                }
                else {
                    $new_indent .= ' ' x $self->indent;
                }
                if ($last->{column}) {
                    my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
                    $yaml .= $space;
                }
                else {
                    $yaml .= $indent;
                }
                if ($last->{type} eq 'SEQ') {
                    $yaml .= "-";
                }
                elsif ($last->{type} eq 'MAP') {
                    $last->{type} = 'COMPLEX';
                    $zero_indent = 1;
                    $yaml .= "?";
                }
                elsif ($last->{type} eq 'COMPLEXVALUE') {
                    $yaml .= ":";
                    $zero_indent = 1;
                }
                else {
                    die "Should not happen ($last->{type} in sequence_start)";
                }
                $last->{column} = 1;
            }
            $last->{newline} = 0;
        }
        if ($props) {
            $yaml .= $last->{column} ? ' ' : $indent;
            $yaml .= $props;
            $newline = 1;
        }
    }
    $self->_write($yaml);
    $last->{index}++;
    my $new_info = {
        index => 0,
        indent => $new_indent,
        info => $info,
        zero_indent => $zero_indent,
        newline => $newline,
        column => $self->column,
        flow => $flow,
    };
    $new_info->{type} = 'SEQ';
    push @{ $stack }, $new_info;
    $self->{open_ended} = 0;
}

sub sequence_end_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ sequence_end_event\n";
    my ($self, $info) = @_;
    my $stack = $self->event_stack;

    my $last = pop @{ $stack };
    if ($last->{index} == 0) {
        my $indent = $last->{indent};
        my $zero_indent = $last->{zero_indent};
        if ($last->{zero_indent}) {
            $indent .= ' ' x $self->indent;
        }
        my $yaml .= $self->column ? ' ' : $indent;
        $yaml .= "[]";
        if ($last->{flow} < 2) {
            $yaml .= "\n";
        }
        $self->_write($yaml);
    }
    elsif ($last->{flow}) {
        my $yaml = "]";
        if ($last->{flow} == 1) {
            $yaml .= "\n";
        }
        $self->_write($yaml);
    }
    $last = $stack->[-1];
    $last->{column} = $self->column;
    if ($last->{type} eq 'SEQ') {
    }
    elsif ($last->{type} eq 'MAP') {
        $last->{type} = 'MAPVALUE';
    }
    elsif ($last->{type} eq 'MAPVALUE') {
        $last->{type} = 'MAP';
    }
    elsif ($last->{type} eq 'COMPLEX') {
        $last->{type} = 'COMPLEXVALUE';
    }
    elsif ($last->{type} eq 'COMPLEXVALUE') {
        $last->{type} = 'MAP';
    }
}

my %forbidden_first = (qw/
    ! 1 & 1 * 1 { 1 } 1 [ 1 ] 1 | 1 > 1 @ 1 ` 1 " 1 ' 1
/, '#' => 1, '%' => 1, ',' => 1, " " => 1);
my %forbidden_first_plus_space = (qw/
    ? 1 - 1 : 1
/);

my %control = (
    "\x00" => '\0',
    "\x01" => '\x01',
    "\x02" => '\x02',
    "\x03" => '\x03',
    "\x04" => '\x04',
    "\x05" => '\x05',
    "\x06" => '\x06',
    "\x07" => '\a',
    "\x08" => '\b',
    "\x0b" => '\v',
    "\x0c" => '\f',
    "\x0e" => '\x0e',
    "\x0f" => '\x0f',
    "\x10" => '\x10',
    "\x11" => '\x11',
    "\x12" => '\x12',
    "\x13" => '\x13',
    "\x14" => '\x14',
    "\x15" => '\x15',
    "\x16" => '\x16',
    "\x17" => '\x17',
    "\x18" => '\x18',
    "\x19" => '\x19',
    "\x1a" => '\x1a',
    "\x1b" => '\e',
    "\x1c" => '\x1c',
    "\x1d" => '\x1d',
    "\x1e" => '\x1e',
    "\x1f" => '\x1f',
    "\x7f" => '\x7f',
    "\x80" => '\x80',
    "\x81" => '\x81',
    "\x82" => '\x82',
    "\x83" => '\x83',
    "\x84" => '\x84',
    "\x86" => '\x86',
    "\x87" => '\x87',
    "\x88" => '\x88',
    "\x89" => '\x89',
    "\x8a" => '\x8a',
    "\x8b" => '\x8b',
    "\x8c" => '\x8c',
    "\x8d" => '\x8d',
    "\x8e" => '\x8e',
    "\x8f" => '\x8f',
    "\x90" => '\x90',
    "\x91" => '\x91',
    "\x92" => '\x92',
    "\x93" => '\x93',
    "\x94" => '\x94',
    "\x95" => '\x95',
    "\x96" => '\x96',
    "\x97" => '\x97',
    "\x98" => '\x98',
    "\x99" => '\x99',
    "\x9a" => '\x9a',
    "\x9b" => '\x9b',
    "\x9c" => '\x9c',
    "\x9d" => '\x9d',
    "\x9e" => '\x9e',
    "\x9f" => '\x9f',
    "\x{2029}" => '\P',
    "\x{2028}" => '\L',
    "\x85" => '\N',
    "\xa0" => '\_',
);

my $control_re = '\x00-\x08\x0b\x0c\x0e-\x1f\x7f-\x84\x86-\x9f\x{d800}-\x{dfff}\x{fffe}\x{ffff}\x{2028}\x{2029}\x85\xa0';
my %to_escape = (
    "\n" => '\n',
    "\t" => '\t',
    "\r" => '\r',
    '\\' => '\\\\',
    '"' => '\\"',
    %control,
);
my $escape_re = $control_re . '\n\t\r';
my $escape_re_without_lb = $control_re . '\t\r';


sub scalar_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ scalar_event\n";
    my ($self, $info) = @_;
    my $stack = $self->event_stack;
    my $last = $stack->[-1];
    my $indent = $last->{indent};
    my $value = $info->{value};
    my $flow = $last->{flow};

    my $props = '';
    my $anchor = $info->{anchor};
    my $tag = $info->{tag};
    if (defined $anchor) {
        $anchor = "&$anchor";
    }
    if (defined $tag) {
        $tag = $self->_emit_tag('scalar', $tag);
    }
    $props = join ' ', grep defined, ($anchor, $tag);

    DEBUG and local $Data::Dumper::Useqq = 1;
    $value = '' unless defined $value;

    my $style = $self->_find_best_scalar_style(
        info => $info,
        value => $value,
    );

    my $open_ended = 0;

    if ($style == YAML_PLAIN_SCALAR_STYLE) {
        $value =~ s/\n/\n\n/g;
    }
    elsif ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
        my $new_indent = $last->{indent} . (' ' x $self->indent);
        $value =~ s/(\n+)/"\n" x (1 + (length $1))/eg;
        my @lines = split m/\n/, $value, -1;
        if (@lines > 1) {
            for my $line (@lines[1 .. $#lines]) {
                $line = $new_indent . $line
                    if length $line;
            }
        }
        $value = join "\n", @lines;
        $value =~ s/'/''/g;
        $value = "'" . $value . "'";
    }
    elsif ($style == YAML_LITERAL_SCALAR_STYLE) {
        DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
        my $indicators = '';
        if ($value =~ m/\A\n* +/) {
            $indicators .= $self->indent;
        }
        my $indent = $indent . ' ' x $self->indent;
        if ($value !~ m/\n\z/) {
            $indicators .= '-';
            $value .= "\n";
        }
        elsif ($value =~ m/(\n|\A)\n\z/) {
            $indicators .= '+';
            $open_ended = 1;
        }
        $value =~ s/^(?=.)/$indent/gm;
        $value = "|$indicators\n$value";
    }
    elsif ($style == YAML_FOLDED_SCALAR_STYLE) {
        DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$value], ['value']);
        my @lines = split /\n/, $value, -1;
        DEBUG and warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\@lines], ['lines']);
        my $trailing = -1;
        while (@lines) {
            last if $lines[-1] ne '';
            pop @lines;
            $trailing++;
        }
        my %start_with_space;
        for my $i (0 .. $#lines) {
            if ($lines[ $i ] =~ m/^[ \t]+/) {
                $start_with_space{ $i } = 1;
            }
        }
        my $indicators = '';
        if ($value =~ m/\A\n* +/) {
            $indicators .= $self->indent;
        }
        my $indent = $indent . ' ' x $self->indent;
        if ($trailing > 0) {
            $indicators .= '+';
            $open_ended = 1;
        }
        elsif ($trailing < 0) {
            $indicators .= '-';
        }
        $value = ">$indicators\n";
        my $got_content = 0;
        for my $i (0 .. $#lines) {
            my $line = $lines[ $i ];
            my $sp = $start_with_space{ $i } || 0;
            my $spnext = $i == $#lines ? 1 : $start_with_space{ $i+1 } || 0;
            my $spprev = $i == 0 ? 1 : $start_with_space{ $i-1 } || 0;
            my $empty = length $line ? 0 : 1;
            my $emptynext = $i == $#lines ? '' : length $lines[$i+1] ? 0 : 1;
            my $nl = 0;
            if ($empty) {
                if ($spnext and $spprev) {
                    $nl = 1;
                }
                elsif (not $spnext) {
                    $nl = 1;
                }
                elsif (not $got_content) {
                    $nl = 1;
                }
            }
            else {
                $got_content = 1;
                $value .= "$indent$line\n";
                if (not $sp and not $spnext) {
                    $nl = 1;
                }
            }
            if ($nl) {
                $value .= "\n";
            }
        }
        $value .= "\n" x ($trailing) if $trailing > 0;
    }
    else {
        $value =~ s/([$escape_re"\\])/$to_escape{ $1 } || sprintf '\\u%04x', ord($1)/eg;
        $value = '"' . $value . '"';
    }

    DEBUG and warn __PACKAGE__.':'.__LINE__.": (@$stack)\n";
    my $yaml = $self->_emit_scalar(
        indent => $indent,
        props => $props,
        value => $value,
        style => $style,
    );

    $last->{index}++;
    $last->{newline} = 0;
    $self->_write($yaml);
    $last->{column} = $self->column;
    $self->{open_ended} = $open_ended;
}

sub _find_best_scalar_style {
    my ($self, %args) = @_;
    my $info = $args{info};
    my $style = $info->{style};
    my $value = $args{value};
    my $stack = $self->event_stack;
    my $last = $stack->[-1];
    my $flow = $last->{flow};

    my $first = substr($value, 0, 1);
    if ($value eq '') {
        if ($flow and $last->{type} ne 'MAPVALUE' and $last->{type} ne 'MAP') {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif (not $style) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
    }
    # no control characters anywhere
    elsif ($value =~ m/[$control_re]/) {
        $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
    }
    $style ||= YAML_PLAIN_SCALAR_STYLE;

    if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE) {
        if ($value =~ m/ \n/ or $value =~ m/\n / or $value =~ m/^\n/ or $value =~ m/\n$/) {
            $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value eq "\n") {
            $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
        }
    }
    elsif ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE) {
        if ($value eq '') {
            $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($flow) {
            # no block scalars in flow
            if ($value =~ tr/\n//) {
                $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
            }
            else {
                $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
            }
        }
    }
    elsif ($style == YAML_PLAIN_SCALAR_STYLE) {
        if (not length $value) {
        }
        elsif ($value =~ m/[$escape_re_without_lb]/) {
            $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value eq "\n") {
            $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value !~ tr/ //c) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value !~ tr/ \n//c) {
            $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value =~ tr/\n//) {
            $style = $flow ? YAML_DOUBLE_QUOTED_SCALAR_STYLE : YAML_LITERAL_SCALAR_STYLE;
        }
        elsif ($forbidden_first{ $first }) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($flow and $value =~ tr/,[]{}//) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif (substr($value, 0, 3) =~ m/^(?:---|\.\.\.)/) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value =~ m/: /) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value =~ m/ #/) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value =~ m/[: \t]\z/) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($value =~ m/[^\x20-\x3A\x3B-\x7E\x85\xA0-\x{D7FF}\x{E000}-\x{FEFE}\x{FF00}-\x{FFFD}\x{10000}-\x{10FFFF}]/) {
            $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
        }
        elsif ($forbidden_first_plus_space{ $first }) {
            if (length ($value) == 1 or substr($value, 1, 1) =~ m/^\s/) {
                $style = YAML_SINGLE_QUOTED_SCALAR_STYLE;
            }
        }
    }
    if ($style == YAML_SINGLE_QUOTED_SCALAR_STYLE and not $info->{style}) {
        if ($value =~ tr/'// and $value !~ tr/"//) {
            $style = YAML_DOUBLE_QUOTED_SCALAR_STYLE;
        }
    }
    return $style;
}

sub _emit_scalar {
    my ($self, %args) = @_;
    my $props = $args{props};
    my $value = $args{value};
    my $style = $args{style};
    my $stack = $self->event_stack;
    my $last = $stack->[-1];
    my $flow = $last->{flow};

    my $yaml = '';
    my $pvalue = $props;
    if ($props and length $value) {
        $pvalue .= " $value";
    }
    elsif (length $value) {
        $pvalue .= $value;
    }
    if ($flow) {
        if ($props and not length $value) {
            $pvalue .= ' ';
        }
        $yaml = $self->_emit_flow_scalar(
            value => $value,
            pvalue => $pvalue,
            style => $args{style},
        );
    }
    else {
        $yaml = $self->_emit_block_scalar(
            props => $props,
            value => $value,
            pvalue => $pvalue,
            indent => $args{indent},
            style => $args{style},
        );
    }
    return $yaml;
}

sub _emit_block_scalar {
    my ($self, %args) = @_;
    my $props = $args{props};
    my $value = $args{value};
    my $pvalue = $args{pvalue};
    my $indent = $args{indent};
    my $style = $args{style};
    my $stack = $self->event_stack;
    my $last = $stack->[-1];

    my $yaml;
    if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
        if ($last->{index} == 0 and $last->{newline}) {
            $yaml .= "\n";
            $last->{column} = 0;
            $last->{newline} = 0;
        }
    }
    my $space = ' ';
    my $multiline = ($style == YAML_LITERAL_SCALAR_STYLE or $style == YAML_FOLDED_SCALAR_STYLE);
    if ($last->{type} eq 'MAP') {

        if ($last->{column}) {
            my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
            $yaml .= $space;
        }
        else {
            $yaml .= $indent;
        }
        if ($props and not length $value) {
            $pvalue .= ' ';
        }
        $last->{type} = 'MAPVALUE';
        if ($multiline) {
            # oops, a complex key
            $yaml .= "? ";
            $last->{type} = 'COMPLEXVALUE';
        }
        if (not $multiline) {
            $pvalue .= ":";
        }
    }
    else {
        if ($last->{type} eq 'MAPVALUE') {
            $last->{type} = 'MAP';
        }
        elsif ($last->{type} eq 'DOC') {
        }
        else {
            if ($last->{column}) {
                my $space = $self->indent > 1 ? ' ' x ($self->indent - 1) : ' ';
                $yaml .= $space;
            }
            else {
                $yaml .= $indent;
            }
            if ($last->{type} eq 'COMPLEXVALUE') {
                $last->{type} = 'MAP';
                $yaml .= ":";
            }
            elsif ($last->{type} eq 'SEQ') {
                $yaml .= "-";
            }
            else {
                die "Should not happen ($last->{type} in scalar_event)";

            }
            $last->{column} = 1;
        }

        if (length $pvalue) {
            if ($last->{column}) {
                $pvalue = "$space$pvalue";
            }
        }
        if (not $multiline) {
            $pvalue .= "\n";
        }
    }
    $yaml .= $pvalue;
    return $yaml;
}

sub _emit_flow_scalar {
    my ($self, %args) = @_;
    my $value = $args{value};
    my $pvalue = $args{pvalue};
    my $stack = $self->event_stack;
    my $last = $stack->[-1];

    my $yaml;
    if ($last->{type} eq 'SEQ') {
        if ($last->{index} == 0) {
            if ($self->column) {
                $yaml .= ' ';
            }
            $yaml .= "[";
        }
        else {
            $yaml .= ", ";
        }
    }
    elsif ($last->{type} eq 'MAP') {
        if ($last->{index} == 0) {
            if ($self->column) {
                $yaml .= ' ';
            }
            $yaml .= "{";
        }
        else {
            $yaml .= ", ";
        }
        $last->{type} = 'MAPVALUE';
    }
    elsif ($last->{type} eq 'MAPVALUE') {
        if ($last->{index} == 0) {
            die "Should not happen (index 0 in MAPVALUE)";
        }
        $yaml .= ": ";
        $last->{type} = 'MAP';
    }
    if ($self->column + length $pvalue > $self->width) {
        $yaml .= "\n";
        $yaml .= $last->{indent};
        $yaml .= ' ' x $self->indent;
    }
    $yaml .= $pvalue;
    return $yaml;
}

sub alias_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ alias_event\n";
    my ($self, $info) = @_;
    my $stack = $self->event_stack;
    my $last = $stack->[-1];
    my $indent = $last->{indent};
    my $flow = $last->{flow};

    my $alias = '*' . $info->{value};

    my $yaml = '';
    if ($last->{type} eq 'MAP' or $last->{type} eq 'SEQ') {
        if ($last->{index} == 0 and $last->{newline}) {
            $yaml .= "\n";
            $last->{column} = 0;
            $last->{newline} = 0;
        }
    }
    $yaml .= $last->{column} ? ' ' : $indent;
    if ($flow) {
        my $space = '';
        if ($last->{type} eq 'SEQ') {
            if ($last->{index} == 0) {
                if ($flow == 1) {
                    $yaml .= ' ';
                }
                $yaml .= "[";
            }
            else {
                $yaml .= ", ";
            }
        }
        elsif ($last->{type} eq 'MAP') {
            if ($last->{index} == 0) {
                if ($flow == 1) {
                    $yaml .= ' ';
                }
                $yaml .= "{";
            }
            else {
                $yaml .= ", ";
            }
            $last->{type} = 'MAPVALUE';
            $space = ' ';
        }
        elsif ($last->{type} eq 'MAPVALUE') {
            if ($last->{index} == 0) {
                die 23;
                if ($flow == 1) {
                    $yaml .= ' ';
                }
                $yaml .= "{";
            }
            else {
                $yaml .= ": ";
            }
            $last->{type} = 'MAP';
        }
        $yaml .= "$alias$space";
    }
    else {
        if ($last->{type} eq 'MAP') {
            $yaml .= "$alias :";
            $last->{type} = 'MAPVALUE';
        }
        else {

            if ($last->{type} eq 'MAPVALUE') {
                $last->{type} = 'MAP';
            }
            elsif ($last->{type} eq 'DOC') {
                # TODO an alias at document level isn't actually valid
            }
            else {
                if ($last->{type} eq 'COMPLEXVALUE') {
                    $last->{type} = 'MAP';
                    $yaml .= ": ";
                }
                elsif ($last->{type} eq 'COMPLEX') {
                    $yaml .= ": ";
                }
                elsif ($last->{type} eq 'SEQ') {
                    $yaml .= "- ";
                }
                else {
                    die "Unexpected";
                }
            }
            $yaml .= "$alias\n";
        }
    }

    $self->_write("$yaml");
    $last->{index}++;
    $last->{column} = $self->column;
    $self->{open_ended} = 0;
}

sub document_start_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_start_event\n";
    my ($self, $info) = @_;
    my $newline = 0;
    my $implicit = $info->{implicit};
    if ($info->{version_directive}) {
        if ($self->{open_ended}) {
            $self->_write("...\n");
        }
        $self->_write("%YAML $info->{version_directive}->{major}.$info->{version_directive}->{minor}\n");
        $self->{open_ended} = 0;
        $implicit = 0; # we need ---
    }
    unless ($implicit) {
        $newline = 1;
        $self->_write("---");
    }
    $self->set_event_stack([
        {
        type => 'DOC', index => 0, indent => '', info => $info,
        newline => $newline, column => $self->column,
        }
    ]);
}

sub document_end_event {
    DEBUG and warn __PACKAGE__.':'.__LINE__.": +++ document_end_event\n";
    my ($self, $info) = @_;
    $self->set_event_stack([]);
    if ($self->{open_ended} or not $info->{implicit}) {
        $self->_write("...\n");
        $self->{open_ended} = 0;
    }
    else {
        $self->{open_ended} = 1;
    }
}

sub stream_start_event {
}

sub stream_end_event {
}

sub _emit_tag {
    my ($self, $type, $tag) = @_;
    my $map = $self->tagmap;
    for my $key (sort keys %$map) {
        if ($tag =~ m/^\Q$key\E(.*)/) {
            $tag = $map->{ $key } . $1;
            return $tag;
        }
    }
    if ($tag =~ m/^(!.*)/) {
        $tag = "$1";
    }
    else {
        $tag = "!<$tag>";
    }
    return $tag;
}

sub finish {
    my ($self) = @_;
    $self->writer->finish;
}

sub _write {
    my ($self, $yaml) = @_;
    return unless length $yaml;
    my @lines = split m/\n/, $yaml, -1;
    my $newlines = @lines - 1;
    $self->{line} += $newlines;
    if (length $lines[-1]) {
        if ($newlines) {
            $self->{column} = length $lines[-1];
        }
        else {
            $self->{column} += length $lines[-1];
        }
    }
    else {
        $self->{column} = 0;
    }
    $self->writer->write($yaml);
}

1;

__END__