FunctionalPerl
29 results

 view release on metacpan or  search on metacpan

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

            # 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) = @_;
    weaken $_[0] if ref $_[0];    # ref check perhaps unnecessary here
    my $no_element = sub {
        @_ = ($v, $fh, undef, undef);
        goto \&_pxml_print_fragment_fast;
    };
    my $with_first_element = sub {
        my ($firstel) = @_;
        weaken $_[0] if ref $_[0];
        my $html5compat
            = $firstel->require_printing_nonvoid_elements_nonselfreferential;
        @_ = ($v, $fh, $html5compat,
            ($html5compat and $firstel->void_element_h));
        goto \&_pxml_print_fragment_fast;
    };
    if (length(my $r = ref $v)) {
        if (defined blessed $v and $v->isa("PXML::XHTML")) {
            @_ = ($v);
            goto &$with_first_element;
        } else {
            my $s = force(stream_mixed_flatten($v)->filter(\&is_pxml_element));
            if (is_null $s) {
                goto &$no_element
            } else {
                @_ = (car $s);
                goto &$with_first_element;
            }
        }
    } else {
        goto &$no_element
    }
}

sub pxml_xhtml_print_fast {
    @_ >= 2 and @_ <= 3 or fp_croak_arity "2-3";
    my ($v, $fh, $maybe_lang) = @_;
    weaken $_[0] if ref $_[0];    # ref check perhaps unnecessary here
    if (not ref $v or (defined(blessed $v) and not $v->isa("PXML::Element"))) {
        die "not an element: " . (show $v);
    }
    if (not "html" eq $v->name) {
        die "not an 'html' element: " . (show $v);
    }
    xprint($fh, "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n");
    xprint($fh,
        "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n"
    );

    # add attributes to toplevel element
    my $v2 = $v->maybe_attributes ? $v : $v->attributes_set(
        do {
            my $lang = $maybe_lang
                or die
                "missing 'lang' attribute from html element and no lang option given";
            +{
                xmlns      => "http://www.w3.org/1999/xhtml",
                "xml:lang" => $lang,
                lang       => $lang
            }
        }
    );
    @_ = ($v2, $fh);
    goto \&pxml_print_fragment_fast;
}

# for now,
sub pxml_xhtml_print;
*pxml_xhtml_print = \&pxml_xhtml_print_fast;

use Chj::xopen "xopen_write";

sub pxml_print {
    @_ == 2 or fp_croak_arity 2;
    my ($v, $fh) = @_;
    weaken $_[0] if ref $_[0];    # ref check perhaps unnecessary here
    xprintln($fh, q{<?xml version="1.0"?>});
    pxml_print_fragment_fast($v, $fh);
}

sub putxmlfile {
    @_ == 2 or fp_croak_arity 2;
    my ($path, $xml) = @_;
    weaken $_[1] if ref $_[0];    # ref check perhaps unnecessary here
    my $f = xopen_write $path;
    binmode($f, ":utf8") or die "binmode";

    # ^ XX should this use ":encoding(UTF-8)"? To validate in-memory
    # strings? Shouldn't we just check all *inputs*?
    pxml_print($xml, $f);
    $f->xclose;
}

sub PXML::Element::xmlfile {
    my ($v, $path) = @_;
    weaken $_[0];
    putxmlfile($path, $v)
}

sub puthtmlfile {
    @_ >= 2 and @_ <= 3 or fp_croak_arity "2-3";
    my ($path, $v, $maybe_lang) = @_;
    weaken $_[1] if ref $_[0];    # ref check perhaps unnecessary here
                                  #xmkdir_p dirname $path;
    my $out = xopen_write($path);
    binmode $out, ":utf8" or die "binmode";



( run in 0.453 second using v1.01-cache-2.11-cpan-119454b85a5 )