view release on metacpan or  search on metacpan

lib/App/Changelog2x.pm  view on Meta::CPAN

}

###############################################################################
#
#   Sub Name:       transform_changelog
#
#   Description:    Take a filehandle or string for input, a filehandle for
#                   output, filename/string of a XSL transform, and optional
#                   parameters. Process the input according to the XSLT and
#                   stream the results to the output handle.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      scalar    Class name or object ref
#                   $xmlin    in      scalar    Filehandle to read/parse or
#                                                 string
#                   $xmlout   in      ref       Filehandle to output the
#                                                 transformed XML to
#                   $style    in      scalar    Stylesheet, either a string
#                                                 or the name of a file
#                   $params   in      hashref   If present, parameters that
#                                                 should be converted for use
#                                                 in the XSLT and passed in.
#
#   Globals:        URI
#
#   Returns:        Success:    null
#                   Failure:    dies
#
###############################################################################
sub transform_changelog
{
    my ($self, $xmlin, $xmlout, $style, $params) = @_;
    $params ||= {}; # In case they didn't pass any

    our $parser = XML::LibXML->new();
    our $xslt   = XML::LibXSLT->new();

    $parser->expand_xinclude(1);
    $xslt->register_function(URI, 'format-date',
                             sub { $self->format_date(@_) });
    $xslt->register_function(URI, 'credits',
                             sub { $self->credits(@_) });

    our (%params, $xsltc, $source, $stylesheet, $result);

    # If the template isn't already an absolute path, use the root-dir and add
    # the "changelog2" prefix and ".xslt" suffix
    unless ($style =~ /^<\?xml/)
    {
        $xsltc = $self->resolve_template($style)
            or die "Could not resolve style '$style' to a file";
        $style = $xsltc;
    }

    # First copy over and properly setup/escape the parameters, so that XSLT
    # understands them.
    %params = map { XML::LibXSLT::xpath_to_string($_ => $params->{$_}) }
        (keys %$params);

    # Do the steps of parsing XML documents, creating stylesheet engine and
    # applying the transform. Each throws a die on error, so each has to be
    # eval'd to allow for a cleaner error report:
    eval {
        $source = ref($xmlin) ?
            $parser->parse_fh($xmlin) : $parser->parse_string($xmlin);
    };
    die "Error parsing input-XML content: $@" if $@;
    eval {
        $xsltc = ($style =~ /^<\?xml/) ?
            $parser->parse_string($style) : $parser->parse_file($style);
    };
    die "Error parsing the XML of the XSLT stylesheet '$style': $@" if $@;
    eval { $stylesheet = $xslt->parse_stylesheet($xsltc); };
    die "Error parsing the XSLT syntax of the stylesheet: $@" if $@;
    eval { $result = $stylesheet->transform($source, %params); };
    die "Error applying transform to input content: $@" if $@;

    $stylesheet->output_fh($result, $xmlout);
    return;
}

###############################################################################
#
#   Sub Name:       resolve_template
#
#   Description:    Resolve a non-absolute template name to a complete file.
#                   This may include adding "changelog2" and ".xslt" to the
#                   string. If the name is already absolute or starts with a
#                   '.', it is returned unchanged.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $self     in      ref       Object of this class
#                   $template in      scalar    Name to resolve
#
#   Returns:        Success:    full path
#                   Failure:    empty string
#
###############################################################################
sub resolve_template
{
    my ($self, $template) = @_;

    return $template if ((substr($template, 0, 1) eq '.') ||
                         File::Spec->file_name_is_absolute($template));

    my @paths = $self->xslt_path;
    my $candidate;

    $template = "changelog2$template.xslt" unless ($template =~ /\.xslt?/i);

    for (@paths)
    {
        $candidate = File::Spec->catfile($_, $template);
        last if -f $candidate;
        undef $candidate;
    }

    $candidate;
}

1;