=head1 NAME

XML::DB - emulate a native xml database using DBI

=head1 SYNOPSIS

=head1 DESCRIPTION

Ehrm... ;)

=head1 FUNCTIONS

=head1 SEE ALSO

=head1 AUTHOR

This perl extension was written by Marc Lehmann <pcg@goof.com>

=head1 BUGS

=cut

package XML::DB;

use XML::Parser;
use PApp::SQL;

#require Exporter;
BEGIN {
   $VERSION = 0.01;

   use base DynaLoader;

   bootstrap XML::DB $VERSION;
}

sub new {
   my $class = shift;
   bless { @_ }, $class;
}

sub seq {
   sql_insertid sql_exec "update $_[0]_seq set n = last_insert_id(n + 1)";
}

sub name_id {
   # not threadsafe
   sql_ufetch $_[0]{dbh}, "select i from name where n = ? and v = ?", "$_[1]", $_[2]
      or sql_insertid sql_exec $_[0]{dbh}, "insert into name values (NULL, ?, ?)", "$_[1]", $_[2];

}

sub new_xml_insert_parser {
   my $self = shift;
   my $dbh = $self->{dbh};

   my $did = 55;
   my $max = 1 + sql_fetch $dbh, "select max(l) from node";

   my $n = $max + 1;

   my @l;
   my @attr;

   new XML::Parser
      Namespaces => 1,
      NoExpand   => 1,
      Handlers   => {
         Comment => sub {
            ++$n;
            sql_exec $dbh, "insert into node values (?, ?, 'comment', NULL)",
                           $n, $n+1;
            sql_exec $dbh, "insert into value values (?, ?)",
                           $n, $_[1];
            ++$n;
         },
         Char => sub {
            ++$n;
            sql_exec $dbh, "insert into node values (?, ?, 'pcdata', NULL)",
                           $n, $n+1;
            sql_exec $dbh, "insert into value values (?, ?)",
                           $n, $_[1];
            ++$n;
         },
         Start => sub {
            my ($parser, $element, @attrs) = @_;
            push @l, ++$n;
            push @attr, \@attrs;
         },
         End => sub {
            my ($parser, $element) = @_;
            my $attr = pop @attr;
            my $l = pop @l;
            sql_exec $dbh, "insert into node values (?, ?, 'element', ?)",
                           $l, ++$n, $self->name_id($parser->namespace($element), $element);

            for (my $i = 0; $i < @$attr;  $i += 2) {
               sql_exec $dbh, "insert into attr values (?, ?, ?)",
                              $l, $self->name_id($parser->namespace($attr->[$i]), $attr->[$i]),
                              $attr->[$i+1];
            }
         },
         Final => sub {
            sql_exec $dbh, "insert into node values (?, ?, 'root', NULL)",
                           $max*1, ++$n;
         },
      },
      @_,
   ;
}

sub get_fragment {
   my ($self, $ol) = @_;

   my $or = sql_fetch $self->{dbh}, "select r from node where l = ?", $ol;
   my $st = sql_exec $self->{dbh}, \my($l, $r, $t, $ns, $name, $value),
                     "select node.l, node.r, node.t, name.n, name.v, value.v
                      from node left join name on (node.n = name.i)
                                left join value on (node.l = value.l)
                      where node.l > ? and node.r < ? order by node.l",
                     $ol, $or;

   my $ot;
   my @stack;
   my $doc = "";
   my (%nsp, $nsps, $nso);
   my $nsp = "a";

   my $expand_name = sub {
      $_[0] ? ($nsp{$_[0]} ||= do {
                      $nsps .= " xmlns:$nsp='$_[0]'";
                      $nsp++;
                   }) . ":$_[1]"
            : $_[1];
   };

   while ($st->fetch) {
      if ($l > $or) {
         ($ol, $or, $oc) = @{pop @stack};

         $doc .= "</$oc>";
      }

      if ($t eq "element") {
         push @stack, [$ol, $or, $name];
         ($ol, $or) = ($l, $r);

         $doc .= "<" . $expand_name->($ns, $name);
         $nso ||= length $doc;

         my $st = sql_exec $self->{dbh}, \my($ns, $name, $value),
                           "select name.n, name.v, attr.v
                            from attr inner join name on (attr.k = name.i)
                            where attr.l = ?",
                           $l;
         while ($st->fetch) {
            $doc .= " " . $expand_name->($ns, $name) . "='" . $value ."'";
         }
         
         $doc .= ">";
      } elsif ($t eq "pcdata" or $t eq "comment") {
         $doc .= $value;
      } elsif ($t eq "entity") {
      } elsif ($t eq "pi") {
      } elsif ($t eq "doctype") {
      } else {
         die "FATAL: database corrupt, unexpected nodetype '$t'";
      }
   }

   substr $doc, $nso, 0, $nsps;
   $doc;
}

1;