=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_value {
   sql_insertid sql_exec $_[0]{dbh}, "insert into value values (NULL, ?)", $_[1];
}

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

   my $did = 55;
   my $n = 1;

   my @l;
   my @attr;

   new XML::Parser
      Namespaces => 1,
      NoExpand   => 1,
      Handlers   => {
         Char => sub {
            sql_exec $dbh, "insert into node values (?, ?, ?, 'pcdata', ?)",
                           $did, $n+1, $n+2, $self->new_value($_[1]);
            $n += 2;
         },
         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', ?)",
                           $did, $l, ++$n, $self->name_id($parser->namespace($element), $element);

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

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

   $ol ||= 1;

   my $or = sql_fetch $self->{dbh}, "select r from node where did = ? and l = ?", $did, $ol;
   my $st = sql_exec $self->{dbh}, \my($l, $r, $t, $c),
                     "select l, r, t, c from node where did = ?  and l > ? and r < ? order by l",
                     $did, $ol, $or;

   my $ot;
   my @stack;
   my $doc = "";
   my %ns;
   my $nso;
   my $nsp = "a";

   my $expand_name = sub {
      $ns{$_[0]} ||= $nsp++;
   };

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

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

      if ($t eq "element") {
         my ($ns, $name) = $expand_name->(sql_ufetch $self->{dbh}, "select ns, v from name where i = ?", $c);
         push @stack, [$ol, $or, $ns];
         ($ol, $or) = ($l, $r);

         $doc .= "<$ns";

         my $st = sql_exec $self->{dbh}, "select name.n, , v from
      } elsif ($t eq "pcdata") {
         $c = sql_ufetch $self->{dbh}, "select v from value where i = ?", $c;

         $doc .= "$c";

      } elsif ($t eq "entity") {
      } elsif ($t eq "pi") {
      } elsif ($t eq "doctype") {
      } else {
         die "FATAL: database corrupt, unexpected nodetype '$t'";
      }
   }

   $doc;
}

1;