view release on metacpan or  search on metacpan

DtfSQL.xs  view on Meta::CPAN

unsigned short 
DtfConDestroy (hcon)
		int hcon
	CODE:
		RETVAL = DtfConDestroy (&hcon);
	OUTPUT:
		hcon
		RETVAL



unsigned short 
DtfConDisconnect (hcon)
		int hcon
	CODE:
		RETVAL = DtfConDisconnect (hcon);
	OUTPUT:
		RETVAL



unsigned short 
DtfEnvDestroy (henv)
		int henv
	CODE:
		RETVAL = DtfEnvDestroy (&henv);
	OUTPUT:
		henv
		RETVAL



unsigned long 
_define_Attribut(a3, a2, a1, a0)
		int a3
		int a2 
		int a1 
		int a0
	CODE:
		RETVAL = _define_Attribut(a3, a2, a1, a0);
	OUTPUT:
		RETVAL



void
dtf_connect (dsn, user, pass)
  		const char *	dsn
  		const char *	user
		const char *	pass
	PREINIT:
		int 			henv = 0;			/* environment handle 	*/
		int 			hcon = 0;			/* connection handle 	*/
		int 			htra = 0;			/* transaction handle 	*/
		unsigned short 	err  = 0;			/* error code 			*/
		char * 			errstr = "";		/* error message 		*/
		unsigned char 	connected = 0; 		/* connected flag 		*/
		unsigned char 	dbExists = 0;  		/* dbExists flag 		*/
		unsigned char	dbConsistent = 0; 	/* dbConsistent flag 	*/
		unsigned char	network = 0; 		/* indicates a network connection */		
	PPCODE: 
		{
  		//  First, we always need an environment handle before
  		//  we are able to do anything else.
  
  		// NOTE
  		// Currently, the number of environment handles which may exist at a time is restricted to one.
 
  		if ( (err = DtfEnvCreate(&henv) ) != DTF_ERR_OK) {
  			errstr = "ERROR(dtf_connect): Can't create environment";
			henv = 0;
			EXTEND(SP, 5); /* extend Perl stack for 5 SVs (return values) */
          	PUSHs(sv_2mortal(newSViv(henv))); /* henv == 0 */
          	PUSHs(sv_2mortal(newSViv(hcon))); /* hcon == 0 */
			PUSHs(sv_2mortal(newSViv(htra))); /* htra == 0 */
			PUSHs(sv_2mortal(newSViv(err)));  /* error code */
			PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
			XSRETURN(5); /* return from XSUB */

    		// return ( $henv, $hcon, $htra, $err, $errstr );
  		}

  		//  When the environment handle (henv) was created successfully,  a connection handle
  		//  can be created as the environment handle's *dependent* handle.
  		// 
  		//  The parameter dsn (DSN = data source name) contains for the single-user version   
  		//  of dtF/SQL the database's partial or fully qualified path (flags = DTF_CF_FILENAME),
  		//  for example "MacHD:path:to:DB:TESTDB.dtF", for the multi-user verion it contains
  		//  a server specification, for example "tcp:host/port" (flags = DTF_CF_NETWORK).

  		// NOTE
  		// Currently, only a single connection can be created on every environment handle.
  
  
  		if ( strncmp ( dsn, "tcp:", 4 ) == 0) { // network, please
    		network = 1;
  			err = DtfConCreate(henv, dsn, DTF_CF_NETWORK, &hcon);
  		} else { // local
  			err = DtfConCreate(henv, dsn, DTF_CF_FILENAME, &hcon);
  		}

  		if (err != DTF_ERR_OK) {
    		errstr = strcat ("ERROR(dtf_connect): Can't create connection to ", dsn);
			// clear up things
			// at this point, henv has successfully been created, thus dispose this handle
			DtfEnvDestroy (&henv);
			henv = 0;
			hcon = 0;
			EXTEND(SP, 5); /* extend Perl stack for 5 SVs (return values) */
          	PUSHs(sv_2mortal(newSViv(henv))); /* henv == 0 */
          	PUSHs(sv_2mortal(newSViv(hcon))); /* hcon == 0 */
			PUSHs(sv_2mortal(newSViv(htra))); /* htra == 0 */
			PUSHs(sv_2mortal(newSViv(err)));  /* error code */
			PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
    		XSRETURN(5); /* return from XSUB */

			//return ( $henv, $hcon, $htra, $err, $errstr );
  		}

  		//  This function queries some information about the just established connection

DtfSQL.xs  view on Meta::CPAN

  		if ( (err = DtfConConnect(hcon, user, pass) ) != DTF_ERR_OK) {
    		errstr = strcat ("ERROR(dtf_connect): Can't connect as " , user);
			// clear up things
			// at this point, henv and hcon have successfully been created, thus dispose these handles
			DtfConDestroy (&hcon);
			DtfEnvDestroy (&henv);
			henv = 0;
			hcon = 0;
			EXTEND(SP, 5); /* extend Perl stack for 5 SVs (return values) */
        	PUSHs(sv_2mortal(newSViv(henv))); /* henv == 0 */
       		PUSHs(sv_2mortal(newSViv(hcon))); /* hcon == 0 */
			PUSHs(sv_2mortal(newSViv(htra))); /* htra == 0 */
			PUSHs(sv_2mortal(newSViv(err)));  /* error code */
			PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
			XSRETURN(5); /* return from XSUB */
			
  			//return ( $henv, $hcon, $htra, $err, $errstr );
  		}

  		//  We are connected, now create a transaction we are able
  		//  to execute SQL statements with.

  		// NOTE
  		// 	The maximum number of concurrent transactions may be modified by
  		// 	setting the connection handle attribute DTF_CAT_TRANSACTIONS. The
  		// 	default value of this attribute is 1.
  
  		if (err = DtfTraCreate( hcon, &htra ) != DTF_ERR_OK) {
    		errstr = "ERROR(dtf_connect): Can't create transaction";	
			// clear up things
			DtfConDisconnect (hcon); // first, disconnect the handle
			// at this point, henv and hcon have successfully been created, thus dispose these handles
			DtfConDestroy (&hcon);
			DtfEnvDestroy (&henv);
			henv = 0;
			hcon = 0;
			htra = 0;
			EXTEND(SP, 5); /* extend Perl stack for 5 SVs (return values) */
        	PUSHs(sv_2mortal(newSViv(henv))); /* henv == 0 */
       		PUSHs(sv_2mortal(newSViv(hcon))); /* hcon == 0 */
			PUSHs(sv_2mortal(newSViv(htra))); /* htra == 0 */
			PUSHs(sv_2mortal(newSViv(err)));  /* error code */
			PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
  			XSRETURN(5); /* return from XSUB */
			
			//return ( $henv, $hcon, $htra, $err, $errstr );
  		}
  
 		// everything is fine here
		
		EXTEND(SP, 5); /* extend Perl stack for 5 SVs (return values) */
        PUSHs(sv_2mortal(newSViv(henv))); /* henv ok */
       	PUSHs(sv_2mortal(newSViv(hcon))); /* hcon ok */
		PUSHs(sv_2mortal(newSViv(htra))); /* htra ok */
		PUSHs(sv_2mortal(newSViv(err)));  /* error code == 0 */
		PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message == '', let Perl determine the length */
 		XSRETURN(5); /* return from XSUB */
		
 		//return ( $henv, $hcon, $htra, $err, $errstr );
  
		} // end PPCODE



