sqlrelaycmd.c

适合于Unix/Linux下的一个持久数据库连接池

	if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
	  return TCL_ERROR;
	}
	isbinary = cur->getColumnIsBinary(col);
	Tcl_SetObjResult(interp, Tcl_NewLongObj(isbinary));
	break;
      }
    case SQLRCUR_getColumnIsBinaryByName:
      {
	bool isbinary;
	if (objc != 3) {
	  Tcl_WrongNumArgs(interp, 2, objv, "col");
	  return TCL_ERROR;
	}
	isbinary = cur->getColumnIsBinary(Tcl_GetString(objv[2]));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(isbinary));
	break;
      }
    case SQLRCUR_getColumnIsAutoIncrementByIndex:
      {
	int col;
	bool isautoinc;
	if (objc != 3) {
	  Tcl_WrongNumArgs(interp, 2, objv, "col");
	  return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
	  return TCL_ERROR;
	}
	isautoinc = cur->getColumnIsAutoIncrement(col);
	Tcl_SetObjResult(interp, Tcl_NewLongObj(isautoinc));
	break;
      }
    case SQLRCUR_getColumnIsAutoIncrementByName:
      {
	bool isautoinc;
	if (objc != 3) {
	  Tcl_WrongNumArgs(interp, 2, objv, "col");
	  return TCL_ERROR;
	}
	isautoinc = cur->getColumnIsAutoIncrement(Tcl_GetString(objv[2]));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(isautoinc));
	break;
      }
    case SQLRCUR_getLongestByIndex:
      {
	int col;
	uint32_t len;
	if (objc != 3) {
	  Tcl_WrongNumArgs(interp, 2, objv, "col");
	  return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &col) != TCL_OK) {
	  return TCL_ERROR;
	}
	len = cur->getLongest(col);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
	break;
      }
    case SQLRCUR_getLongestByName:
      {
	int len;
	if (objc != 3) {
	  Tcl_WrongNumArgs(interp, 2, objv, "col");
	  return TCL_ERROR;
	}
	len = cur->getLongest(Tcl_GetString(objv[2]));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
	break;
      }
    case SQLRCUR_getResultSetId:
      {
	if (objc > 2) {
	  Tcl_WrongNumArgs(interp, 2, objv, NULL);
	  return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(cur->getResultSetId()));
	break;
      }
    case SQLRCUR_suspendResultSet:
      {
	if (objc > 2) {
	  Tcl_WrongNumArgs(interp, 2, objv, NULL);
	  return TCL_ERROR;
	}
	cur->suspendResultSet();
	break;
      }
    case SQLRCUR_resumeResultSet:
      {
	int id;
	if (objc != 3) {
	  Tcl_WrongNumArgs(interp, 2, objv, "id");
	  return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &id) != TCL_OK) {
	  return TCL_ERROR;
	}
	Tcl_SetObjResult(interp,
			 Tcl_NewBooleanObj(cur->resumeResultSet(id)));
	break;
      }
    case SQLRCUR_resumeCachedResultSet:
      {
	int id;
	if (objc != 4) {
	  Tcl_WrongNumArgs(interp, 2, objv, "id filename");
	  return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &id) != TCL_OK) {
	  return TCL_ERROR;
	}
	Tcl_SetObjResult(interp,
			 Tcl_NewBooleanObj(cur->resumeCachedResultSet(id, Tcl_GetString(objv[3]))));
	break;
      }
    }
  return TCL_OK;
}

/*
 * sqlrcurCmd --
 *    create new sqlrcur object command. This command itselfs is a
 *    subcommand of sqlrcon object command. see below.
 */
int sqlrcurCmd(ClientData data, Tcl_Interp *interp,
	       int objc, Tcl_Obj *CONST objv[]) {
  sqlrconnection *con = (sqlrconnection *)data;
  sqlrcursor *cur = (sqlrcursor *)NULL;
  Tcl_Obj *id;

  if ((cur = new sqlrcursor(con)) == (sqlrcursor *)NULL) {
    Tcl_AppendResult(interp, "cannot allocate sqlrcursor", (char *)NULL);
    return TCL_ERROR;
  }
  cur->copyReferences();

  id = getCursorID();
  Tcl_CreateObjCommand(interp,
		       Tcl_GetString(id),
		       sqlrcurObjCmd,
		       (ClientData)cur,
		       (Tcl_CmdDeleteProc *)sqlrcurDelete);
  Tcl_SetObjResult(interp, id);
  return TCL_OK;
}

/*
 * sqlrconDelete --
 */
void sqlrconDelete(ClientData data) {
  sqlrconnection *con = (sqlrconnection *)data;
  if (con != (sqlrconnection *)NULL) {
    delete con;
    con = (sqlrconnection *)NULL;
  }
}

