Tuxedo - Perl extension module for Tuxedo
use Tuxedo;
This module provides the following functionality...
'C' style interface
The Tuxedo perl module gives you access to almost all of the tuxedo 8.1 apis from perl. In most cases you can take the C API you already familiar with, apply perl semantics to it, and write working tuxedo programs in perl.
Object wrapping of C structures
Many tuxedo functions take pointers to C structures as function parameters. To preserve the C interface, this module provides perl objects that encapsulate the C structures used by tuxedo. These objects allow the user to create and manipulate the elements of these C structures, and these objects are then passed as parameters to the perl version of these tuxedo C functions.
buffer management
Perl classes exist for each buffer type to allow for easy manipulation of buffer contents and automatic memory cleanup when no more references to the buffer exist.
callback subs
perl subs can be registered as unsolicited message handlers and signal handlers.
FML/FML32 field table support
This module includes the mkfldpm32.pl script that is the perl equivalent of the tuxedo mkfldhdr32 program. It accepts a field table file as input and produces a *.pm file that can be included in a perl script, so field identifiers can be referenced by id.
perl tuxedo services
You can now write tuxedo services in perl. When you build the Tuxedo module, it should create a tuxedo server called PERLSVR. This is a tuxedo server that contains an embedded perl interpretor for executing perl tuxedo services. When PERLSVR boots up, it parses the perlsvr.pl script, which at the moment it expects to find in its working directory. The location of perlsvr.pl will be configurable in a future version. The perlsvr.pl script is run as the tpsvrinit routine. You can modify perlsvr.pl to define any subs you want to be tuxedo services and advertise these subs.
There are a few rules for writing subs that are to be run as tuxedo services.
1) They must accept a single input parameter which is a reference to a TPSVCINFO_PTR object.
2) They must return 5 parameters corresponding to the parameters of the tpreturn tuxedo function. You don't call tpreturn directly from a perl sub tuxedo service. When the sub returns, the PERLSVR will extract the return values from the perl stack and call tpreturn for you.
Below is the perlsvr.pl that is included with this distribution. It demonstrates how to write and advertise two simple perl subs that act as tuxedo services.
use Tuxedo; sub TOUPPER { my ($tpsvcinfo) = @_; my ($inbuf) = $tpsvcinfo->data; $inbuf->value( ($newval = uc($inbuf->value)) ); return ( TPSUCCESS, 0, $inbuf, $tpsvcinfo->len, 0 ); } sub REVERSE { my ($tpsvcinfo) = @_; my ($buf) = $tpsvcinfo->data; $buf->value( ($newval = reverse($buf->value)) ); return ( TPSUCCESS, 0, $buf, $tpsvcinfo->len, 0 ); } tpadvertise( "TOUPPER", \&TOUPPER ); tpadvertise( "REVERSE", \&REVERSE );
Future versions of this module will include
workstation and native modules
Different modules will exist for native and workstation tuxedo development. Currently native is the default.
An object oriented tuxedo interface
Version 1 of the Tuxedo module only presented an object oriented interface to the user. This version of the Tuxedo module presents the original C interface to make perl tuxedo development easier for experienced tuxedo programmers. The object oriented interface will co-exist with the C interface in a future version of this module.
An example is probably the best way to demonstrate the interface provided by the Tuxedo perl module for writing tuxedo programs. The following example shows how to connect to a tuxedo system and make a service call.
use Tuxedo; use tpadm; my $password = "password"; # Allocate a TPINIT buffer my $tpinitbfr = tpalloc( "TPINIT", 0, TPINITNEED( length($password) ) ); # populate the TPINIT buffer $tpinitbfr->usrname( "Anthony" ); $tpinitbfr->cltname( "PERL" ); $tpinitbfr->data( $password ); $tpinitbfr->passwd( "tuxedo" ); $tpinitbfr->flags( TPMULTICONTEXTS ); # connect to tuxedo if ( tpinit( $tpinitbfr ) == -1 ) { die "tpinit failed: " . tpstrerror(tperrno) . "\n"; } # allocate FML32 buffers my $inbuf = tpalloc( "FML32", 0, 1024 ); my $outbuf = tpalloc( "FML32", 0, 1024 ); if ( $inbuf == undef || $outbuf == undef ) { die "tpalloc failed: " . tpstrerror(tperrno) . "\n"; } # populate the FML32 inbuf $rc = Fappend32( $inbuf, TA_CLASS, "T_CLIENT", 0 ); if ( $rc == -1 ) { die "Fappend failed: " . Fstrerror32(Ferror32) . "\n"; } $rc = Fappend32( $inbuf, TA_OPERATION, "GET", 0 ); $rc = Findex32( $inbuf, 0 ); # call the .TMIB service $rc = tpcall( ".TMIB", $inbuf, 0, $outbuf, $olen, 0 ); if ( $rc == -1 ) { die ( "tpcall failed: " . tpstrerror(tperrno) . ".\n" ); } # print the returned buffer tuxputenv( "FIELDTBLS32=tpadm" ); tuxputenv( "FLDTBLDIR32=" . tuxgetenv("TUXDIR") . "/udataobj" ); Fprint32( $outbuf ); # disconnect from tuxedo tpterm();
The Tuxedo module provides perl objects for creating and reading/writing elements of tuxedo C structures. The objects and methods available are...
TPINIT_PTR
This object is returned by a call to tpalloc when specifying a "TPINIT" buffer type. The methods available on this object are...
get and set the usrname
get and set the cltname
get and set the passwd
get and set the grpname
get and set the flags
get and set the datalen
get and set the data
CLIENTID_PTR
create a new instance of a CLIENTID_PTR object.
# example of creating a new CLIENTID_PTR object $clientid = CLIENTID_PTR::new();
Get and set the clientdata.
# to set the clientdata element $clientid->clientdata( 1, 2, 3, 4 ); # to get the clientdata element. This returns an arary of 4 longs @clientdata = $clientid->clientdata;
TPTRANID_PTR
create a new instance of a TPTRANID_PTR object.
# example of creating a new TPTRANID_PTR object $tptranid = TPTRANID_PTR::new();
Get and set the info.
# to set the info element $tptranid->info( 1, 2, 3, 4, 5, 6 ); # to get the info element. This returns an arary of 6 longs @info = $tptranid->info;
XID_PTR
create a new instance of a XID_PTR object.
# example of creating a new XID_PTR object $xid = XID_PTR::new();
Get and set the formatID.
Get and set the gtrid_length.
Get and set the bqual_length.
Get and set the data.
TPQCTL_PTR
create a new instance of a TPQCTL object.
# example of creating a new TPQCTL_PTR object $tpqctl = TPQCTL_PTR::new();
Get and set the flags.
Get and set the deq_time.
Get and set the priority.
Get and set the diagnostic.
Get and set the msgid.
Get and set the corrid.
Get and set the replyqueue.
Get and set the failurequeue.
Get and set the cltid.
Get and set the urcode.
Get and set the appkey.
Get and set the delivery_qos.
Get and set the reply_qos.
Get and set the exp_time.
TPEVCTL_PTR
create a new instance of a TPEVCTL_PTR object.
# example of creating a new TPEVCTL_PTR object $tpevctl = TPEVCTL_PTR::new();
Get and set the name1.
Get and set the name2.
Get and set the qctl.
TXINFO_PTR
create a new instance of a TXINFO_PTR object.
# example of creating a new TXINFO_PTR object $txinfo = TXINFO_PTR::new();
Get and set the xid.
Get and set the when_return.
Get and set the transaction_control.
Get and set the transaction_timeout.
Get and set the transaction_state.
All buffers returned by tpalloc are blessed as the type of buffer that you allocate. This means there are methods you can call on the returned buffer to manipulate the buffer contents. For example, to allocate and populate a TPINIT buffer, you would do the following.
# Allocate a TPINIT buffer my $tpinitbfr = tpalloc( "TPINIT", 0, TPINITNEED( length($password) ) ); # populate the TPINIT buffer $tpinitbfr->usrname( "Anthony" ); $tpinitbfr->cltname( "PERL" );
In this example, tpalloc returns a reference to a TPINIT_PTR object which has usrname, cltname and other methods available to modify the contents of the underlying TPINIT buffer. If you allocate an FML32 buffer, tpalloc will return a FBFR32_PTR object which has different methods available to manipulate buffer contents.
Another benefit of this approach is that a DESTROY method is automatically called when the reference count of each tuxedo buffer becomes zero, so that any allocated memory is consequently automatically freed for you.
The Tuxedo module allows you to create perl subs that are registered as unsolicited message and signal handers. The example below demonstrates how to do this.
# create a sub to use as an unsolicited message handler sub unsol_msg_handler { my( $buffer, $len, $flags ) = @_; # assume the recieved message is an FML32 buffer Fprint32( $buffer ); printf( "unsol_msg_handler called!\n" ); } # create a sub to use as a signal handler sub sigusr2_handler { my( $signum ) = @_; printf( "caught SIGUSR2\n" ); } # register unsol_msg_hander with tuxedo tpsetunsol( \&unsol_msg_handler ); # register sigusr2_handler with tuxedo. SIGUSR2 is 17 Usignal( 17, \&sigusr2 );
This version of the perl module also includes a useful utility script, mkfldpm32.pl, which is the perl equivalent of mkfldhdr32. It will parse a field table file and create a .pm file that you can include in any perl scripts to access fields in an FML/FML32 buffer directly by id instead of name.
BADFLDID FLD_CARRAY FLD_CHAR FLD_DOUBLE FLD_FLOAT FLD_FML32 FLD_LONG FLD_PTR FLD_SHORT FLD_STRING FLD_VIEW32 TP_CMT_COMPLETE TP_CMT_LOGGED TPABSOLUTE TPACK TPAPPAUTH TPCONV TPCONVCLTID TPCONVMAXSTR TPCONVTRANID TPCONVXID TPEABORT TPEBADDESC TPEBLOCK TPEDIAGNOSTIC TPEEVENT TPEHAZARD TPEHEURISTIC TPEINVAL TPEITYPE TPELIMIT TPEMATCH TPEMIB TPENOENT TPEOS TPEOTYPE TPEPERM TPEPROTO TPERELEASE TPERMERR TPESVCERR TPESVCFAIL TPESYSTEM TPETIME TPETRAN TPEXIT TPFAIL TPGETANY TPGETANY TPGOTSIG TPINITNEED TPMULTICONTEXTS TPNOAUTH TPNOBLOCK TPNOCHANGE TPNOREPLY TPNOTIME TPNOTRAN TPRECVONLY TPSA_FASTPATH TPSA_PROTECTED TPSENDONLY TPSIGRSTRT TPSUCCESS TPSYSAUTH TPTOSTRING TPTRAN TPU_DIP TPU_IGN TPU_MASK TPU_SIG TPU_THREAD TPQCORRID TPQFAILUREQ TPQBEFOREMSGID TPQGETBYMSGIDOLD TPQMSGID TPQPRIORITY TPQTOP TPQWAIT TPQREPLYQ TPQTIME_ABS TPQTIME_REL TPQGETBYCORRIDOLD TPQPEEK TPQDELIVERYQOS TPQREPLYQOS TPQEXPTIME_ABS TPQEXPTIME_REL TPQEXPTIME_NONE TPQGETBYMSGID TPQGETBYCORRID TPQQOSDEFAULTPERSIST TPQQOSPERSISTENT TPQQOSNONPERSISTENT TPKEY_SIGNATURE TPKEY_DECRYPT TPKEY_ENCRYPT TPKEY_VERIFICATION TPKEY_AUTOSIGN TPKEY_AUTOENCRYPT TPKEY_REMOVE TPKEY_REMOVEALL TPKEY_VERIFY TPEX_STRING TPSEAL_OK TPSEAL_PENDING TPSEAL_EXPIRED_CERT TPSEAL_REVOKED_CERT TPSEAL_TAMPERED_CERT TPSEAL_UNKNOWN TPSIGN_OK TPSIGN_PENDING TPSIGN_EXPIRED TPSIGN_EXPIRED_CERT TPSIGN_POSTDATED TPSIGN_REVOKED_CERT TPSIGN_TAMPERED_CERT TPSIGN_TAMPERED_MESSAGE TPSIGN_UNKNOWN
Anthony Fryer, apfryer@hotmail.com
perl(1). http://e-docs.bea.com/tuxedo/tux81/interm/ref.htm
To install tpadm, copy and paste the appropriate command in to your terminal.
cpanm
cpanm tpadm
CPAN shell
perl -MCPAN -e shell install tpadm
For more information on module installation, please visit the detailed CPAN module installation guide.