File Coverage

blib/lib/DBIx/XMLServer.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# $Id: XMLServer.pm,v 1.19 2005/11/15 22:03:01 mjb47 Exp $

use strict;
use warnings;
use XML::LibXML;
use XML::LibXSLT;

package DBIx::XMLServer;

our $VERSION = '0.02';

my $our_ns = 'http://boojum.org.uk/NS/XMLServer';

my $sql_ns = sub {
  my $node = shift;
  my $uri = shift || $our_ns;
  my $prefix;
  $prefix = $node->lookupNamespacePrefix($uri) and return $prefix;
  for($prefix = 'a'; $node->lookupNamespaceURI($prefix); ++$prefix) {}
  $node->setNamespace($uri, $prefix, 0);
  return $prefix;
};

package DBIx::XMLServer::Field;
use Carp;

our $VERSION = sprintf '%d.%03d', (q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/);

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = {};
  $self->{XMLServer} = shift
    and ref $self->{XMLServer}
      and $self->{XMLServer}->isa('DBIx::XMLServer')
	or croak "No XMLServer object supplied";
  $self->{node} = shift
    and ref $self->{node}
      and $self->{node}->isa('XML::LibXML::Element')
	or croak "No XML element node supplied";
  $self->{node}->namespaceURI eq $our_ns
    and $self->{node}->localname eq 'field'
      or croak "The node is not an  element";
  my $type = $self->{node}->getAttribute('type')
    or croak " element has no `type' attribute";
  $class = $self->{XMLServer}->{types}->{$type}
    or croak "Undefined field type: `$type'";
  bless($self, $class);
  $self->init if $self->can('init');
  return $self;
}

sub where { return '1'; }

sub select {
  my $self = shift;
  my $expr = $self->{node}->getAttribute('expr')
    or die "A  element has no `expr' attribute";
  return $expr;
}

sub join {
  my $self = shift;
  return $self->{node}->getAttribute('join');
}

sub value {
  my $self = shift;
  return shift @{shift()};
}

sub result {
  my $self = shift;
  my $n = shift;

  my $value = $self->value(shift());

  do {
    $value = $n->ownerDocument->createElementNS($our_ns, 'sql:null');
    $value->setAttribute('type',
			 $self->{node}->getAttribute('null') || 'empty');
  } unless defined $value;

  do {
    my $x = $n->ownerDocument->createTextNode($value);
    $value = $x;
  } unless ref $value;

  my $attr = $self->{node}->getAttribute('attribute');

  if($attr) {
    my $x = $n->ownerDocument->createElementNS($our_ns, 'sql:attribute');
    $x->setAttribute('name', $attr);
    $x->appendChild($value);
    $value = $x;
  }

  $n->replaceNode($value);
}

1;

package DBIx::XMLServer::OrderSpec;

our $VERSION = sprintf '%d.%03d', (q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/);

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = {};

  my ($xmlserver, $node, $dir) = @_;
  $self->{field} = new DBIx::XMLServer::Field($xmlserver, $node);
  $self->{dir} = $dir;

  bless($self, $class);
  return $self;
}

sub orderspec {
  my $self = shift;
  my $spec = $self->{field}->select;
  for ($self->{dir}) {
    defined $_ or last;
    /^ascending$/ && do {
      $spec .= ' ASC';
      last;
    };
    /^descending$/ && do {
      $spec .= ' DESC';
      last;
    };
  }
  return $spec;
}

1;

package DBIx::XMLServer::Request;
use Carp;
use Text::Balanced qw(extract_bracketed);

our $VERSION = sprintf '%d.%03d', (q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/);

if ($ lt v5.7)
{
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw(IsNCNameStartChar IsNCNameChar);
}

# Look for an initial segment of the string which looks like an XPath
# pattern
sub get_xpath {
  my $text = shift;

  # Repeatedly skip XPath-like stuff and bracketed things
  while( (extract_bracketed($text, "[(\"'",
			    '[-|@_./:[:alnum:][:space:]]*')) [0]) {};
  # Skip any more XPath-like stuff
  $text =~ m'\G[-|@_./:[:alnum:][:space:]]*'g;

  return substr($text, 0, pos $text), substr($text, pos $text);
}

