view release on metacpan or  search on metacpan

lib/Plack/Middleware/XSLT.pm  view on Meta::CPAN

    my $res = $self->app->($env);

    Plack::Util::response_cb($res, sub {
        my $res = shift;

        my $xsl_file = $env->{'xslt.style'};
        return if !defined($xsl_file) || $xsl_file eq '';

        if (!$xslt) {
            if ($self->cache) {
                require XML::LibXSLT::Cache;
                $xslt = XML::LibXSLT::Cache->new;
            }
            else {
                $xslt = XML::LibXSLT->new;
            }
        }

        my $path = $self->path;
        $xsl_file = File::Spec->catfile($path, $xsl_file)
            if defined($path) && !File::Spec->file_name_is_absolute($xsl_file);

        my $stylesheet = $xslt->parse_stylesheet_file($xsl_file);
        my $media_type = $stylesheet->media_type();
        my $encoding   = $stylesheet->output_encoding();

        my $headers = Plack::Util::headers($res->[1]);
        $headers->remove('Content-Encoding');
        $headers->remove('Transfer-Encoding');
        $headers->set('Content-Type', "$media_type; charset=$encoding");

        if ($res->[2]) {
            my ($output, $error) = $self->_xform($stylesheet, $res->[2]);

            if (defined($error)) {
                # Try to convert error to HTTP response.

                my ($status, $message);

                for my $line (split(/\n/, $error)) {
                    if ($line =~ /^(\d\d\d)(?:\s+(.*))?\z/) {
                        $status  = $1;
                        $message = defined($2) ? $2 : '';
                        last;
                    }
                }

                die($error) if !defined($status);

                $res->[0] = $status;
                $headers->set('Content-Type', 'text/plain');
                $headers->set('Content-Length', length($message));
                $res->[2] = [ $message ];
            }
            else {
                $headers->set('Content-Length', length($output));
                $res->[2] = [ $output ];
            }
        }
        else {
            # PSGI streaming

            my ($done, @chunks);

            return sub {
                my $chunk = shift;

                return undef if $done;

                if (defined($chunk)) {
                    push(@chunks, $chunk);
                    return '';
                }
                else {
                    $done = 1;
                    my ($output, $error) =
                        $self->_xform($stylesheet, \@chunks);
                    die($error) if defined($error);
                    return $output;
                }
            }
        }
    });
}

sub _xform {
    my ($self, $stylesheet, $body) = @_;

    if (!$parser) {
        my $options = $self->parser_options;
        $parser = $options
                ? XML::LibXML->new($options)
                : XML::LibXML->new;
    }

    my ($doc, $output, $error);

    if (ref($body) eq 'ARRAY') {
        $doc = $parser->parse_string(join('', @$body));
    }
    else {
        $doc = $parser->parse_fh($body);
    }

    my $result = try {
        $stylesheet->transform($doc) or die("XSLT transform failed: $!");
    }
    catch {
        $error = defined($_) ? $_ : 'Unknown error';
        undef;
    };

    $output = $stylesheet->output_as_bytes($result)
        if $result;

    return ($output, $error);
}

sub _cache_hits {
    my $self = shift;