Permalink
Browse files

interim save, field [0] from mysql_fetch_row returns ok but higher on…

…es do not
  • Loading branch information...
1 parent 1e62099 commit a223fb928bfa1411298c498bc720dacdbbc6607b Martin Berends committed Mar 3, 2010
Showing with 60 additions and 39 deletions.
  1. +31 −30 examples/mysqlclient.p6
  2. +29 −9 lib/NativeCall.pm
View
@@ -11,74 +11,74 @@
use NativeCall;
-class CPointer { ... }
-# hack compensating for too-late import of CPointer from NativeCall.pm
+class OpaquePointer { ... }
+# hack compensating for too-late import of OpaquePointer from NativeCall.pm
# ------------------- foreign function definitions ---------------------
-sub mysql_init( CPointer $mysql_client)
- returns CPointer
+sub mysql_init( OpaquePointer $mysql_client)
+ returns OpaquePointer
is native('libmysqlclient')
{ ... }
-sub mysql_real_connect( CPointer $mysql_client, Str $host, Str $user,
+sub mysql_real_connect( OpaquePointer $mysql_client, Str $host, Str $user,
Str $password, Str $database, Int $port, Str $socket, Int $flag )
- returns CPointer
+ returns OpaquePointer
is native('libmysqlclient')
{ ... }
-sub mysql_error( CPointer $mysql_client)
+sub mysql_error( OpaquePointer $mysql_client)
returns Str
is native('libmysqlclient')
{ ... }
-sub mysql_stat( CPointer $mysql_client)
+sub mysql_stat( OpaquePointer $mysql_client)
returns Str
is native('libmysqlclient')
{ ... }
-sub mysql_get_client_info( CPointer $mysql_client)
+sub mysql_get_client_info( OpaquePointer $mysql_client)
returns Str
is native('libmysqlclient')
{ ... }
-sub mysql_query( CPointer $mysql_client, Str $sql_command )
+sub mysql_query( OpaquePointer $mysql_client, Str $sql_command )
returns Int
is native('libmysqlclient')
{ ... }
-sub mysql_store_result( CPointer $mysql_client )
- returns CPointer
+sub mysql_store_result( OpaquePointer $mysql_client )
+ returns OpaquePointer
is native('libmysqlclient')
{ ... }
-sub mysql_use_result( CPointer $mysql_client )
- returns CPointer
+sub mysql_use_result( OpaquePointer $mysql_client )
+ returns OpaquePointer
is native('libmysqlclient')
{ ... }
-sub mysql_field_count( CPointer $mysql_client )
+sub mysql_field_count( OpaquePointer $mysql_client )
returns Int
is native('libmysqlclient')
{ ... }
-sub mysql_fetch_row( CPointer $result_set )
- returns CPointer
+sub mysql_fetch_row( OpaquePointer $result_set )
+ returns Positional of Str
is native('libmysqlclient')
{ ... }
-sub mysql_num_rows( CPointer $result_set )
+sub mysql_num_rows( OpaquePointer $result_set )
returns Int
is native('libmysqlclient')
{ ... }
-sub mysql_fetch_field( CPointer $result_set )
- returns CPointer
+sub mysql_fetch_field( OpaquePointer $result_set )
+ returns OpaquePointer
is native('libmysqlclient')
{ ... }
-sub mysql_free_result( CPointer $result_set )
- returns CPointer
+sub mysql_free_result( OpaquePointer $result_set )
+ returns OpaquePointer
is native('libmysqlclient')
{ ... }
@@ -89,24 +89,24 @@ my $client = mysql_init( pir::null__P() );
print mysql_error($client);
say "real_connect";
-mysql_real_connect( pir::descalarref__PP($client), 'localhost', 'testuser',
- 'testpass', 'mysql', 0, pir::null__P(), 0 );
+mysql_real_connect( $client, 'localhost', 'testuser', 'testpass',
+ 'mysql', 0, pir::null__P(), 0 );
print mysql_error($client);
say "DROP DATABASE zavolaj";
-mysql_query( pir::descalarref__PP($client), "
+mysql_query( $client, "
DROP DATABASE zavolaj
");
print mysql_error($client);
say "CREATE DATABASE zavolaj";
-mysql_query( pir::descalarref__PP($client), "
+mysql_query( $client, "
CREATE DATABASE zavolaj
");
print mysql_error($client);
say "USE zavolaj";
-mysql_query( pir::descalarref__PP($client), "
+mysql_query( $client, "
USE zavolaj
");
print mysql_error($client);
@@ -118,7 +118,7 @@ print "get_client_info: ";
say mysql_get_client_info($client);
say "CREATE TABLE nom";
-mysql_query( pir::descalarref__PP($client),"
+mysql_query( $client,"
CREATE TABLE nom (
name char(4),
description char(30),
@@ -129,7 +129,7 @@ mysql_query( pir::descalarref__PP($client),"
print mysql_error($client);
say "INSERT nom";
-mysql_query( pir::descalarref__PP($client), "
+mysql_query( $client, "
INSERT nom (name, description, quantity, price)
VALUES ( 'BUBH', 'Hot beef burrito', 1, 4.95 ),
( 'TAFM', 'Mild fish taco', 1, 4.85 ),
@@ -138,7 +138,7 @@ mysql_query( pir::descalarref__PP($client), "
print mysql_error($client);
say "SELECT *, quantity*price AS amount FROM nom";
-mysql_query( pir::descalarref__PP($client), "
+mysql_query( $client, "
SELECT *, quantity*price AS amount FROM nom
");
print mysql_error($client);
@@ -170,6 +170,7 @@ if $batch-mode {
# It would be better to be able to call mysql_fetch_fields().
loop ( my $field_number=0; $field_number<$field_count; $field_number++ ) {
print "field $field_number ";
+ print $row_data[$field_number];
# my $field = mysql_fetch_field( $result_set );
}
say " ";
View
@@ -2,26 +2,46 @@ class OpaquePointer { }
class NativeArray {
has $!unmanaged;
+ has $!of;
has $!max-index = -1;
method postcircumfix:<[ ]>($idx) {
+ say "in postcircumfix:<[ ]>($idx)";
if $idx > $!max-index {
self!update-desc-to-index($idx);
}
- $!unmanaged[$idx]
+ say "trying to index";
+ Q:PIR {
+ $P0 = find_lex 'self'
+ $P0 = getattribute $P0, '$!unmanaged'
+ $P1 = find_lex '$idx'
+ $S0 = $P0[$P1]
+ %r = box $S0
+ };
}
method !update-desc-to-index($idx) {
+ say "in update-desc-to-index($idx)";
my $fpa = pir::new__Ps('FixedIntegerArray');
pir::set__vPi($fpa, 3);
- given self.of {
- when Str { $fpa[0] = -70 }
- when Int { $fpa[0] = -92 }
- when Num { $fpa[0] = -83 }
+ my $typeid;
+ given $!of {
+ when Str { $typeid = -70 }
+ when Int { $typeid = -92 }
+ when Num { $typeid = -83 }
+ default { die "Unknown type"; }
}
- $fpa[1] = $idx + 1;
- $fpa[2] = 0;
- pir::set__vPP($!unmanaged, $fpa);
+ Q:PIR {
+ $P0 = find_lex '$fpa'
+ $P1 = find_lex '$typeid'
+ $P0[0] = $P1
+ $P1 = find_lex '$idx'
+ $I0 = $P1
+ inc $I0
+ $P0[1] = $I0
+ $P0[2] = 0
+ };
+ pir::assign__vPP(pir::descalarref__PP($!unmanaged), $fpa);
}
}
@@ -50,7 +70,7 @@ our sub make-mapper(Mu $type) {
given $type {
when Positional {
-> \$unmanaged-struct {
- NativeArray.new(unmanaged => $unmanaged-struct) does $type
+ NativeArray.new(unmanaged => $unmanaged-struct, of => $type.of)
}
}
default { -> \$x { $x } }

0 comments on commit a223fb9

Please sign in to comment.