BEGIN {
  # This hack is because Perl 5.6.1 appears to be buggy and not
  # allow unicode character properties to be declared in a package
  # pther than main.
  our $property_package = $ lt v5.8 ? 'main' : 'DBIx::XMLServer::Request';
  eval <
  package $property_package;

  # These are the ranges defined by XML 1.1, as these
  # are more up-to-date w.r.t Unicode those defined by
  # XML 1.0 (3rd ed).  They're also much simpler to specify.
  sub IsNCNameStartChar {
      return <
41	5A
5F
61	7A
C0	D6
D8	F6
F8	2FF
370	37D
37F	1FFF
200C	200D
2070	218F
2C00	2FEF
3001	D7FF
F900	FDCF
FDF0	FFFD
10000	EFFFF
END
  }

  sub IsNCNameChar {
      return <
2D	2E
30	39
41	5A
5F
61	7A
B7
C0	D6
D8	F6
F8	2FF
300	36F
370	37D
37F	1FFF
200C	200D
203F	2040
2070	218F
2C00	2FEF
3001	D7FF
F900	FDCF
FDF0	FFFD
10000	EFFFF
END
  }

END_PROPERTIES
}

# Definition of NCName as per XML Namespaces 1.1
use utf8;
our $NCName = qr/(?:\p{IsNCNameStartChar}\p{IsNCNameChar}*)/;