/*
 * sqlrconObjCmd --
 *    sqlrcon object command.
 * Synopsis:
 *  $con free
 *  $con endSession
 *  $con suspendSession
 *  $con getConnectionPort
 *  $con getConnectionSocket
 *  $con resumeSession port socket
 *  $con ping
 *  $con identify
 *  $con dbVersion
 *  $con bindFormat
 *  $con autoCommit bool
 *  $con commit
 *  $con rollback
 *  $con debug ?bool?
 *  $con sqlrcur
 *     set cur [$con sqlrcur]
 */
int sqlrconObjCmd(ClientData data, Tcl_Interp *interp,
		  int objc, Tcl_Obj *CONST objv[]) {
  sqlrconnection *con = (sqlrconnection *)data;
  int index;
  static CONSTCHAR *options[] = {
    "free",
    "endSession",
    "suspendSession",
    "getConnectionPort",
    "getConnectionSocket",
    "resumeSession",
    "ping",
    "identify",
    "dbVersion",
    "bindFormat",
    "autoCommit",
    "commit",
    "rollback",
    "debug",
    "sqlrcur",
  };
  enum options {
    SQLR_FREE,
    SQLR_ENDSESSION,
    SQLR_SUSPENDSESSION,
    SQLR_GETCONNECTIONPORT,
    SQLR_GETCONNECTIONSOCKET,
    SQLR_RESUMESESSION,
    SQLR_PING,
    SQLR_IDENTIFY,
    SQLR_DBVERSION,
    SQLR_BINDFORMAT,
    SQLR_AUTOCOMMIT,
    SQLR_COMMIT,
    SQLR_ROLLBACK,
    SQLR_DEBUG,
    SQLR_SQLRCUR,
  };

  if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
    return TCL_ERROR;
  }

  if (Tcl_GetIndexFromObj(interp, objv[1], (CONSTCHAR **)options, "option", 0,
			  (int *)&index) != TCL_OK) {
    return TCL_ERROR;
  }

  switch ((enum options)index) {
  case SQLR_FREE: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    sqlrconDelete(con);
    break;
  }
  case SQLR_ENDSESSION: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    con->endSession();
    break;
  }
  case SQLR_SUSPENDSESSION: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(con->suspendSession()));
    break;
  }
  case SQLR_GETCONNECTIONPORT: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, "getConnectionPort");
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(con->getConnectionPort()));
    break;
  }
  case SQLR_GETCONNECTIONSOCKET: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
		     Tcl_NewStringObj(con->getConnectionSocket(),
				      -1));
    break;
  }
  case SQLR_RESUMESESSION: {
    int port;
    const char *socket;

    if (objc != 4) {
      Tcl_WrongNumArgs(interp, 2, objv, "port socket");
      return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[2], &port) != TCL_OK) {
      return TCL_ERROR;
    }
    socket = Tcl_GetString(objv[3]);

    Tcl_SetObjResult(interp,
		     Tcl_NewBooleanObj(con->resumeSession(port, socket)));
    break;
  }
  case SQLR_PING: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
		     Tcl_NewBooleanObj(con->ping()));
    break;
  }
  case SQLR_IDENTIFY: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
		     Tcl_NewStringObj(con->identify(), -1));
    break;
  }
  case SQLR_DBVERSION: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
		     Tcl_NewStringObj(con->dbVersion(), -1));
    break;
  }
  case SQLR_BINDFORMAT: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
		     Tcl_NewStringObj(con->bindFormat(), -1));
    break;
  }
  case SQLR_AUTOCOMMIT: {
    int flag = 0;
    if (objc !=3) {
      Tcl_WrongNumArgs(interp, 2, objv, "bool");
      return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[2], &flag) != TCL_OK) {
      return TCL_ERROR;
    }
    if (flag) {
      Tcl_SetObjResult(interp, Tcl_NewIntObj(con->autoCommitOn()));
    } else {
      Tcl_SetObjResult(interp, Tcl_NewIntObj(con->autoCommitOff()));
    }
    break;
  }
  case SQLR_COMMIT: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(con->commit()));
    break;
  }
  case SQLR_ROLLBACK:
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(con->rollback()));
    break;
  case SQLR_DEBUG: {
    int flag = 0;
    if (objc == 2) {
      Tcl_SetObjResult(interp,
		       Tcl_NewBooleanObj(con->getDebug()));
      break;
    } else if (objc == 3) {
      if (Tcl_GetBooleanFromObj(interp, objv[2], &flag) != TCL_OK) {
	return TCL_ERROR;
      }
      if (flag) {
	con->debugOn();
      } else {
	con->debugOff();
      }
    } else {
      Tcl_WrongNumArgs(interp, 2, objv, "debug ?bool?");
      return TCL_ERROR;
    }
  }
  case SQLR_SQLRCUR: {
    if (objc > 2) {
      Tcl_WrongNumArgs(interp, 2, objv, NULL);
      return TCL_ERROR;
    }
    if (sqlrcurCmd(data, interp, objc, objv) != TCL_OK) {
      return TCL_ERROR;
    }
  }
  }
  return TCL_OK;
}

