view release on metacpan or  search on metacpan

lib/PXML/Serialize.pm  view on Meta::CPAN

                                $selfreferential = $isempty;
                                warn "html5 compatible serialization requested "
                                    . "but got void element '$n' that is not empty"
                                    if not $isempty;
                            }
                        } else {
                            $selfreferential = 0;
                        }
                    } else {
                        $selfreferential = $looksempty;
                    }
                    if ($selfreferential) {
                        print $fh "/>" or die $!;
                    } else {
                        print $fh ">" or die $!;
                        no warnings "recursion";    # hu.
                        _pxml_print_fragment_fast($body, $fh, $html5compat,
                            $void_element_h);
                        print $fh "</$n>" or die $!;
                    }
                } elsif (my $car_and_cdr = $v->can("car_and_cdr")) {
                PAIR:

                    #my $a;
                    ($a, $v) = &$car_and_cdr($v);
                    _pxml_print_fragment_fast($a, $fh, $html5compat,
                        $void_element_h);

                    #_pxml_print_fragment_fast (cdr $v, $fh);
                    redo LP;
                } elsif (my $for_each = $v->can("for_each")) {

                    # catches null, too. Well.
                    &$for_each(
                        $v,
                        sub {
                            my ($a) = @_;
                            _pxml_print_fragment_fast($a, $fh, $html5compat,
                                $void_element_h);
                        }
                    );
                } else {
                    my $v2 = force($v, 1);

                    # ^XX why pass nocache flag? (Was this to avoid
                    # memory retention issues?)
                    my $addr2 = refaddr($v2);
                    if (defined($addr2) and $addr2 != refaddr($v)) {

                        $v = $v2;
                        redo LP;
                    } elsif (is_somearray($v)) {

                        # COPY-PASTE. Really should refactor
                        # _pxml_print_fragment_fast into local hash-table
                        # based dispatcher.
                        no warnings "recursion";    # hu.
                        for (@$v) {

                           # XXX use Keep around $_ to prevent mutation of tree?
                           # nope, can't, will prevent streaming.
                            _pxml_print_fragment_fast($_, $fh, $html5compat,
                                $void_element_h);
                        }
                    } elsif (is_pxmlflush $v) {
                        flush $fh or die $!
                    } else {

                        # Fallback for references, XX copy-paste
                        print $fh object_force_escape($v,
                            "pxml_serialized_body_string", \&content_escape,
                            $fh)
                            or die $!;
                    }
                }
            } else {
                if (is_somearray($v)) {
                    no warnings "recursion";    # hu.
                    for (@$v) {

                        # XXX use Keep around $_ to prevent mutation of tree?
                        # nope, can't, will prevent streaming.
                        _pxml_print_fragment_fast($_, $fh, $html5compat,
                            $void_element_h);
                    }
                }

                # 'force' doesn't evaluate CODE (probably rightly so),
                # thus need to be explicit if we want 'late binding'
                # (e.g. reference to dynamic variables) during
                # serialization
                elsif ($ref eq "CODE") {
                    $v = &$v();
                    redo LP;
                } elsif (is_null $v) {
                    die "OBSOLETE?";

                    # end of linked list, nothing
                    # XX obsolete now, since $v->can("for_each") above
                    # will catch it already.
                } else {

                    warn "XXX when does this happen?";

                    #use FP::Repl;
                    #repl;

                    # slow fallback...  again, see above **NOTE** re
                    # evil.
                    $ref or die "BUG";    # we're in the if ref scope, right?
                    goto PXML if $v->isa("PXML::Element");
                    goto PAIR if is_pair $v;

                    # goto PROMISE if is_promise $v;

                    # Fallback for references, XX copy-paste
                    print $fh object_force_escape($v,
                        "pxml_serialized_body_string", \&content_escape, $fh)
                        or die $!;
                }
            }
        } elsif (not defined $v) {

            # (previously end of linked list marker) nothing; XX
            # should this give exception (to point out any issue with
            # deleted streams, the reason why I changed from using
            # undef to null)? But exception won't show a good
            # backtrace anyway at this point.
            #warn "warning: ignoring undef in PXML datastructure";
            # XXX what to do about this?
        } else {

            #print $fh content_escape($v) or die $!;
            $v =~ s/([&<>])/$content_escape{$1}/sg;
            print $fh $v or die $!;
        }
    }
}

sub pxml_print_fragment_fast {
    @_ == 2 or fp_croak_arity 2;
    my ($v, $fh) = @_;