sub add_prefix($$) {

  my ( $xpath, $prefix ) = @_;

  while ( $xpath =~ s/
            ^( (?:[^'"]*(?:"[^"]*"|'[^']*'))*[^'"]*
               (?: (?
                 | (?: (?: (?<=[\@([,\/|+-=<>])
                         | (?<=[<>!]=|\/\/|::)
                         | ^)
                       (?: $NCName\s+ $NCName\s+ )*
                     | (?: (?<=[.\])"'])
                         | [0-9]+(?:\.[0-9]+)?\s
                         | \$$NCName(?::$NCName)?\s )
                       \s* $NCName\s+
                       (?: $NCName\s+ $NCName\s+ )* )
                   (?
            ($NCName)
            (\s+[^:(\s]|\s*(?![:(\s])\P{IsNCNameChar}|$)
          /$1$prefix:$2$3/x ) {}

  return $xpath;
}

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self;
  if($#_ <= 1) {
    $self = {};
    $self->{XMLServer} = shift;
    $self->{template} = shift;
  } else {
    $self = { @_ };
  };
  ref $self->{XMLServer}
    and $self->{XMLServer}->isa('DBIx::XMLServer')
      or croak "No XMLServer object supplied";

  $self->{template} or $self->{template} = $self->{XMLServer}->{template};
  $self->{template}->isa('XML::LibXML::Element')
    or croak "Template is not a XML::LibXML::Element";

  $self->{template}->localname eq 'template'
    && $self->{template}->namespaceURI eq $our_ns
      or croak "Template is not ";
  $self->{main_table} = $self->{template}->getAttribute('table')
    or croak "The  element has no `table' attribute";
  $self->{ns} = $self->{template}->getAttribute('default-namespace');
  my $p = &$sql_ns($self->{template});
  $self->{record} = $self->{template}->findnodes(".//$p:record/*[1]")->shift
    or croak "The  element contains no  element";

  $self->{criteria} = [];
  $self->{page} = 0;
  $self->{pagesize} = $self->{XMLServer}->{maxpagesize}
    unless defined $self->{pagesize};
  $self->{rowcount} = $self->{XMLServer}->{rowcount}
    unless defined $self->{rowcount};
  bless($self, $class);
  return $self;
}

sub real_parse {
  my $self = shift;
  my $query = shift or croak "No query string supplied";
  foreach(split /&/, $query) {
    # Un-URL-encode the string
    tr/+/ /;
    s/%([0-9A-Fa-f][0-9A-Fa-f])/chr(hex($1))/eg;
    # Split it into key and condition
    my ($key, $condition) = get_xpath($_);
    $key or return "Unrecognised condition: '$condition'";
    for ($key) {
      /^fields$/ && do {
	$condition =~ s/^=//
	  or return "Expected '=' after 'fields' but found '$condition'";
	$self->{fields} = $condition;
	last;
      };
      /^order$/ && do {
	$condition =~ s/^=//
	  or return "Expected '=' after 'order' but found '$condition'";
	$self->{order} = $condition;
	last;
      };
      /^page$/ && do { # The page number
        $condition =~ /^=([1-9]\d*)$/
	  or return "Unrecognised page number: $condition";
	$self->{page} = $1 - 1;
	last;
      };
      /^pagesize$/ && do { # The page size
        $condition =~ /^=(\d+)$/
	  or return "Unrecognised page size: $condition";
	$self->{pagesize} = $1;
	defined($self->{XMLServer}->{maxpagesize})
	  && $self->{XMLServer}->{maxpagesize} > 0
          and ( ($1 > 0 && $1 <= $self->{XMLServer}->{maxpagesize})
	    or return "Invalid page size: Must be between 1 " .
	      "and $self->{XMLServer}->{maxpagesize}");
	last;
      };
      /^format$/ && $self->{userformat} && do {
          $condition =~ s/^=//
            or return "Expected '=' after 'format' but found '$condition'";
          my $root = $self->{XMLServer}->{doc}->documentElement;
          my $p = &$sql_ns($root);
	  $self->{template} = $root->findnodes("/$p:spec/$p:template[@"
					       . "id='$condition']")->shift
	    or return "Invalid format.  Must be one of "
	      . join(', ', map("'" . $_->value . "'",
			       $root->findnodes("/$p:spec/$p:template/@"."id")))
              . ".";
	  $self->{template}->localname eq 'template'
	    && $self->{template}->namespaceURI eq $our_ns
	    or croak "Template is not ";
	  $self->{main_table} = $self->{template}->getAttribute('table')
	    or croak "The  element has no `table' attribute";
	  $self->{ns} = $self->{template}->getAttribute('default-namespace');
	  $p = &$sql_ns($self->{template});
	  $self->{record} = $self->{template}->findnodes(".//$p:record/*[1]")
	    ->shift
	    or croak "The  element contains no  element";
	  last;
	};
      # Anything else we treat as a search criterion
      push @{$self->{criteria}}, [$key, $condition];
    }
  }
  return undef;
}

sub do_criteria {
  my $self = shift;

  my $prefix = $self->{ns};
  $prefix = &$sql_ns($self->{record}, $self->{ns})
    if defined $self->{ns} && $self->{ns} ne '*';
  my $p = &$sql_ns($self->{record});
  foreach(@{$self->{criteria}}) {
    my $key = $_->[0];
    # Fix up a default namespace
    $key = add_prefix($key, $prefix) if $prefix;
    # Find the field
    my @nodelist = $self->{record}->findnodes($key);
    my $node;
    if(@nodelist eq 1 && $nodelist[0]->isa('XML::LibXML::Attr')) {
      my $name = $nodelist[0]->nodeName;
      my $owner = $nodelist[0]->getOwnerElement;
      my $q = &$sql_ns($owner);
      $node = $owner->findnodes("$q:field[@"."attribute='$name']")->shift
	or return "Attribute '$key' isn't a field";
    } else {
      my @nodes = $self->{record}->findnodes
	($key . "//$p:field[not(@"."attribute)]")
	or return "Unknown field: '$key'";
      @nodes eq 1 or return "Expression '$key' selects more than one field";
      $node = shift @nodes;
    }
    $_->[0] = new DBIx::XMLServer::Field($self->{XMLServer}, $node);
  }
  return undef;
}

sub _prune {
  my $element = shift;
  if($element->getAttributeNS($our_ns, 'keepme')) {
    foreach my $child ($element->childNodes) {
      _prune($child) if $child->isa('XML::LibXML::Element');
    }
  } else {
    $element->unbindNode
      unless ($element->namespaceURI || '') eq $our_ns # Hack to avoid pruning
	&& $element->localname eq 'field'      # attribute fields
	  && $element->getAttribute('attribute');
  }
}

sub build_output {
  my $self = shift;
  my $doc = shift;

  # Create the output structure
  my $new_template = $self->{template}->cloneNode(1);
  $doc->adoptNode($new_template);
  $doc->setDocumentElement($new_template);
  my $p = &$sql_ns($new_template);
  my $record = $new_template->findnodes(".//$p:record")->shift
    or croak "There is no  element in the template";
  $self->{newrecord} = $record->findnodes('*')->shift
    or croak "The  element has no child element";

  $self->{rowcount} = 'NONE'
    unless $new_template->findnodes(".//$p:meta[@ type='rows']")->size();

  # Find the nodes to return
  if(defined $self->{fields}) {
    my $prefix = $self->{ns};
    $prefix = &$sql_ns($self->{newrecord}, $self->{ns})
      if defined $self->{ns} && $self->{ns} ne '*';
    my ($r, $s) = get_xpath($self->{fields});
    return "Unexpected text: '$s'" if $s;
    $r = add_prefix($r, $prefix) if $prefix;
    $self->{fields} = $r;
  } else {
    $self->{fields} = '.';
  }
  my @nodeset = $self->{newrecord}->findnodes
    ("($self->{fields})/descendant-or-self::*");
  @nodeset > 0 or return "No elements match expression $self->{fields}";

  # Mark the subtree containing them
  $self->{newrecord}->setAttributeNS($our_ns, 'keepme', 1);
  foreach my $node (@nodeset) {
    until($node->isa('XML::LibXML::Element') &&
	  $node->getAttributeNS($our_ns, "keepme")) {
      $node->setAttributeNS($our_ns, "keepme", 1)
	if $node->isa('XML::LibXML::Element');
      $node = $node->parentNode;
    }
  }

  # Find the nodes to order by
  if(defined $self->{order}) {
    my $prefix = $self->{ns};
    $prefix = &$sql_ns($self->{newrecord}, $self->{ns})
      if defined $self->{ns} && $self->{ns} ne '*';
    my $order = $self->{order};
    my @order;
    while ( $order ne '' ) {
      my ($xpath, $more) = get_xpath($order);
      $xpath = add_prefix($xpath, $prefix) if $prefix;
      $xpath =~ s/ +(ascending|descending) *$//;
      my $dir = $1;
      my @o = $self->{newrecord}->findnodes($xpath)
	or return "Invalid field in order clause: $xpath\n";
      foreach (@o) {
	my @f = $_->findnodes(
	  $_->nodeType == XML::LibXML::XML_ATTRIBUTE_NODE
	    ? "../$p:field[\@attribute='".$_->nodeName."']"
	    : ".//$p:field" )
	  or return "No non-static data matched by order clause: $xpath\n";
	foreach (@f) {
	  push @order,
	    new DBIx::XMLServer::OrderSpec($self->{XMLServer}, $_, $dir);
	}
      }
      return "Unexpected order: '$order'"
	unless $more eq '' || $more =~ s/^,//;
      $order = $more;
    }
    $self->{order} = \@order;
  }

  # Prune away what we don't want to return
  _prune($self->{newrecord});

  return undef;
}

sub build_fields {
  my $self = shift;
  my @fields;
  my $p = &$sql_ns($self->{newrecord});
  foreach($self->{newrecord}->findnodes(".//$p:field")) {
    push @fields, new DBIx::XMLServer::Field($self->{XMLServer}, $_);
  }
  $self->{fields} = \@fields;
  return undef;
}

sub add_join {
  my ($self, $table) = @_;
  return unless $table;
  do {
    my $root = $self->{XMLServer}->{doc}->documentElement;
    my $p = &$sql_ns($root);
    my $tabledef = $root->find("/$p:spec/$p:table[@"."name='$table']")->shift
      or croak "Unknown table reference: $table";
    my $jointo = $tabledef->getAttribute('jointo');
    my $join = '';
    do {
      $self->add_join($jointo);
      $join = uc $tabledef->getAttribute('join') || '';
      $join .= ' JOIN ';
    } if $jointo;
    my $sqlname = $tabledef->getAttribute('sqlname')
      or croak "Table `$table' has no `sqlname' attribute";
    $join .= "$sqlname AS $table";
    do {
      if(my $using = $tabledef->getAttribute('using')) {
	$join .= " ON $jointo.$using = $table.$using";
      } elsif(my $ref = $tabledef->getAttribute('refcolumn')) {
	my $key = $tabledef->getAttribute('keycolumn')
	  or croak "Table $table has `refcolumn' without `keycolumn'";
	$join .= " ON $jointo.$ref = $table.$key";
      } elsif(my $on = $tabledef->getAttribute('on')) {
	$join .= " ON $on";
      }
    } if $jointo;
    push @{$self->{jointext}}, $join;
    $self->{joinhash}->{$table} = 1;
  } unless $self->{joinhash}->{$table};
}

sub parse {
  my ($self, $arg) = @_;
  my $err;

  $self->{doc} = new XML::LibXML::Document;
  $self->{arg} = $arg;
  $err = $self->real_parse($arg) and return $err;
  $err = $self->do_criteria and return $err;
  $err = $self->build_output($self->{doc}) and return $err;
  $err = $self->build_fields and return $err;

  $self->{jointext} = [];
  $self->{joinhash} = {};
  $self->add_join($self->{main_table});
  foreach my $x (@{$self->{criteria}}) {
    foreach($x->[0]->join) {
      $self->add_join($_);
    }
  }

  my $select;
  my $from;
  my $where;
  my $order;
  my $limit;

  eval {
    $where = join(' AND ', map($_->[0]->where($_->[1]),
				      @{$self->{criteria}})) || '1';
    $from = join(' ', @{$self->{jointext}});
  };
  return $@ if $@;

  $self->{count_query} = "SELECT COUNT(*) FROM $from WHERE $where";

  foreach my $f (@{$self->{fields}}) {
    foreach ($f->join) {
      $self->add_join($_);
    }
  }

  foreach my $o (@{$self->{order}}) {
    foreach ($o->{field}->join) {
      $self->add_join($_);
    }
  }

  eval {
    $select = join(',', map($_->select, @{$self->{fields}})) || '0';
    $order = (defined $self->{order} && scalar @{$self->{order}}) ?
      ' ORDER BY ' . join(',', map($_->orderspec, @{$self->{order}}))
        : '';
    $limit = ($self->{pagesize} > 0) ?
      ' LIMIT ' . ($self->{page} * $self->{pagesize}) . ", $self->{pagesize}"
	: '';
    $from = join(' ', @{$self->{jointext}});
  };
  return $@ if $@;

  $self->{query} = "SELECT $select FROM $from WHERE $where$order$limit";

  return undef;
}

# Process a request
# $results = $xmlout->process();
sub process {
  my $self = shift;
  my %args = @_;
  my $err;

  $self->{query}
    or croak "DBIx::XMLServer::Request: must call parse before process";

  $args{rowcount} = $self->{rowcount} unless $args{rowcount};

  # Do the query
  my $query = $self->{query};
  $query =~ s/^SELECT/SELECT SQL_CALC_FOUND_ROWS/
    if $args{rowcount} eq 'FOUND_ROWS';
  my $sth = $self->{XMLServer}->{dbh}->prepare($query);
  $sth->execute or croak $sth->errstr;

  # Put the data into the result tree
  my $r = $self->{newrecord}->parentNode;
  my @row;
  while(@row = $sth->fetchrow_array) {

    # Clone the template record and insert after the previous record
    $r = $r->parentNode->insertAfter($self->{newrecord}->cloneNode(1), $r);

    # Fill in the values
    my $p = &$sql_ns($self->{newrecord});
    my @n = $r->findnodes(".//$p:field");
    foreach(@{$self->{fields}}) {
      eval { $_->result(shift @n, \@row); };
      return $@ if $@;
    }

  }

  my $rows = 0;
  do {
    my @r;
    @r = $self->{XMLServer}->{dbh}->selectrow_array('SELECT FOUND_ROWS()')
      or croak $self->{XMLServer}->{dbh}->errstr;
    $rows = $r[0];
  } if $args{rowcount} eq 'FOUND_ROWS';
  do {
    my @r;
    @r = $self->{XMLServer}->{dbh}->selectrow_array($self->{count_query})
      or croak $self->{XMLServer}->{dbh}->errstr;
    $rows = $r[0];
  } if $args{rowcount} eq 'COUNT';

  my %params = (
    'args' => $self->{arg},
    'page' => $self->{page},
    'pagesize' => $self->{pagesize},
    'query' => $self->{query},
    'rows' => $rows,
  );

  # Process through XSLT to produce the result
  return $self->{XMLServer}->{xslt}->transform($self->{doc},
    XML::LibXSLT::xpath_to_string(%params));
}

1;

package DBIx::XMLServer;
use Carp;

sub add_type {
  my $self = shift;
  my $type = shift;
  my $name = $type->getAttribute('name')
    or croak("Field type found with no name");

  my $p = &$sql_ns($type);
  my $package_name = $type->findnodes("$p:module");
  if($package_name->size) {
    $package_name = "$package_name";
    eval "use $package_name;";
    croak "Error loading module `$package_name' for field type"
      . " definition `$name':\n$@" if $@;
  } else {
    $package_name = "DBIx::XMLServer::Types::$name";
    my $where = $type->findnodes("$p:where");
    $where = $where->size ? "sub where { $where }" : '';
    my $select = $type->findnodes("$p:select");
    $select = $select->size ? "sub select { $select }" : '';
    my $join = $type->findnodes("$p:join");
    $join = $join->size ? "sub join { $join }" : '';
    my $value = $type->findnodes("$p:value");
    $value = $value->size ? "sub value { $value }" : '';
    my $init = $type->findnodes("$p:init");
    $init = $init->size ? "sub init { $init }" : '';
    my $isa = $type->findnodes("$p:isa");
    $isa = $isa->size ? "$isa" : 'DBIx::XMLServer::Field';
    $isa =~ s/\s+//g;
    eval <
package $package_name;
use XML::LibXML;
our \@ISA = ('$isa');
$init
$select
$where
$join
$value
1;
EOF
    croak "Error compiling field type definition `$name':\n$@" if $@;
  }
  $self->{types}->{$name} = $package_name;
}

# Object constructor
# $xmlout = new DBIx::XMLServer($dbh, $doc[, $template]);
sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self;
  my $doc;

  # Deal with the parameters
  if(ref $_[0]) { # dbh, doc [, template]
    $self = {};
    $self->{dbh} = shift or croak "No database handle supplied";
    $doc = shift or croak "No template file supplied";
    $self->{template} = shift;
  } else { # Named parameters
    $self = { @_ };
    $self->{dbh} or croak "No database handle supplied";
    $doc = $self->{doc} or croak "No template file supplied";
  }
  bless($self, $class);

  my $parser = new XML::LibXML;
  ref $doc or $doc = $parser->parse_file($doc)
    or croak "Couldn't parse template file '$doc'";
  $doc->isa('XML::LibXML::Document')
    or croak "This isn't a XML::LibXML::Document";
  $self->{doc} = $doc;

  my $root = $doc->documentElement;
  $root->localname eq 'spec' && $root->namespaceURI eq $our_ns
    or croak "Document element is not ";

  my $p = &$sql_ns($root);

  # Find all the field type definitions and parse them
  $self->{types} = {};
  foreach($doc->findnodes("/$p:spec/$p:type")) {
    $self->add_type($_);
  }

  # Find the template
  $self->{template}
    or $self->{template} = $doc->find("/$p:spec/$p:template")
        ->shift
      or croak "No  element found";

  $self->{template}->isa('XML::LibXML::Element')
    or croak "Template is not a XML::LibXML::Element";

  $self->{template}->localname eq 'template'
    && $self->{template}->namespaceURI eq $our_ns
      or croak "Template is not ";

  # Parse our XSLT stylesheet
  my $xslt = new XML::LibXSLT;
  my $f = $INC{'DBIx/XMLServer.pm'};
  $f =~ s/XMLServer\.pm/XMLServer\/xmlout\.xsl/;
  my $style_doc = $parser->parse_file($f)
    or croak "Couldn't open stylesheet '$f'";
  $self->{xslt} = $xslt->parse_stylesheet($style_doc)
    or croak "Error parsing stylesheet '$f'";

  $self->{maxpagesize} = 0 unless $self->{maxpagesize};
  $self->{rowcount} = 'NONE' unless defined $self->{rowcount};

  return $self;
}

sub process {
  my $self = shift;
  my %args;
  my $err;

  # Process arguments
  if($#_ <= 1 && $_[0] ne 'query') {
    $args{query} = shift
      or croak "No query string given";
  } else { # Named parameters
    %args = @_;
  }

  $args{XMLServer} = $self;
  my $request = new DBIx::XMLServer::Request(%args);
  $err = $request->parse($args{query}) and return $err;
  return $request->process();
}

1;
__END__