unmaintained/mysql/mysql.factor

   1 ! See http://factorcode.org/license.txt for license.
   2 ! Copyright (C) 2007 Berlin Brown
   3 ! Date: 1/17/2007
   4 !
   5 ! libs/mysql/mysql.factor
   6 !
   7 ! Adapted from mysql.h and mysql.c
   8 ! Tested with MySQL version - 5.0.24a
   9
  10 IN: mysql
  11 USING: kernel alien errors io prettyprint
  12     sequences namespaces arrays math tools generic ;
  13
  14 SYMBOL: my-conn
  15
  16 TUPLE: mysql-connection mysqlconn host user password db port handle resulthandle ;
  17
  18 : init-mysql ( -- conn )
  19     f mysql_init ;
  20
  21 C: mysql-connection ( host user password db port -- mysql-connection )
  22     [ set-mysql-connection-port ] keep
  23     [ set-mysql-connection-db ] keep
  24     [ set-mysql-connection-password ] keep
  25     [ set-mysql-connection-user ] keep
  26     [ set-mysql-connection-host ] keep ;
  27
  28 : (mysql-error) ( mysql-connection -- str )
  29     mysql-connection-mysqlconn mysql_error ;
  30
  31 : connect-error-msg ( mysql-connection -- s )
  32     mysql-connection-mysqlconn mysql_error
  33     [
  34         "Couldn't connect to mysql database.\n" %
  35         "Message: " % %
  36     ] "" make ;
  37
  38 : mysql-connect ( mysql-connection -- )
  39     init-mysql swap
  40     [ set-mysql-connection-mysqlconn ] 2keep
  41     [ mysql-connection-host ] keep
  42     [ mysql-connection-user ] keep
  43     [ mysql-connection-password ] keep
  44     [ mysql-connection-db ] keep
  45     [ mysql-connection-port f 0 mysql_real_connect ] keep
  46     [ set-mysql-connection-handle ] keep
  47     dup mysql-connection-handle
  48     [ connect-error-msg throw ] unless ;
  49
  50 ! =========================================================
  51 ! Low level mysql utility definitions
  52 ! =========================================================
  53
  54 : (mysql-query) ( mysql-connection query -- ret )
  55     >r mysql-connection-mysqlconn r> mysql_query ;
  56
  57 : (mysql-result) ( mysql-connection -- ret )
  58     [ mysql-connection-mysqlconn mysql_use_result ] keep
  59     [ set-mysql-connection-resulthandle ] keep ;
  60
  61 : (mysql-affected-rows) ( mysql-connection -- n )
  62     mysql-connection-mysqlconn mysql_affected_rows ;
  63
  64 : (mysql-free-result) ( mysql-connection -- )
  65     mysql-connection-resulthandle drop ;
  66
  67 : (mysql-row) ( mysql-connection -- row )
  68     mysql-connection-resulthandle mysql_fetch_row ;
  69
  70 : (mysql-num-cols) ( mysql-connection -- n )
  71     mysql-connection-resulthandle mysql_num_fields ;
  72
  73 : mysql-char*-nth ( index object -- str )
  74     #! Utility based on 'char*-nth' to perform an additional sanity check on the value
  75     #! extracted from the array of strings.
  76     void*-nth [ alien>char-string ] [ "" ] if* ;
  77
  78 : mysql-row>seq ( object n -- seq )
  79     [ swap mysql-char*-nth ] map-with ;
  80
  81 : (mysql-result>seq) ( seq -- seq )
  82     my-conn get (mysql-row) dup [
  83         my-conn get (mysql-num-cols) mysql-row>seq
  84         over push
  85         (mysql-result>seq)
  86     ] [ drop ] if
  87     ! Perform needed cleanup on fetched results
  88     my-conn get (mysql-free-result) ;
  89
  90 ! =========================================================
  91 !  Public Word Definitions
  92 ! =========================================================
  93
  94 : mysql-close ( mysql-connection -- )
  95     mysql-connection-mysqlconn mysql_close ;
  96
  97 : mysql-print-table ( seq -- )
  98     [ [ write bl ] each "\n" write ] each ;
  99
 100 : mysql-query ( query -- ret )
 101     >r my-conn get r> (mysql-query) drop
 102     my-conn get (mysql-result) ;
 103
 104 : mysql-command ( query -- n )
 105     mysql-query drop
 106     my-conn get (mysql-affected-rows) ;
 107
 108 : mysql-error ( -- s )
 109     #! Get the last mysql error
 110     my-conn get (mysql-error) ;
 111
 112 : mysql-result>seq ( -- seq )
 113     V{ } clone (mysql-result>seq) ;
 114
 115 : with-mysql ( host user password db port quot -- )
 116     [
 117         >r <mysql-connection> my-conn set
 118             my-conn get mysql-connect drop r>
 119         [ my-conn get mysql-close ] cleanup
 120     ] with-scope ; inline
 121
 122 : with-mysql-catch ( host user password db port quot -- )
 123     [ with-mysql ] catch [ "Caught: " write print ] when* ;
 124