/* Copyright (c) 1997-2004, Perforce Software, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL PERFORCE SOFTWARE, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ /* * Include math.h here because it's included by some Perl headers and on * Win32 it must be included with C++ linkage. Including it here prevents it * from being reincluded later when we include the Perl headers with C linkage. */ #ifdef OS_NT # include #endif #include "clientapi.h" /* When including Perl headers, make sure the linkage is C, not C++ */ extern "C" { #include "EXTERN.h" #include "perl.h" #include "XSUB.h" } #ifdef Error // Defined by older versions of Perl to be Perl_Error # undef Error #endif #include "clientuserperl.h" /* * The architecture of this extension is relatively complex. The main * class is P4::Client which is a blessed hash containing: * * 1. a pointer to the real ClientApi object. * 2. a pointer to a per instance Error object * 3. an integer to track the number of Init/Final calls * * This makes the implementation here more complex than I'd like it to be * but bundling these three things together makes it so much more usable. * * As the Perforce API is callback based, this class doesn't have anything * to do with client output. ClientApi::Run() ends up calling member functions * of a ClientUser derived object to interact with the user. ClientUserPerl * provides this interface and transfers the C++ callback into a Perl * callback. * * The real interaction with the user is then dealt with in Perl space by * the P4::UI module. As it's all OO based, derive a class from P4::UI to * customise the interaction. */ /* * Local function to get at the data stored in the hash */ static int ExtractData( SV *obj, Error **e, ClientApi **c, SV **i ) { SV **tmp; if (!(sv_isobject((SV*)obj) && sv_derived_from((SV*)obj,"P4::Client"))) { warn("Not a P4::Client object!" ); return 0; } tmp = hv_fetch( (HV *)SvRV(obj), "Error", 5, 0 ); *e = ( Error * ) SvIV( *tmp ); tmp = hv_fetch( (HV*)SvRV(obj), "Client", 6, 0 ); *c = ( ClientApi *) SvIV( *tmp ); tmp = hv_fetch( (HV*) SvRV(obj), "InitCount", 9, 0 ); *i = *tmp; return 1; } /* * Local function to get hold of just the ClientApi pointer from the hash */ static ClientApi *ExtractClient( SV *obj ) { SV **tmp; if (!(sv_isobject((SV*)obj) && sv_derived_from((SV*)obj,"P4::Client"))) { warn("Not a P4::Client object!" ); return NULL; } if ( ! SvROK( obj ) ) { warn( "Can't dereference object!!!" ); return NULL; } tmp = hv_fetch( (HV *)SvRV(obj), "Client", 6, 0 ); return ( ClientApi *) SvIV( *tmp ); } /* * Local function to check the value of a boolean flag */ static int GetFlag( const char *flag, SV *obj ) { SV **tmp; if (!(sv_isobject((SV*)obj) && sv_derived_from((SV*)obj,"P4::Client"))) { warn("Not a P4::Client object!" ); return 0; } if ( ! SvROK( obj ) ) { warn( "Can't dereference object!!!" ); return 0; } tmp = hv_fetch( (HV *)SvRV(obj), flag, strlen( flag ), 0 ); if ( ! tmp ) return 0; return SvIV( *tmp ); } /* * Local function to check if debug is enabled on a P4::Client object */ static int DebugLevel( SV *obj ) { return GetFlag( "Debug", obj ); } /* * Local function to test if Perl Diffs are requested on a P4::Client object */ static int DoPerlDiffs( SV *obj ) { return GetFlag( "PerlDiffs", obj ); } MODULE = P4::Client PACKAGE = P4::Client SV * new( CLASS ) char *CLASS; INIT: HV *myself; HV *stash; Error *e; ClientApi *c; SV *initdone; SV *tmp; CODE: /* * Create a new HV and put inside it a pointer to a new * ClientApi object. We also need an Error * and we need * a flag to track whether or not the Init() suceeded so * we know to call Final() in the DESTROY XSUB */ myself = newHV(); c = new ClientApi(); e = new Error(); /* Put the client in the hash */ tmp = newSViv( (I32) c ); hv_store( myself, "Client", 6, tmp, 0 ); /* Put the error object in the hash */ tmp = newSViv( (I32)e ); hv_store( myself, "Error", 5, tmp, 0 ); /* Now put a flag in the hash for Init/Final testing */ tmp = newSViv( 0 ); hv_store( myself, "InitCount", 9, tmp, 0 ); /* Now put in a flag for the type of Diff support required */ tmp = newSViv( 0 ); hv_store( myself, "PerlDiffs", 9, tmp, 0 ); /* Now add the debug flag */ tmp = newSViv( 0 ); hv_store( myself, "Debug", 5, tmp, 0 ); /* Return a blessed reference to the hash */ RETVAL = newRV_noinc( (SV * )myself ); stash = gv_stashpv( CLASS, TRUE ); sv_bless( (SV *)RETVAL, stash ); OUTPUT: RETVAL void DESTROY( THIS ) SV *THIS INIT: Error *e; ClientApi *c; SV *count; CODE: if ( ! ExtractData( THIS, &e, &c, &count ) ) XSRETURN_UNDEF; if ( SvIV( count ) ) c->Final( e ); delete e; delete c; int Dropped( THIS ) SV *THIS INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( c ) XSRETURN_UNDEF; RETVAL = c->Dropped(); OUTPUT: RETVAL void Final( THIS ) SV *THIS INIT: Error *e; ClientApi *c; SV *count; CODE: if ( ! ExtractData( THIS, &e, &c, &count ) ) XSRETURN_UNDEF; if ( SvIV( count ) ) { c->Final( e ); sv_setiv( count, SvIV(count) - 1 ); } else { warn( "Can't call Final() when you haven't called Init()" ); } SV * GetClient( THIS ) SV *THIS INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; StrPtr cl = c->GetClient(); RETVAL = newSVpv( cl.Text(), 0 ); OUTPUT: RETVAL SV * GetCwd( THIS ) SV *THIS INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; StrPtr cwd = c->GetCwd(); RETVAL = newSVpv( cwd.Text(), 0 ); OUTPUT: RETVAL SV * GetHost( THIS ) SV *THIS INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; StrPtr h = c->GetHost(); RETVAL = newSVpv( h.Text(), 0 ); OUTPUT: RETVAL SV * GetPassword( THIS ) SV *THIS INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; StrPtr p = c->GetPassword(); RETVAL = newSVpv( p.Text(), 0 ); OUTPUT: RETVAL SV * GetPort( THIS ) SV *THIS INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; StrPtr p = c->GetPort(); RETVAL = newSVpv( p.Text(), 0 ); OUTPUT: RETVAL SV * GetUser( THIS ) SV *THIS INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; StrPtr u = c->GetUser(); RETVAL = newSVpv( u.Text(), 0 ); OUTPUT: RETVAL SV * Init( THIS ) SV *THIS INIT: ClientApi *c; Error *e; SV *count; CODE: if ( ! ExtractData( THIS, &e, &c, &count ) ) XSRETURN_NO; if ( SvIV( count ) ) { warn( "P4::Client - client has already been initialized" ); XSRETURN_YES; } e->Clear(); c->Init( e ); RETVAL = newSViv( ! e->Test() ); if ( ! e->Test() ) sv_setiv( count, SvIV( count ) + 1 ); OUTPUT: RETVAL void Run( THIS, uiref, cmd, ... ) SV *THIS SV *uiref SV *cmd INIT: ClientApi *c; Error *e; SV *count; AV *args; I32 va_start = 3; I32 debug = 0; I32 argc; I32 stindex; I32 argindex; STRLEN len = 0; char *currarg; char **cmdargs = NULL; SV *sv; ClientUserPerl *ui = NULL; CODE: debug = DebugLevel( THIS ); if ( ! ExtractData( THIS, &e, &c, &count ) ) { warn("Not a P4::Client object" ); XSRETURN_UNDEF; } /* * First check that the client has been initialised. Otherwise * the result tends to be a SEGV */ if ( ! SvIV( count ) ) { warn("P4::Client::Run() - Client has not been initialised"); XSRETURN_UNDEF; } /* * Set up the ClientUserPerl interface */ if (sv_isobject(uiref) && sv_derived_from( uiref, "P4::UI") ) ui = new ClientUserPerl( uiref ); else { warn("P4::Client::Run() - uiref is not a P4::UI object"); XSRETURN_UNDEF; }; ui->DebugLevel( debug ); ui->DoPerlDiffs( DoPerlDiffs( THIS ) ); if ( debug ) printf( "[P4::Client::Run] Running a \"p4 %s\" with %d args\n", SvPV( cmd, PL_na ), items - va_start ); if ( items > va_start ) { argc = items - va_start; New( 0, cmdargs, argc, char * ); for ( stindex = va_start, argindex = 0; argc; argc--, stindex++, argindex++ ) { if ( SvPOK( ST(stindex) ) ) { currarg = SvPV( ST(stindex), len ); cmdargs[argindex] = currarg ; if ( debug ) printf( "\tArg[ %d ] = %s\n", argindex, currarg ); } else if ( SvIOK( ST(stindex) ) ) { /* * Be friendly and convert numeric args to * char *'s. Use Perl to reclaim the storage. * automatically by declaring them as mortal SV's */ char buf[32]; STRLEN len; sprintf(buf, "%d", SvIV( ST( stindex ) ) ); sv = sv_2mortal(newSVpv( buf, 0 )); currarg = SvPV( sv, len ); cmdargs[argindex] = currarg; if ( debug ) printf( "\tArg[ %d ] = %s\n", argindex, currarg ); } else { /* * Can't handle other arg types */ printf( "\tArg[ %d ] unknown type %d\n", argindex, SvTYPE( ST(stindex) ) ); die( "Invalid argument to P4::Client::Run" ); } } } len = 0; currarg = SvPV( cmd, len ); if ( debug ) { for ( int i = 0; i < items - va_start; i++ ) { printf("[P4::Client::Run] Arg[%d] = %s\n", i, cmdargs[i] ); } } c->SetArgv( items - va_start, cmdargs ); c->Run( currarg, ui ); if ( ui )delete ui; if ( cmdargs )Safefree( cmdargs ); void SetClient( THIS, clientName ) SV *THIS char *clientName INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; c->SetClient( clientName ); void _SetCwd( THIS, cwd ) SV *THIS char *cwd INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; c->SetCwd( cwd ); void SetHost( THIS, hostname ) SV *THIS char *hostname INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; c->SetHost( hostname ); void SetPassword( THIS, password ) SV *THIS char *password INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; c->SetPassword( password ); void SetPort( THIS, address ) SV *THIS char *address INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; c->SetPort( address ); void SetProtocol( THIS, protocol, value ) SV *THIS char *protocol char *value INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; c->SetProtocol( protocol, value ); void SetUser( THIS, username ) SV *THIS char *username INIT: ClientApi *c; CODE: c = ExtractClient( THIS ); if ( ! c ) XSRETURN_UNDEF; c->SetUser( username );