view release on metacpan or  search on metacpan

lib/Apache/XPointer/XPath.pm  view on Meta::CPAN

I<Required>

=head2 XPointerAllowCGI

If set to B<On> then the handler will check for CGI parameters as well
as HTTP headers. CGI parameters are checked only if no matching HTTP
header is present.

Case insensitive.

=head2 XPointerCGIRangeParam

The name of the CGI parameter to check for an XPath range.

Default is B<range>

=head2 XPointerCGIAcceptParam

The name of the CGI parameter to list one or more acceptable
content types for a response.

Default is B<accept>

=head1 MOD_PERL COMPATIBILITY

This handler will work with both mod_perl 1.x and mod_perl 2.x.

=cut

use XML::LibXML;
use XML::LibXML::XPathContext;

sub send_as {
    my $pkg = shift;
    my $as  = shift;

    if ($as eq "multipart/mixed") {
	return "send_multipart";
    }

    elsif ($as eq "application/xml") {
	return "send_xml";
    } 

    else {
	return undef;
    }
}

sub parse_range {
    my $pkg    = shift;
    my $apache = shift;
    my $range  = shift;

    my %ns      = ();
    my $pointer = undef;

    $range =~ s/^\s+//;
    $range =~ s/\s+$//;

    # FIX ME - hooks to deal with '^' escaped
    # parens per the XPointer spec

    while ($range =~ /\G\s*xmlns\(([^=]+)=([^\)]+)\)/mg) {
	$ns{ $1 } = $2;
    }
    
    $range =~ /xpointer\((.*)\)$/;
    $pointer = $1;
    
    return {query => $pointer,
	    ns    => \%ns };
}

sub query {
    my $pkg     = shift;
    my $apache  = shift;
    my $args    = shift;

    my $parser = XML::LibXML->new();
    my $doc    = undef;

    eval {
	$doc = $parser->parse_file($apache->filename());
    };
    
    if ($@) {
	$apache->log()->error(sprintf("failed to parse file '%s', %s",
				      $apache->filename(),$@));

	return {success  => 0,
		response => $pkg->_server_error()};
    }
    
    my $context = XML::LibXML::XPathContext->new($doc);
    my $ns      = $args->{'ns'};

    foreach my $prefix (keys %$ns) {
	$context->registerNs($prefix,$ns->{$prefix});
    }

    #

    my $result = undef;
    
    eval {
	$result = $context->findnodes($args->{'query'});
    };
    
    if ($@) {
	$apache->log()->error(sprintf("failed to find nodes for '%s', %s",
				      $args->{'query'},$@));

	return {success  => 0,
		response => $pkg->_server_error()};
    }

    #

    return {success  => 1,
	    encoding => $doc->encoding(),