package Xmldoom::Criteria::XML;
use Xmldoom::Criteria;
use Xmldoom::Criteria::UnknownObject;
use DBIx::Romani::Query::XML::Util qw(get_element_text);
use XML::GDOME;
use XML::DOM;
use strict;
use Data::Dumper;
sub parse_string
{
my $xml = shift;
my $database = shift;
my $doc = XML::GDOME->createDocFromString( $xml );
return Xmldoom::Criteria::XML::parse_dom( $doc, $database );
}
sub parse_dom
{
my $doc = shift;
my $database = shift;
return Xmldoom::Criteria::XML::create_criteria_from_node( $doc->getDocumentElement(), $database );
}
sub create_criteria_from_node
{
my $parent_node = shift;
my $database = shift;
# this will grab the Criteria parent if such a section exists
my $parent = Xmldoom::Criteria::XML::_parse_parent_section($parent_node, $database);
my $criteria = Xmldoom::Criteria->new($parent);
my $limit = $parent_node->getAttribute('limit');
my $offset = $parent_node->getAttribute('offset');
if ( (defined $limit and $limit ne "") or
(defined $offset and $offset ne "") )
{
$criteria->set_limit($limit, $offset);
}
my $has_constraints = 0;
my $has_order_by = 0;
my $has_group_by = 0;
my $node = $parent_node->getFirstChild();
while ( defined $node )
{
if ( $node->getNodeType() == XML::DOM::ELEMENT_NODE )
{
my $name = $node->getTagName();
if ( $name eq 'constraints' )
{
if ( not $has_constraints )
{
_parse_constraints_section( $criteria, $node );
$has_constraints = 1;
}
else
{
die "Cannot have multiple constraints sections";
}
}
elsif ( $name eq 'order-by' )
{
if ( not $has_order_by )
{
_parse_order_by_section( $criteria, $node );
$has_order_by = 1;
}
else
{
die "Cannot have multiple order-by sections";
}
}
elsif ( $name eq 'group-by' )
{
if ( not $has_group_by )
{
_parse_group_by_section( $criteria, $node );
$has_group_by = 1;
}
else
{
die "Cannot have multiple group-by sections";
}
}
elsif ( $name eq 'parent' )
{
# Already processed this section in advance...
}
else
{
die "Unknown criteria section: $name";
}
}
$node = $node->getNextSibling();
}
return $criteria;
}
sub _parse_parent_section
{
my $top_node = shift;
my $database = shift;
# try to find the parent section
my $parent_node = $top_node->getFirstChild();
while ( defined $parent_node )
{
if ( $parent_node->getNodeType() == XML::DOM::ELEMENT_NODE &&
$parent_node->getTagName() eq 'parent' )
{
last;
}
$parent_node = $parent_node->getNextSibling();
}
# check it out
if ( not defined $parent_node )
{
return undef;
}
elsif ( not defined $database )
{
die "Cannot parse a criteria with a section if you don't pass the database object into the parser";
}
my $object_name = $parent_node->getAttribute('object_name');
my $definition = $database->get_object($object_name);
my $load_args = { };
# find the node with the keys in it
my $key_node = $parent_node->getFirstChild();
while ( defined $key_node )
{
if ( $key_node->getNodeType() == XML::DOM::ELEMENT_NODE &&
$key_node->getTagName() eq 'key' )
{
last;
}
$key_node = $key_node->getNextSibling();
}
if ( not defined $key_node )
{
die "No key given for object of ";
}
# get all the attributes into our load hash
my $attrs = $key_node->getAttributes();
for( my $i = 0; $i < $attrs->getLength(); $i++ )
{
my $attr = $attrs->item($i);
$load_args->{$attr->getName()} = $attr->getValue();
}
# actually load the object
my $object = $definition->class_load( $load_args );
return $object;
}
sub _parse_constraints_section
{
my ($criteria, $parent_node) = @_;
my $node = $parent_node->getFirstChild();
while ( defined $node )
{
if ( $node->getNodeType() == XML::DOM::ELEMENT_NODE )
{
my $name = $node->getTagName();
if ( $name eq 'property' or $name eq 'attribute' )
{
my $prop_name = $node->getAttribute('name');
my $cons = _parse_constraint_value( $node );
if ( $name eq 'property' )
{
$criteria->add_prop( $prop_name, $cons->{value}, $cons->{type} );
}
else
{
$criteria->add_attr( $prop_name, $cons->{value}, $cons->{type} );
}
}
elsif ( $name eq 'join-properties' )
{
my $attr_name1 = $node->getAttribute('name1');
my $attr_name2 = $node->getAttribute('name2');
$criteria->join_prop( $attr_name1, $attr_name2 );
}
elsif ( $name eq 'join-attributes' )
{
my $attr_name1 = $node->getAttribute('name1');
my $attr_name2 = $node->getAttribute('name2');
$criteria->join_attr( $attr_name1, $attr_name2 );
}
elsif ( $name eq 'and' or $name eq 'or' )
{
if ( $name eq 'and' and $criteria->get_type() eq 'AND' )
{
# if the criteria is already of the AND type, then we don't need to
# put this is another section.
_parse_constraints_section( $criteria, $node );
}
else
{
my $search;
if ( $name eq 'and' )
{
$search = Xmldoom::Criteria::Search->new( $Xmldoom::Criteria::AND );
}
else
{
$search = Xmldoom::Criteria::Search->new( $Xmldoom::Criteria::OR );
}
_parse_constraints_section( $search, $node );
$criteria->add( $search );
}
}
else
{
die "Unknown constraint tag: $name";
}
}
$node = $node->getNextSibling();
}
}
sub _parse_order_by_section
{
my ($criteria, $parent_node) = @_;
my $node = $parent_node->getFirstChild();
while ( defined $node )
{
if ( $node->getNodeType() == XML::DOM::ELEMENT_NODE )
{
my $tag_name = $node->getTagName();
my $name = $node->getAttribute("name");
my $dir = $node->getAttribute("dir") || undef;
if ( $tag_name eq 'property' )
{
$criteria->add_order_by_prop( $name, $dir );
}
elsif ( $tag_name eq 'attribute' )
{
$criteria->add_order_by_attr( $name, $dir );
}
else
{
die "Unknown order-by tag: $name";
}
}
$node = $node->getNextSibling();
}
}
sub _parse_group_by_section
{
my ($criteria, $parent_node) = @_;
my $node = $parent_node->getFirstChild();
while ( defined $node )
{
if ( $node->getNodeType() == XML::DOM::ELEMENT_NODE )
{
my $tag_name = $node->getTagName();
my $name = $node->getAttribute("name");
if ( $tag_name eq 'property' )
{
$criteria->add_group_by_prop( $name );
}
elsif ( $tag_name eq 'attribute' )
{
$criteria->add_group_by_attr( $name );
}
else
{
die "Unknown order-by tag: $name";
}
}
$node = $node->getNextSibling();
}
}
sub _parse_constraint_value
{
my $parent_node = shift;
my $type;
my $value;
my $node = $parent_node->getFirstChild();
while ( defined $node )
{
if ( $node->getNodeType() == XML::DOM::ELEMENT_NODE )
{
my $name = $node->getTagName();
if ( $name eq 'in' or $name eq 'not-in' or $name eq 'between' )
{
if ( $name eq 'between' )
{
$type = $Xmldoom::Criteria::BETWEEN;
$value = [
$node->getAttribute('min'),
$node->getAttribute('max'),
];
}
else
{
if ( $name eq 'in' )
{
$type = $Xmldoom::Criteria::IN;
}
elsif ( $name eq 'not-in' )
{
$type = $Xmldoom::Criteria::NOT_IN;
}
$value = _parse_value_list( $node );
}
}
else
{
if ( $name eq 'equal' )
{
$type = $Xmldoom::Criteria::EQUAL;
}
elsif ( $name eq 'not-equal' )
{
$type = $Xmldoom::Criteria::NOT_EQUAL;
}
elsif ( $name eq 'greater-than' )
{
$type = $Xmldoom::Criteria::GREATER_THAN;
}
elsif ( $name eq 'greater-equal' )
{
$type = $Xmldoom::Criteria::GREATER_EQUAL;
}
elsif ( $name eq 'less-than' )
{
$type = $Xmldoom::Criteria::LESS_THAN;
}
elsif ( $name eq 'less-equal' )
{
$type = $Xmldoom::Criteria::LESS_EQUAL;
}
elsif ( $name eq 'like' )
{
$type = $Xmldoom::Criteria::LIKE;
}
elsif ( $name eq 'not-like' )
{
$type = $Xmldoom::Criteria::NOT_LIKE;
}
elsif ( $name eq 'is-null' )
{
$type = $Xmldoom::Criteria::IS_NULL;
}
elsif ( $name eq 'is-not-null' )
{
$type = $Xmldoom::Criteria::IS_NOT_NULL;
}
else
{
die "Unknown comparison type: $name";
}
if ( ($name eq 'equal' or $name eq 'not-equal') and
defined $node->getFirstChild() and
$node->getFirstChild()->getNodeType == XML::DOM::ELEMENT_NODE )
{
$value = _parse_object( $node );
}
elsif ( $type eq $Xmldoom::Criteria::IS_NULL or
$type eq $Xmldoom::Criteria::IS_NOT_NULL )
{
# doen't do nothing because these can't take values
}
else
{
$value = get_element_text( $node );
}
}
}
$node = $node->getNextSibling();
}
#if ( $value eq '' )
#{
# $value = undef;
#}
return { type => $type, value => $value };
}
sub _parse_object
{
my $parent_node = shift;
my $node = $parent_node->getFirstChild();
if ( $node->getTagName() ne 'object' )
{
die sprintf "%s tag can only contain text or an tag", $parent_node->getTagName();
}
my %info;
my $attrs = $node->getAttributes();
for( my $i = 0; $i < $attrs->getLength(); $i++ )
{
my $attr = $attrs->item($i);
$info{$attr->getName()} = $attr->getValue();
}
return Xmldoom::Criteria::UnknownObject->new( \%info );
}
sub _parse_value_list
{
my $parent_node = shift;
my $node = $parent_node->getFirstChild();
my @values;
while ( defined $node )
{
if ( $node->getNodeType() == XML::DOM::ELEMENT_NODE )
{
if ( $node->getTagName() eq 'value' )
{
push @values, get_element_text( $node );
}
else
{
die sprintf "Can only list tags inside of %s tag", $parent_node->getTagName();
}
}
$node = $node->getNextSibling();
}
return \@values;
}
1;