view release on metacpan or  search on metacpan

dbd/dbdimp.c  view on Meta::CPAN

 *  Purpose: Called to associate an error code and an error message
 *           to some handle
 *
 *  Input:   h - the handle in error condition
 *           rc - the error code
 *           what - the error message
 *
 *  Returns: Nothing
 *
 **************************************************************************/

void do_error(SV* h, int rc, char* what) {
    D_imp_xxh(h);
    STRLEN lna;

    SV *errstr = DBIc_ERRSTR(imp_xxh);
    sv_setiv(DBIc_ERR(imp_xxh), (IV)rc);	/* set err early	*/
    sv_setpv(errstr, what);
    DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), errstr);
    if (dbis->debug >= 2)
	PerlIO_printf(DBILOGFP, "%s error %d recorded: %s\n",
		      what, rc, SvPV(errstr,lna));
}
void do_warn(SV* h, int rc, char* what) {
    D_imp_xxh(h);
    STRLEN lna;

    SV *errstr = DBIc_ERRSTR(imp_xxh);
    sv_setiv(DBIc_ERR(imp_xxh), (IV)rc);	/* set err early	*/
    sv_setpv(errstr, what);
    DBIh_EVENT2(h, WARN_event, DBIc_ERR(imp_xxh), errstr);
    if (dbis->debug >= 2)
	PerlIO_printf(DBILOGFP, "%s warning %d recorded: %s\n",
		      what, rc, SvPV(errstr,lna));
    warn("%s", what);
}
#define doquietwarn(s)                                            \
    {                                                             \
        SV* sv = perl_get_sv("DBD::~~dbd_driver~~::QUIET", FALSE);  \
        if (!sv  ||  !SvTRUE(sv)) {                               \
	    warn s;                                               \
	}                                                         \
    }



/***************************************************************************
 *
 *  Name:    _MyLogin, MyConnect
 *
 *  Purpose: Replacements for mysql_connect or msqlConnect
 *
 *  Input:   imp_dbh - database handle
 *
 *  Returns: TRUE for success, FALSE otherwise; you have to call
 *           do_error in the latter case.
 *
 *  Bugs:    The msql version needs to set the environment
 *           variable MSQL_TCP_PORT. There's absolutely no
 *           portable way of setting environment variables
 *           from within C: Neither setenv() nor putenv()
 *           are guaranteed to work. I have decided to use
 *           the internal perl functions setenv_getix()
 *           and my_setenv() instead, let's hope, this is safe.
 *
 *           Another problem was pointed out by Andreas:
 *           This isn't thread safe. We'll have fun with perl
 *           5.005 ... :-)
 *
 **************************************************************************/