/*
 * sqlrconCmd --
 *   the sqlrcon command itselfs.
 * Synopsis:
 *   set con [sqlrcon -server server -port port -user user -password password ?-retrytime time -tries count?]
 * OR
 *   set con [sqlrcon -socket socket -user user -password password ?-retrytime time -tries count?]
 */
int sqlrconCmd(ClientData dummy, Tcl_Interp *interp,
		  int objc, Tcl_Obj *CONST objv[]) {
  static int count = 0;
  static CONSTCHAR *optionStrings[] = {
    "-server",
    "-port",
    "-socket",
    "-user",
    "-password",
    "-retrytime",
    "-tries",
    (char *)NULL
  };
  enum options {
    SQLRCON_SERVER,
    SQLRCON_PORT,
    SQLRCON_SOCKET,
    SQLRCON_USER,
    SQLRCON_PASSWORD,
    SQLRCON_RETRYTIME,
    SQLRCON_TRIES,
  };
  int i;
  CONSTCHAR *server, *socket, *user, *password;
  int port = 9000, retrytime = 0, tries = 1;
  sqlrconnection *con = (sqlrconnection *)NULL;
  Tcl_Obj *id;

  if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
    return TCL_ERROR;
  }

  server = socket = user = password = "";
  for (i = 1; objc > i; i += 2) {
    int index;

    if (Tcl_GetIndexFromObj(interp, objv[i],
			    (CONSTCHAR **)optionStrings,
			    "option",
			    0,
			    (int *)&index) != TCL_OK) {
      return TCL_ERROR;
    }

    switch ((enum options)index) {
    case SQLRCON_SERVER: {
      server = Tcl_GetString(objv[i+1]);
      break;
    }
    case SQLRCON_PORT: {
      if (Tcl_GetIntFromObj(interp, objv[i+1], &port) != TCL_OK) {
	return TCL_ERROR;
      }
      break;
    }
    case SQLRCON_SOCKET:
      socket = Tcl_GetString(objv[i+1]);
      break;
    case SQLRCON_USER: {
      user = Tcl_GetString(objv[i+1]);
      break;
    }
    case SQLRCON_PASSWORD: {
      password = Tcl_GetString(objv[i+1]);
      break;
    }
    case SQLRCON_RETRYTIME: {
      if (Tcl_GetIntFromObj(interp, objv[i+1], &retrytime) != TCL_OK) {
	return TCL_ERROR;
      }
      break;
    }
    case SQLRCON_TRIES:
      if (Tcl_GetIntFromObj(interp, objv[i+1], &tries) != TCL_OK) {
	return TCL_ERROR;
      }
      break;
    }
  }

  if (charstring::compare("",server,1) == 0 && charstring::compare("", socket, 1) == 0) {
    Tcl_AppendResult(interp, 
		     "-server name or -socket name required", (char *)NULL);
    return TCL_ERROR;
  }
  if (charstring::compare("", user, 1) == 0) {
    Tcl_AppendResult(interp, "-user username required", (char *)NULL);
    return TCL_ERROR;
  }
  if (charstring::compare("", password, 1) == 0) {
    Tcl_AppendResult(interp, "-password password required", (char *)NULL);
    return TCL_ERROR;
  }

  con = new sqlrconnection(server, port, socket, user, password,
		                retrytime, tries);
  con->copyReferences();
  

  id = Tcl_NewStringObj("sqlrcon", -1);
  Tcl_AppendStringsToObj(id, Tcl_GetString(Tcl_NewIntObj(count++)),
			(char *)NULL);

  Tcl_CreateObjCommand(interp, Tcl_GetString(id), sqlrconObjCmd,
		       (ClientData)con,
		       (Tcl_CmdDeleteProc *)sqlrconDelete);

  Tcl_SetObjResult(interp, id);
  return TCL_OK;
}

DLLEXPORT int Sqlrelay_Init(Tcl_Interp *interp) {
#ifdef USE_TCL_STUBS
  Tcl_InitStubs(interp, "8.2", 0);
#endif
  Tcl_CreateObjCommand(interp, "sqlrcon", sqlrconCmd,
		       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  return Tcl_PkgProvide(interp, "sqlrelay", "1.0");
}

}