Merge pull request #35 from Skarsnik/master

Add row and allrows method that return typed value when possible and offer adverbs to change the way values are returned

META.info

@@ -1,4 +1,5 @@
 {
+    "perl"	    : "6",
     "name"          : "DBIish",
     "version"       : "*",
     "description"   : "Database connectivity for Perl 6",

README.pod

@@ -44,8 +44,8 @@ DBIish - a simple database interface for Rakudo Perl 6
 
     $sth.execute();
 
-    my $arrayref = $sth.fetchall_arrayref();
-    say $arrayref.elems; # 3
+    my @rows = $sth.allrows();
+    say @rows.elems; # 3
 
     $sth.finish;
 
@@ -63,9 +63,31 @@ a subset of the functionality).
 It is based on Martin Berends' MiniDBI project, but unlike MiniDBI, DBDish
 aims to provide an interface that takes advantage of Perl 6 idioms
 
-Unlike Perl 5's DBI, it provides a C<fetchrow_typedhash> and C<fetchall_typedhash> 
-methods on DBD::StatementHandle that returns a hash with Perl6 typed value by oposition
-to everything in Str (implemented only in Pg for now).
+=head2 Fetching data
+
+DBIish provides nearly all the perl5 DBI fetch* method to fetch values from the C<StatementHandle> object.
+However it's recommanded to use the C<row> and C<allrows> method. They provide you typed value when possible
+
+=head3 row
+
+C<row> take the C<hash> adverb if you want to have the values in a hash form instead of a plain array
+
+Example:
+
+    my @values = $sth.row();
+    my %values = $sth.row(:hash);
+
+=head3 allrows
+
+C<allrows> returns all the row as an array of arrays.
+If you want to fetch the values in a hash form, use one of the two adverbs C<array-of-hash>
+and C<hash-of-array>
+
+Example:
+
+    my @datas = $sth.allrows(); # [[1, 2, 3], [4, 5, 6]]
+    my @datas = $sth.allrows(:array-of-hash); # [ ( a => 1, b => 2), ( a => 3, b => 4) ]
+    my %datas = $sth.allrows(:hash-of-array); # a => [1, 3], b => [2, 4]
 
 =head1 INSTALLATION
 

lib/DBDish/Pg/StatementHandle.pm6

@@ -76,6 +76,46 @@ method rows() {
     }
 }
 
