package dinfo;

use Carp;
use PApp::SQL;

$VERSION = 0.1;

sub new {
   my ($class, $dsn, $user, $pass) = @_;

   my $self = bless {
      dbh => (PApp::SQL::connect_cached "dinfo::", $dsn, $user, $pass),
   }, $class;

   $self;
}

=item $result = $dinfo->search (column => type => value, ...)

Initiate a search on the given columns. C<type> can be one of C<exact>,
C<prefix>, C<like>, C<regexp> or C<match>, which specifies the sql-search
mode used. For C<nummer>-columns, only C<exact> and C<prefix> are
supported.

Returns a C<dinfo::result> object.

 my $r = $dinfo->search(name => like => "Marc%");

 my $r = $dinfo->search(plz => exact => 76139, branche => match => "psychologe");

Not all types are efficient on all columns.. check your indices! :)

=cut

my @cols = (
  [ 1 => "name"],
  [ 2 => "vorname"],
  [ 3 => "zusatz1"],
  [ 4 => "zusatz2"],
  [ 5 => "zusatz3"],
  [ 6 => "vorwahl"],
  [ 7 => "strasse"],
  [ 8 => "haus"],
  [ 9 => "plz"],
  [10 => "ort"],
  [11 => "branche"],
);

sub search {
   my ($self, @pred) = @_;

   my @args;
   my $select = "select\n  nummer, " . (join ", ", map "$_->[1].data", @cols) . "\n"
              . "from row\n". (join "", map "  inner join $_->[1] on (row.$_->[1] = $_->[1].id)\n", @cols)
              . "where  (1=1)\n";

   while (@pred) {
      my ($column, $type, $match) = splice @pred, 0, 3, ();
      $select .= "  and ";
      if ($column eq "nummer") {
         $select .= "($column between ? and ?)";
         if ($type eq "exact") {
            push @args, 
               (pack "H*", (substr "${match}000000000000", 0, 12) . sprintf "%x0", 12 - length $match),
               (pack "H*", (substr "${match}000000000000", 0, 12) . sprintf "%xf", 12 - length $match);
         } elsif ($type eq "prefix") {
            push @args, 
               (pack "H*", (substr "${match}00000000000000", 0, 14)),
               (pack "H*", (substr "${match}a0000000000000", 0, 14));
         } else {
            croak "illegal search type '$type', must be one of exact, prefix";
         }
         warn unpack "H*", $args[-2];
         warn unpack "H*", $args[-1];
      } else {
         push @args, $match;
         if ($type eq "exact") {
            $select .= "($column.data = ?)";
         } elsif ($type eq "like") {
            $select .= "($column.data like ?)";
         } elsif ($type eq "prefix") {
            $select .= "($column.data like ?)";
            $args[-1] .= "%";
         } elsif ($type eq "regexp") {
            $select .= "($column.data regexp ?)";
         } elsif ($type eq "match") {
            $select .= "(match $column.data against (?)";
         } else {
            croak "illegal search type '$type', must be one of exact, like, regexp or match";
         }
      }
   }

   my $st = sql_exec $self->{dbh}, $select, @args;

   if ($st) {
      return bless {
         dinfo => $self,
         st    => $st,
      }, dinfo::result;
   } else {
      return ();
   }
}

=head2 dinfo::result

=item $count = $result->rows

=cut

sub dinfo::result::rows {
   $_[0]{st}->rows;
}

=item $hash = $result->fetch

Fetch and return the next result row.

=cut

my %typ;

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

   my $row = $self->{st}->fetchrow_arrayref;

   if ($row) {
      my %r;

      $r{$_->[1]} = $row->[$_->[0]] for @cols;

      my $nummer = unpack "H*", $row->[0];

      my $len = hex substr $nummer, -2, 1;
      my $typ = hex substr $nummer, -1, 1;

      $r{nummer} = substr $nummer, 0, 12 - $len;
      $r{typ}    = $typ{$typ}
                   ||= sql_fetch $self->{dinfo}{dbh},
                                 "select data from typ where id = ?",
                                 $typ;

      \%r;
   } else {
      return ();
   }
}

1;