view release on metacpan or  search on metacpan

lib/Apache2/ModXml2.pm  view on Meta::CPAN

# Makes mod_xml2 functionality available to perl modules
# $Id: $
package Apache2::ModXml2;

use 5.010001;
use strict;
use warnings;

use XML::LibXML;
use XML::LibXML::Devel qw(:all);

use Apache2::RequestRec;
use APR::Pool;

use Apache2::Filter;
use APR::Brigade ( );
use APR::Bucket ( );
use APR::BucketType ( );

use Apache2::Log;  

use base qw(Exporter);

use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS );

our %EXPORT_TAGS = ( 'all' => [ qw(	
  wrap_node
  unwrap_node
  end_bucket
  cmp_bucket
  make_start_bucket
  xpath_filter_init 
  xpath_filter 
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our $VERSION = '0.01';

require XSLoader;
XSLoader::load('Apache2::ModXml2', $VERSION);


sub unwrap_node 
{
  my ($b) = @_;
  my $vn = xml2_unwrap_node($b);
  # The nodes are owned by the document.
  # We do not introduce an owner fragment
  # as LibXML does it.
  my $d = raw_owner_document($vn);
  my $rtn = node_to_perl($vn, $d);
  refcnt_inc($vn);
  return $rtn;
}

sub wrap_node 
{
  my ($a, $n, $r) = @_;
  my $vn = node_from_perl($n);
  my $b = xml2_wrap_node($a, $vn, $r);
  refcnt_inc($vn);
  return $b;
}

sub xpath_filter_init
{
  my ($f, $pattern, $namespaces, $transform ) = @_;

  if (defined($namespaces)) {
    push(@$namespaces, (undef, undef));
  }

  xml2_xpath_filter_init($f, $pattern, $namespaces, sub {
    my ($n) = @_;
    $f->r->log->debug("Transform callback called.");
    my $node = node_to_perl($n, raw_owner_document($n));
    refcnt_inc($n); 
    
    &$transform($node); 
    $f->r->log->debug("Transform callback finished.");
  });
}

#
# INTERNAL
# Called from mod_xml2 through the XS layer.
#
sub document_start 
{
  my ($r, $d) = @_;  
  my $rec = rec_to_perl($r);

  $rec->log->debug("document_start called.");

  my $doc = node_to_perl($d);
  # If the doc node has just been created, 
  # it has one reference
  die "document_start found doc with  refcnt=".refcnt($d)."." 
    unless (refcnt($d) == 1);
  # We inc. the counter to for $doc 
  refcnt_inc($d); 
  # We inc. the counter to prevent deletion 
  refcnt_inc($d); 
  # and schedule deletion at request cleanup time
  $rec->pool->cleanup_register(sub {refcnt_dec($_[0]);}, $d);  
}

1;