int MyConnect(dbh_t *sock, char* unixSocket, char* host, char* port,
	      char* user, char* password, char* dbname, imp_dbh_t *imp_dbh) {
    int portNr;

    if (host && !*host) host = NULL;
    if (port && *port) {
        portNr = atoi(port);
    } else {
        portNr = 0;
    }
    if (user && !*user) user = NULL;
    if (password && !*password) password = NULL;

    if (dbis->debug >= 2)
        PerlIO_printf(DBILOGFP,
		      "imp_dbh->MyConnect: host = %s, port = %d, uid = %s," \
		      " pwd = %s\n",
		      host ? host : "NULL", portNr,
		      user ? user : "NULL",
		      password ? password : "NULL");

#ifdef DBD_MYSQL
    {
#ifdef MYSQL_USE_CLIENT_FOUND_ROWS
        unsigned int client_flag = CLIENT_FOUND_ROWS;
#else
	unsigned int client_flag = 0;
#endif
	mysql_init(*sock);

	if (imp_dbh) {
	    SV* sv = DBIc_IMP_DATA(imp_dbh);
	    imp_dbh->has_transactions = TRUE;
	    DBIc_set(imp_dbh, DBIcf_AutoCommit, &sv_yes);
	    if (sv  &&  SvROK(sv)) {
	        HV* hv = (HV*) SvRV(sv);
		SV** svp;
		STRLEN lna;

		if ((svp = hv_fetch(hv, "mysql_compression", 17, FALSE))  &&
		    *svp  &&  SvTRUE(*svp)) {
		    if (dbis->debug >= 2)
		        PerlIO_printf(DBILOGFP,
				      "imp_dbh->MyConnect: Enabling" \
				      " compression.\n");
		    mysql_options(*sock, MYSQL_OPT_COMPRESS, NULL);
		}
		if ((svp = hv_fetch(hv, "mysql_connect_timeout", 21, FALSE))
		    &&  *svp  &&  SvTRUE(*svp)) {
		  int to = SvIV(*svp);
		  if (dbis->debug >= 2)
		    PerlIO_printf(DBILOGFP,
				  "imp_dbh->MyConnect: Setting" \
				  " connect timeout (%d).\n",to);
		  mysql_options(*sock, MYSQL_OPT_CONNECT_TIMEOUT,
				(const char *)&to);
		}
		if ((svp = hv_fetch(hv, "mysql_read_default_file", 23,
				    FALSE))  &&
		    *svp  &&  SvTRUE(*svp)) {
		    char* df = SvPV(*svp, lna);
		    if (dbis->debug >= 2)
		        PerlIO_printf(DBILOGFP,
				      "imp_dbh->MyConnect: Reading" \
				      " default file %s.\n", df);
		    mysql_options(*sock, MYSQL_READ_DEFAULT_FILE, df);
		}
		if ((svp = hv_fetch(hv, "mysql_read_default_group", 24,
				    FALSE))  &&
		    *svp  &&  SvTRUE(*svp)) {
		    char* gr = SvPV(*svp, lna);
		    if (dbis->debug >= 2)
		        PerlIO_printf(DBILOGFP,
				      "imp_dbh->MyConnect: Using" \
				      " default group %s.\n", gr);
		    mysql_options(*sock, MYSQL_READ_DEFAULT_GROUP, gr);
		}
		if ((svp = hv_fetch(hv, "mysql_client_found_rows", 23,
				    FALSE))  &&  *svp) {
		    if (SvTRUE(*svp)) {
		        client_flag |= CLIENT_FOUND_ROWS;
		    } else {
		        client_flag &= ~CLIENT_FOUND_ROWS;
		    }
		}
	    }
        }
	if (dbis->debug >= 2)
	  PerlIO_printf(DBILOGFP, "imp_dbh->MyConnect: client_flags = %d\n",
			client_flag);
        return mysql_real_connect(*sock, host, user, password, dbname,
				  portNr, unixSocket, client_flag) ?
	  TRUE : FALSE;
    }
#else
    {
        /*
	 *  Setting a port for msql's client is extremely ugly: We have
	 *  to set an environment variable. Even worse, we cannot trust
	 *  in setenv or putenv being present, thus we need to use
	 *  internal, not documented, perl functions. :-(
	 */
        char buffer[32];
	char* oldPort = NULL;

	if (imp_dbh) {
	    imp_dbh->has_transactions = FALSE;
	    DBIc_set(imp_dbh, DBIcf_AutoCommit, &sv_yes);
	}

	sprintf(buffer, "%d", portNr);
	if (portNr) {
	    oldPort = environ[setenv_getix("MSQL_TCP_PORT")];
	    if (oldPort) {
	        char* copy = (char*) malloc(strlen(oldPort)+1);
		if (!copy) {
		    return FALSE;
		}
		strcpy(copy, oldPort);
		oldPort = copy;
	    }
	    my_setenv("MSQL_TCP_PORT", buffer);
	}
	*sock = msqlConnect(host);
	if (oldPort) {
	    my_setenv("MSQL_TCP_PORT", oldPort);
	    if (oldPort) { free(oldPort); }
	}
	if (*sock != -1  &&  dbname  &&  MySelectDb(*sock, dbname)) {
	    MyClose(*sock);
	    *sock = -1;
	}
	return (*sock == -1) ? FALSE : TRUE;
    }
#endif
}

static int _MyLogin(imp_dbh_t *imp_dbh) {
    SV* sv;
    SV** svp;
    HV* hv;
    char* dbname;
    char* host;
    char* port;
    char* user;
    char* password;
    char* unixSocket = NULL;
    STRLEN len, lna;

    sv = DBIc_IMP_DATA(imp_dbh);
    if (!sv  ||  !SvROK(sv)) {
        return FALSE;
    }
    hv = (HV*) SvRV(sv);
    if (SvTYPE(hv) != SVt_PVHV) {
        return FALSE;
    }
    if ((svp = hv_fetch(hv, "host", 4, FALSE))) {
        host = SvPV(*svp, len);
	if (!len) {
	    host = NULL;
	}
    } else {
        host = NULL;
    }
    if ((svp = hv_fetch(hv, "port", 4, FALSE))) {
        port = SvPV(*svp, lna);
    } else {
        port = NULL;
    }
    if ((svp = hv_fetch(hv, "user", 4, FALSE))) {
        user = SvPV(*svp, len);
	if (!len) {
	    user = NULL;
	}
    } else {
        user = NULL;
    }
    if ((svp = hv_fetch(hv, "password", 8, FALSE))) {
        password = SvPV(*svp, len);
	if (!len) {
	    password = NULL;
	}
    } else {
        password = NULL;
    }