+method _row(:$hash) {
+    my @row_array;
+    my %ret_hash;
+    return Any if $!current_row >= $!row_count;
+
+    unless defined $!field_count {
+        $!field_count = PQnfields($!result);
+    }
+    my @names = self.column_names if $hash;
+    my @types = self.column_p6types;
+    if defined $!result {
+        self!reset_errstr;
+        my $afield = False;
+        for ^$!field_count {
+            FIRST {
+                $afield = True;
+            }
+            my $res := PQgetvalue($!result, $!current_row, $_);
+            if $res eq '' {
+                $res := Str if PQgetisnull($!result, $!current_row, $_)
+            }
+            my $value;
+            given (@types[$_]) {
+                $value = $res when 'Str';
+                $value = $res.Num when 'Num';
+                $value = $res.Int when 'Int';
+                $value = self.true_false($res) when 'Bool';
+                $value = $res.Real when 'Real';
+            }
+            $hash ?? (%ret_hash{@names[$_]} = $value) !! @row_array.push($value);
+        }
+        $!current_row++;
+        self!handle-errors;
+
+        if ! $afield { self.finish; }
+    }
+    $hash ?? return %ret_hash !! return @row_array;
+}
+
+
 method fetchrow() {
     my @row_array;
     return () if $!current_row >= $!row_count;

lib/DBDish/Role/StatementHandle.pm6

@@ -15,6 +15,8 @@ method finish() { ... }
 method fetchrow() { ... }
 method execute(*@) { ... }
 
+method	_row(:$hash) { ... }
+
 method column_p6types { die "The selected backend does not support/implement typed value" }
 # Used by fetch* typedhash
 method true_false { return True }
@@ -23,7 +25,36 @@ method fetchrow-hash() {
     hash self.column_names Z=> self.fetchrow;
 }
 
-method fetchall_typedhash {
+method row(:$hash) {
+     self._row(:hash($hash));
+}
+
+method allrows(:$array-of-hash, :$hash-of-array) {
+    my @rows;
+    die "You can't use array-of-hash with hash-of-array" if $array-of-hash and $hash-of-array;
+    if $array-of-hash {
+        while self.row(:hash) -> %row {
+            @rows.push(%row);
+        }
+        return @rows;
+    }
+    if $hash-of-array {
+        my @names := self.column_names;
+        my %rows = @names Z=> [] xx *;
+        while self.row -> @a {
+            for @a Z @names -> ($v, $n) {
+                %rows{$n}.push: $v;
+            }
+        }
+        return %rows;
+    }
+    while self.row -> @r {
+         @rows.push(@r);
+    }
+    return @rows;
+}
+
+method fetchall_typedhash is DEPRECATED("allrows(:hash-of-array)"){
     my @names = self.column_names;
     my @types = self.column_p6types;
     my %res = @names Z=> [] xx *;
@@ -36,7 +67,7 @@ method fetchall_typedhash {
     return %res;
 }
 
-method fetchrow_typedhash {
+method fetchrow_typedhash is DEPRECATED("row(:hash)") {
     my Str @values = self.fetchrow_array;
     return Any if !@values.defined;
     my @names = self.column_names;
@@ -97,4 +128,4 @@ method fetch() {
     $.fetchrow;
 }
 
-method fetchall_arrayref { [ self.fetchall-array.eager ] }
+method fetchall_arrayref  { [ self.fetchall-array.eager ] }

lib/DBDish/SQLite/Connection.pm6

@@ -1,10 +1,11 @@
 
 use v6;
 
+use NativeCall;
 need DBDish::Role::Connection;
 need DBDish::SQLite::StatementHandle;
 use DBDish::SQLite::Native;
-use NativeCall;
+
 
 unit class DBDish::SQLite::Connection does DBDish::Role::Connection;
 

lib/DBDish/SQLite/Native.pm6

@@ -36,6 +36,15 @@ enum SQLITE is export (
     SQLITE_DONE      =>   101, #  sqlite3_step() has finished executing
 );
 
+
+enum SQLITE_TYPE is export (
+    SQLITE_INTEGER => 1,
+    SQLITE_FLOAT   => 2,
+    SQLITE_TEXT    => 3,
+    SQLITE_BLOB    => 4,
+    SQLITE_NULL    => 5
+);
+
 constant LIB = %*ENV<DBIISH_SQLITE_LIB> || 'libsqlite3';
 
 sub sqlite3_errmsg(OpaquePointer $handle)

lib/DBDish/SQLite/StatementHandle.pm6

@@ -1,9 +1,10 @@
 
 use v6;
 
+use NativeCall;
 need DBDish::Role::StatementHandle;
 use DBDish::SQLite::Native;
-use NativeCall;
+
 
 unit class DBDish::SQLite::StatementHandle does DBDish::Role::StatementHandle;
 
@@ -14,6 +15,7 @@ has $.dbh;
 has Int $!row_status;
 has @!mem_rows;
 has @!column_names;
+has $!finished = False;
 
 method !handle-error(Int $status) {
     return if $status == SQLITE_OK;
@@ -23,6 +25,7 @@ method !handle-error(Int $status) {
 submethod BUILD(:$!conn, :$!statement, :$!statement_handle, :$!dbh) { }
 
 method execute(*@params) {
+    die "Finish was previously called on the StatementHandle" if $!finished;
     sqlite3_reset($!statement_handle) if $!statement_handle.defined;
     @!mem_rows = ();
     my @strings;
@@ -56,6 +59,34 @@ method column_names {
     @!column_names;
 }
 
+
+method _row (:$hash) {
+    my @row;
+    my %hash;
+    die 'row without prior execute' unless $!row_status.defined;
+    return Any if $!row_status == SQLITE_DONE;
+    my Int $count = sqlite3_column_count($!statement_handle);
+    for ^$count  -> $col {
+        my $value;
+        given sqlite3_column_type($!statement_handle, $col) {
+            when SQLITE_INTEGER {
+                 $value = sqlite3_column_int64($!statement_handle, $col);
+            }
+            when SQLITE_FLOAT {
+                 $value = sqlite3_column_double($!statement_handle, $col);
+            }
+            default { 
+                $value = sqlite3_column_text($!statement_handle, $col);
+            }
+        }
+        $hash ?? (%hash{sqlite3_column_name($!statement_handle, $col)} = $value) !! @row.push: $value;
+    }
+    $!row_status = sqlite3_step($!statement_handle);
+
+    $hash ?? %hash !! @row;
+}
+
+
 method fetchrow {
     my @row;
     die 'fetchrow_array without prior execute' unless $!row_status.defined;
@@ -73,5 +104,6 @@ method finish {
     sqlite3_finalize($!statement_handle) if $!statement_handle.defined;
     $!row_status = Int;;
     $!dbh._remove_sth(self);
+    $!finished = True;
     True;
 }

lib/DBDish/TestMock/Connection.pm6

@@ -3,6 +3,7 @@ use v6;
 
 use  DBDish::Role::Connection;
 need DBDish::TestMock::StatementHandle;
+need DBDish::Role::Connection;
 
 unit class DBDish::TestMock::Connection does DBDish::Role::Connection;
 

lib/DBDish/TestMock/StatementHandle.pm6

@@ -16,6 +16,7 @@ has Int $!current_idx = 0;
 
 method execute(*@)  { $!current_idx = 0; @data.elems }
 method rows         { @data.elems }
+method _row	    {self.fetchrow}
 
 method fetchrow     { (@data[$!current_idx++] // ()).list }
 method column_names { @column_names }

lib/DBDish/mysql/Connection.pm6

@@ -1,10 +1,11 @@
 
 use v6;
+use NativeCall;
 
 need DBDish::Role::Connection;
 need DBDish::mysql::StatementHandle;
 use DBDish::mysql::Native;
-use NativeCall;
+
 
 unit class DBDish::mysql::Connection does DBDish::Role::Connection;
 

lib/DBDish/mysql/Native.pm6

@@ -7,6 +7,69 @@ unit module DBDish::mysql::Native;
 
 constant LIB = %*ENV<DBIISH_MYSQL_LIB> || 'libmysqlclient';
 
+#From mysql_com.h
+enum mysql-field-type is export (
+  MYSQL_TYPE_DECIMAL => 0, MYSQL_TYPE_TINY => 1,
+  MYSQL_TYPE_SHORT => 2,  MYSQL_TYPE_LONG => 3,
+  MYSQL_TYPE_FLOAT => 4,  MYSQL_TYPE_DOUBLE => 5,
+  MYSQL_TYPE_NULL => 6,   MYSQL_TYPE_TIMESTAMP => 7,
+  MYSQL_TYPE_LONGLONG => 8,MYSQL_TYPE_INT24 => 9,
+  MYSQL_TYPE_DATE => 10,   MYSQL_TYPE_TIME => 11,
+  MYSQL_TYPE_DATETIME => 12, MYSQL_TYPE_YEAR => 13,
+  MYSQL_TYPE_NEWDATE => 14, MYSQL_TYPE_VARCHAR => 15,
+  MYSQL_TYPE_BIT => 16,
+  MYSQL_TYPE_NEWDECIMAL => 246,
+  MYSQL_TYPE_ENUM => 247,
+  MYSQL_TYPE_SET => 248,
+  MYSQL_TYPE_TINY_BLOB => 249,
+  MYSQL_TYPE_MEDIUM_BLOB => 250,
+  MYSQL_TYPE_LONG_BLOB => 251,
+  MYSQL_TYPE_BLOB => 252,
+  MYSQL_TYPE_VAR_STRING => 253,
+  MYSQL_TYPE_STRING => 254,
+  MYSQL_TYPE_GEOMETRY => 255
+);
+
+constant %mysql-type-conv is export = (
+  MYSQL_TYPE_DECIMAL.value => 'Num', MYSQL_TYPE_TINY.value => 'Int', #Tiny is used for Bool
+  MYSQL_TYPE_SHORT.value => 'Int',  MYSQL_TYPE_LONG.value => 'Int',
+  MYSQL_TYPE_FLOAT.value => 'Num',  MYSQL_TYPE_DOUBLE.value => 'Num',
+  MYSQL_TYPE_NULL.value => 'Str',
+  MYSQL_TYPE_TIMESTAMP.value => 'Int',
+  MYSQL_TYPE_LONGLONG.value => 'Int', MYSQL_TYPE_INT24.value => 'Int',
+  MYSQL_TYPE_DATE.value => 'Str',   MYSQL_TYPE_TIME.value => 'Str',
+  MYSQL_TYPE_DATETIME.value => 'Str', MYSQL_TYPE_YEAR.value => 'Int',
+  MYSQL_TYPE_NEWDATE.value => 'Str', MYSQL_TYPE_VARCHAR.value => 'Str',
+  MYSQL_TYPE_BIT.value => 'Int',
+  MYSQL_TYPE_NEWDECIMAL.value => 'Num',
+  MYSQL_TYPE_ENUM.value => 'Str'
+ # Meh the default will be Str
+).hash;
+
+class MYSQL_FIELD is repr('CStruct') is export {
+    has	Str	$.name;
+    has Str	$.org_name;
+    has Str	$.table;
+    has Str	$.org_table;
+    has Str	$.db;
+    has Str	$.catalog;
+    has	Str	$.def;
+    has ulong	$.length;
+    has ulong	$.max_length;
+    has uint32	$.name_length;
+    has uint32	$.org_name_length;
+    has uint32	$.table_length;
+    has	uint32	$.org_table_length;
+    has uint32	$.db_length;
+    has uint32	$.catalog_length;
+    has uint32	$.def_length;
+    has uint32	$.flags;
+    has uint32	$.decimals;
+    has uint32	$.charsetnr;
+    has int32	$.type;
+    has Pointer $.extension;
+}
+
 #------------ mysql library functions in alphabetical order ------------
 
 sub mysql_affected_rows( OpaquePointer $mysql_client )
@@ -27,7 +90,7 @@ sub mysql_error( OpaquePointer $mysql_client)
     { ... }
 
 sub mysql_fetch_field( OpaquePointer $result_set )
-    returns CArray[Str]
+    returns Pointer[MYSQL_FIELD]
     is native(LIB)
     is export
     { ... }
@@ -62,7 +125,7 @@ sub mysql_insert_id( OpaquePointer $mysql_client )
     { ... }
 
 sub mysql_num_rows( OpaquePointer $result_set )
-    returns Int
+    returns ulonglong
     is native(LIB)
     is export
     { ... }
@@ -74,7 +137,7 @@ sub mysql_query( OpaquePointer $mysql_client, str $sql_command )
     { ... }
 
 sub mysql_real_connect( OpaquePointer $mysql_client, Str $host, Str $user,
-    Str $password, Str $database, int32 $port, Str $socket, Int $flag )
+    Str $password, Str $database, int32 $port, Str $socket, ulong $flag )
     returns OpaquePointer
     is native(LIB)
     is export
@@ -98,7 +161,7 @@ sub mysql_stmt_init( OpaquePointer $mysql_client )
     is export
     { ... }
 
-sub mysql_stmt_prepare( OpaquePointer $mysql_stmt, Str, Int $length )
+sub mysql_stmt_prepare( OpaquePointer $mysql_stmt, Str, ulong $length )
     returns OpaquePointer
     is native(LIB)
     is export