void
dtf_disconnect (henv, hcon, htra)
  		int				henv
  		int 			hcon
		int 			htra
	PREINIT:
		unsigned short 	err  = 0;			/* error code 			*/
		char * 			errstr = "";		/* error message 		*/		
		unsigned char 	connected = 0; 		/* connected flag 		*/	
	PPCODE: 
		{

  		if (htra != DTFHANDLE_NULL) {
    		if ( (err = DtfTraDestroy(&htra) ) != DTF_ERR_OK) {
				errstr = "ERROR(dtf_disconnect): Can't destroy transaction handle";
				EXTEND(SP, 2); /* extend Perl stack for 2 SVs (return values) */
          		PUSHs(sv_2mortal(newSViv(err)));  /* error code */
				PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
				XSRETURN(2); /* return from XSUB */
				
				// return ($err, $errstr);
			}
  		} //if htra

  		if (hcon != DTFHANDLE_NULL) {

    		if ( (err = DtfConQueryStatus(hcon, &connected, NULL, NULL) ) != DTF_ERR_OK) {
				errstr = "ERROR(dtf_disconnect): Can't query connection status";
				EXTEND(SP, 2); /* extend Perl stack for 2 SVs (return values) */
          		PUSHs(sv_2mortal(newSViv(err)));  /* error code */
				PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
				XSRETURN(2); /* return from XSUB */
				
				// return ($err, $errstr);
			}

    		if (connected) { // connected as user X (aka login)
	  		
				if ( (err = DtfConDisconnect(hcon) ) != DTF_ERR_OK) {
					errstr = "ERROR(dtf_disconnect): User can't disconnect (logout)";
					EXTEND(SP, 2); /* extend Perl stack for 2 SVs (return values) */
          			PUSHs(sv_2mortal(newSViv(err)));  /* error code */
					PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
					XSRETURN(2); /* return from XSUB */
				
					// return ($err, $errstr);
    			}
				
			} //connected

    		if ( (err = DtfConDestroy(&hcon) ) != DTF_ERR_OK) {
				errstr = "ERROR(dtf_disconnect): Can't destroy connection handle";
				EXTEND(SP, 2); /* extend Perl stack for 2 SVs (return values) */
          		PUSHs(sv_2mortal(newSViv(err)));  /* error code */
				PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
				XSRETURN(2); /* return from XSUB */
				
				//return ($err, $errstr);
  			}
  		} //if hcon

  		if (henv != DTFHANDLE_NULL) {
    		if ( (err = DtfEnvDestroy(&henv) ) != DTF_ERR_OK) {
				errstr = "ERROR(dtf_disconnect): Can't destroy environment handle";
				EXTEND(SP, 2); /* extend Perl stack for 2 SVs (return values) */
          		PUSHs(sv_2mortal(newSViv(err)));  /* error code */
				PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
				XSRETURN(2); /* return from XSUB */
				
				// return ($err, $errstr);
  			}
  		} //if henv
  
  		// everything is fine here
		EXTEND(SP, 2); /* extend Perl stack for 2 SVs (return values) */
        PUSHs(sv_2mortal(newSViv(err)));  /* error code */
		PUSHs(sv_2mortal(newSVpv(errstr, 0))); /* error message, let Perl determine the length */
		XSRETURN(2); /* return from XSUB */
  		
		//return ($err, $errstr);

		}// end PPCODE