view release on metacpan or  search on metacpan

lib/YAML/PP/Emitter.pm  view on Meta::CPAN

    "\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 ];

lib/YAML/PP/Emitter.pm  view on Meta::CPAN

        $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__

=pod

=encoding utf-8

=head1 NAME

YAML::PP::Emitter - Emitting events

=head1 SYNOPSIS

    my $emitter = YAML::PP::Emitter->new(
        indent => 4,
    );

    $emitter->init;

    $emitter->stream_start_event;
    $emitter->document_start_event({ implicit => 1 });
    $emitter->sequence_start_event;
    $emitter->scalar_event({ value => $input, style => $style });
    $emitter->sequence_end_event;
    $emitter->document_end_event({ implicit => 1 });
    $emitter->stream_end_event;

    my $yaml = $emitter->writer->output;
    $emitter->finish;

=head1 DESCRIPTION

The emitter emits events to YAML. It provides methods for each event
type. The arguments are mostly the same as the events from L<YAML::PP::Parser>.

=head1 METHODS

=over

=item new

    my $emitter = YAML::PP::Emitter->new(
        indent => 4,