File Coverage

blib/lib/Cindy.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# $Id: Cindy.pm 120 2013-01-31 11:34:41Z jo $
# Cindy - Content INjection
#
# Copyright (c) 2008 Joachim Zobel . All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#

package Cindy;

use strict;
use warnings;

use base qw(Exporter);

our $VERSION = '0.19';

our @EXPORT= qw(get_html_doc get_xml_doc
                parse_html_string parse_xml_string
                parse_cis parse_cis_string
                inject dump_xpath_profile);

use XML::LibXML;
use Cindy::Sheet;
use Cindy::Log;

sub get_html_doc($)
{
  my ($file)  = @_;
  my $parser = XML::LibXML->new();

  return $parser->parse_html_file($file);
}

sub get_xml_doc($)
{
  my ($file)  = @_;
  my $parser = XML::LibXML->new();

  return $parser->parse_file($file);
}

sub omit_nodes {
  my ($doc, $tag) = @_;

  my $found = $doc->find( "///$tag" );
  foreach my $node ($found->get_nodelist()) {
    my $parent = $node->parentNode;

    foreach my $child ($node->childNodes()) {
      $parent->insertBefore($child->cloneNode(1), $node);
    }

    $parent->removeChild($node);
  }
}

sub parse_html_string($;$)
{
  my ($string, $ropt)  = @_;
  $ropt ||= {};
  my $html_parse_noimplied = $ropt->{html_parse_noimplied};

  my $dont_omit =  !$html_parse_noimplied
               ||  ($string =~ /

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

  my $doc = $parser->parse_html_string($string, $ropt);

  if (!$dont_omit) {
    # Until HTML_PARSE_NOIMPLIED is implemented by
    # libxml2 (and passed by XML::LibXML) we need
    # to remove html/body tags that have been added to
    # fragments.
    omit_nodes($doc, 'html');
    omit_nodes($doc, 'body');
  }
  return $doc;
}

sub parse_xml_string($)
{
  my $parser = XML::LibXML->new();

  return $parser->parse_string($_[0]);
}

sub parse_cis($)
{
  return Cindy::Sheet::parse_cis($_[0]);
}

sub parse_cis_string($)
{
  return Cindy::Sheet::parse_cis_string($_[0]);
}

#
# Get a copied doc. root for modification.
#
sub get_root_copy($)
{
  my ($doc)   = @_;
  my $root  = $doc->documentElement();
  my $rtn = $root->cloneNode( 1 );
  return $rtn;
}

sub dump_xpath_profile()
{
  Cindy::Injection::dump_profile();
}

sub inject($$$)
{
  my ($data, $doc, $descriptions) = @_;
  my $docroot = get_root_copy($doc);
#  my $dataroot = get_root_copy($data);
  my $dataroot = $data->getDocumentElement();
  # Create a root description with action none
  # to hold the description list
  my $descroot = Cindy::Injection->new(
      '.', 'none', '.', 'xpath',
      sublist => $descriptions);

  # Connect the copied docroot with the output document.
  # This has to be done before the tree is matched.
  my $out = XML::LibXML::Document->new($doc->getVersion, $doc->getEncoding);
  $out->setDocumentElement($docroot);

  # Run the sheet
  $descroot->run($dataroot, $docroot);

  return $out;
}

1;


__END__