MonetDB::CLI::MapiPP - MonetDB::CLI implementation, using the Mapi protocol

  Homepage    : http://monetdb.cwi.nl
  SourceForge : http://sourceforge.net/projects/monetdb

package MonetDB::CLI::MapiPP;

use IO::Socket::INET();
use Text::ParseWords();
use strict;
use warnings;

our $VERSION = '0.03';


my %unescape = ( n => "\n", t => "\t", r => "\r", f => "\f");

sub unquote
{
  my ($class, $v) = @_;

  return undef if $v eq 'NULL' || $v eq 'nil';

  if ( $v =~ /^["']/) {
    $v =~ s/^["']//;
    $v =~ s/["']$//;
    $v =~ s/\\(.)/$unescape{$1}||$1/eg;
  }
  return $v;
}


sub connect
{
  my ($class, $host, $port, $user, $pass, $lang) = @_;

  my $h = IO::Socket::INET->new( PeerAddr => $host, PeerPort => $port )
    or die "Handle is undefined: $@";
  <$h>;
  print $h "$user:$pass:$lang:line\n" or die $!;
  while ( local $_ = <$h> ) {
    last if /^\001/;
  }
  bless { h => $h, lang => $lang },'MonetDB::CLI::MapiPP::Cxn';
}


package MonetDB::CLI::MapiPP::Cxn;

sub query
{
  my ($self, $statement) = @_;

  my $h = $self->new_handle;
  $h->query( $statement );

  return $h;
}

sub new_handle
{
  my ($self) = @_;

  bless { p => $self },'MonetDB::CLI::MapiPP::Req';
}

sub DESTROY
{
  my ($self) = @_;

  $self->{h}->close;

  return;
}


package MonetDB::CLI::MapiPP::Req;

sub query
{
  my ($self, $statement) = @_;

  my $lang  = $self->{p}{lang};
  my $h     = $self->{p}{h};
  my $delim = $lang eq 'sql' ? qr(\s*,\s*) : qr(\s+);
  my @err;

  if ( $lang eq 'sql') {
    my @statement = split /\n/, $statement;
    s/--.*// for @statement;  # TODO: -- inside '' (or blocked mode?)
    $statement  = join ' ', @statement;
    $statement .= ';' unless $statement =~ /;$/;
    $statement  = 's' . $statement;
  }
  else {
    $statement  =~ s/\n/ /g;
  }
  print $h $statement,"\n" or die $!;

  $self->finish;

  while ( local $_ = <$h> ) {
    chomp;
    if (/^\[/) {
      die "Incomplete tuple: $_" unless /\]$/;
      s/^\[\s*//;
      s/\s*\]$//;
      my @a = Text::ParseWords::parse_line( qr(\s*,\s*), 0, $_ );
      push @{$self->{rs}}, [ map { MonetDB::CLI::MapiPP->unquote( $_ ) } @a ];
    }
    elsif (/^&(\d) (\d+) (\d+) (\d+)/) {
      $self->{querytype}   = $1 if $self->{querytype}   < 0;
      $self->{id}          = $2 if $self->{id}          < 0;
      $self->{tuplecount}  = $3 if $self->{tuplecount}  < 0;
      $self->{columncount} = $4 if $self->{columncount} < 0;
    }
    elsif (/^&(\d) (\d+)/) {
      $self->{querytype}   = $1 if $self->{querytype}   < 0;
      $self->{tuplecount}  = $2 if $self->{tuplecount}  < 0;
    }
    elsif (/^#\s+\b(.*)\b\s+# (name|type|length)$/) {
      $self->{$2} = [ split $delim, $1 ];
    }
    elsif (/^!/) {
      push @err, $_;
    }
    elsif (/^\001\001/) {
      last;
    }
    elsif (/^\001\002/) {
      die "Incomplete query: $statement";
    }
  }
  $self->{columncount}   = @{$self->{name}} if $self->{columncount} < 0;;
  $self->{columncount} ||= @{$self->{rs}[0]} if $self->{rs}[0];
  $self->{tuplecount}    = @{$self->{rs}} if $lang ne 'sql';

  die join "\n", @err if @err;

  return;
}

sub querytype
{
  my ($self) = @_;

  return $self->{querytype};
}

sub id
{
  my ($self) = @_;

  return $self->{id};
}

sub rows_affected
{
  my ($self) = @_;

  return $self->{tuplecount};
}

sub columncount
{
  my ($self) = @_;

  return $self->{columncount};
}

sub name
{
  my ($self, $fnr) = @_;

  return $self->{name}[$fnr] || '';
}

sub type
{
  my ($self, $fnr) = @_;

  return $self->{type}[$fnr] || '';
}

sub length
{
  my ($self, $fnr) = @_;

  return $self->{length}[$fnr] || 0;
}

sub fetch
{
  my ($self) = @_;

  return if ++$self->{i} > $#{$self->{rs}};
  return $self->{columncount};
}

sub field
{
  my ($self, $fnr) = @_;

  return $self->{rs}[$self->{i}][$fnr];
}

sub finish
{
  my ($self) = @_;

  $self->{$_} = -1 for qw(querytype id tuplecount columncount i);
  $self->{$_} = [] for qw(rs name type length);

  return;
}

sub DESTROY
{
  my ($self) = @_;

  return;
}

__PACKAGE__;