/*******************************************************************************
Copyright (c) 1997-2007, 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.
*******************************************************************************/
#ifdef OS_NT
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
# include <winsvc.h>
# include <ntservice.h>
# undef GetMessage
# undef SetPort
#endif // OS_NT
#define NEED_TIME
#include "clientapi.h"
#include "hostenv.h"
#include "strtable.h"
#include "debug.h"
#include "spec.h"
#include "enviro.h"
#include "ident.h"
#include "i18napi.h"
#include "perlheaders.h"
#include "p4result.h"
#include "p4perldebug.h"
#include "specmgr.h"
#include "perlclientuser.h"
#include "perlclientapi.h"
static Ident ident = {
IdentMagic "P4PERL" "/" ID_OS "/" ID_REL "/" ID_PATCH " (" ID_API " API)",
ID_Y "/" ID_M "/" ID_D
};
SV *
PerlClientApi::Identify()
{
StrBuf msg;
ident.GetMessage( &msg );
// Not mortal, XS will do that for us.
SV * sv = newSVpv( msg.Text(), msg.Length() );
return sv;
}
PerlClientApi::PerlClientApi()
{
Enviro env;
client = new ClientApi;
specMgr = new SpecMgr;
ui = new PerlClientUser( specMgr );
initCount = 0;
debug = 0;
maxResults = 0;
maxScanRows = 0;
maxLockTime = 0;
server2 = 0;
tagged = 1;
prog = "Unnamed P4Perl script";
client->SetProtocol( "specstring", "" );
if( char *c = env.Get( "P4CHARSET" ) )
SetCharset( c );
//
// Load the current ticket file. Start with the default, and then
// override it if P4TICKETS is set.
//
HostEnv henv;
Enviro enviro;
const char *t;
henv.GetTicketFile( ticketFile );
if( t = enviro.Get( "P4TICKETS" ) )
ticketFile = t;
}
PerlClientApi::~PerlClientApi()
{
Disconnect();
delete ui;
delete client;
delete specMgr;
}
SV *
PerlClientApi::Connect()
{
Error e;
if( initCount )
return &PL_sv_yes;
if( P4PERL_DEBUG_CMDS )
PerlIO_stdoutf( "[P4]: Connecting to Perforce\n" );
client->Init( &e );
if( e.Test() )
ui->HandleError( &e );
else
initCount++;
return initCount ? &PL_sv_yes : &PL_sv_no;
}
SV *
PerlClientApi::Disconnect()
{
if( !initCount )
return &PL_sv_yes;
if( P4PERL_DEBUG_CMDS )
PerlIO_stdoutf( "[P4]: Closing connection to Perforce\n" );
Error e;
client->Final( &e );
initCount--;
if( e.Test() )
ui->HandleError( &e );
return e.Test() ? &PL_sv_no : &PL_sv_yes;
}
SV *
PerlClientApi::IsConnected()
{
if( initCount && !client->Dropped() )
return newSViv( 1 );
return newSViv( 0 );
}
void
PerlClientApi::SetInput( SV *i )
{
if( P4PERL_DEBUG_FLOW )
PerlIO_stdoutf( "Saving user input for later\n" );
ui->SetInput( i );
}
void
PerlClientApi::SetApiLevel( int level )
{
StrBuf l;
l << level;
client->SetProtocol( "api", l.Text() );
}
SV *
PerlClientApi::SetCharset( const char *c )
{
CharSetApi::CharSet cs = CharSetApi::Lookup( c );
if( cs == (CharSetApi::CharSet) -1 )
{
warn( "Unknown charset ignored. Check your code or P4CHARSET." );
return &PL_sv_undef;
}
client->SetTrans( cs, cs, cs, cs );
client->SetCharset( c );
return &PL_sv_yes;
}
SV *
PerlClientApi::GetCharset()
{
const StrPtr &c = client->GetCharset();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetConfig()
{
const StrPtr &c = client->GetConfig();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetClient()
{
const StrPtr &c = client->GetClient();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetCwd()
{
const StrPtr &c = client->GetCwd();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetHost()
{
const StrPtr &c = client->GetHost();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetLanguage()
{
const StrPtr &c = client->GetLanguage();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetMaxResults()
{
return newSViv( maxResults );
}
SV *
PerlClientApi::GetMaxScanRows()
{
return newSViv( maxScanRows );
}
SV *
PerlClientApi::GetMaxLockTime()
{
return newSViv( maxLockTime );
}
SV *
PerlClientApi::GetPassword()
{
const StrPtr &c = client->GetPassword();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetPort()
{
const StrPtr &c = client->GetPort();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetProg()
{
return newSVpv( prog.Text(), prog.Length() );
}
SV *
PerlClientApi::GetVersion()
{
return newSVpv( version.Text(), version.Length() );
}
SV *
PerlClientApi::GetServerLevel()
{
return newSViv( server2 );
}
void
PerlClientApi::SetTicketFile( const char *t )
{
client->SetTicketFile( t );
ticketFile = t;
}
SV *
PerlClientApi::GetTicketFile()
{
return newSVpv( ticketFile.Text(), ticketFile.Length() );
}
SV *
PerlClientApi::GetUser()
{
const StrPtr &c = client->GetUser();
return newSVpv( c.Text(), c.Length() );
}
SV *
PerlClientApi::GetFirstOutput()
{
AV * output = ui->GetResults().GetOutput();
SV **s = av_fetch( output, 0, 0 );
return s ? *s : 0;
}
AV *
PerlClientApi::GetOutput()
{
return ui->GetResults().GetOutput();
}
AV *
PerlClientApi::GetWarnings()
{
return ui->GetResults().GetWarnings();
}
AV *
PerlClientApi::GetErrors()
{
return ui->GetResults().GetErrors();
}
I32
PerlClientApi::GetOutputCount()
{
return ui->GetResults().OutputCount();
}
I32
PerlClientApi::GetWarningCount()
{
return ui->GetResults().WarningCount();
}
I32
PerlClientApi::GetErrorCount()
{
return ui->GetResults().ErrorCount();
}
void
PerlClientApi::SetDebugLevel( int l )
{
debug = l;
ui->SetDebugLevel( l );
specMgr->SetDebug( l );
if( P4PERL_DEBUG_RPC )
p4debug.SetLevel( DT_RPC, 5 );
else
p4debug.SetLevel( DT_RPC, 0 );
}
AV *
PerlClientApi::Run( const char *cmd, int argc, char * const *argv )
{
StrBuf cmdstr;
ui->Reset();
if( P4PERL_DEBUG_CMDS )
{
cmdstr << cmd;
char * const *a = argv;
for( int i = 0; i < argc; i++, a++ )
cmdstr << " " << *a;
PerlIO_stdoutf( "[P4]: Executing: 'p4 %s'\n", cmdstr.Text() );
}
RunCmd( cmd, ui, argc, argv );
//
// Save the specdef for this command...
//
if( ui->LastSpecDef().Length() )
specDict.SetVar( cmd, ui->LastSpecDef() );
if( P4PERL_DEBUG_CMDS )
PerlIO_stdoutf( "[P4]: Completed: 'p4 %s'\n", cmdstr.Text() );
return GetOutput();
}
//
// RunCmd is a private function to work around an obscure protocol
// bug in 2000.[12] servers. Running a "p4 -Ztag client -o" messes up the
// protocol so if they're running this command then we disconnect and
// reconnect to refresh it. For efficiency, we only do this if the
// server2 protocol is either 9 or 10 as other versions aren't affected.
//
void
PerlClientApi::RunCmd( const char *cmd, ClientUser *ui, int argc, char * const *argv )
{
// If maxresults or maxscanrows is set, enforce them now
if( maxResults ) client->SetVar( "maxResults", maxResults );
if( maxScanRows ) client->SetVar( "maxScanRows", maxScanRows );
if( maxLockTime ) client->SetVar( "maxLockTime", maxLockTime );
if( tagged ) client->SetVar( "tag", "" );
client->SetProg( prog.Text() );
if( version.Length() )
client->SetVersion( version.Text() );
client->SetArgv( argc, argv );
client->Run( cmd, ui );
// Have to request server2 protocol *after* a command has been run. I
// don't know why, but that's the way it is.
if ( ! server2 )
{
StrPtr *pv = client->GetProtocol( "server2" );
if ( pv )
server2 = pv->Atoi();
}
if ( IsTagged() && StrRef( cmd ) == "client" &&
server2 >= 9 && server2 <= 10 )
{
if ( argc && ( StrRef( argv[ 0 ] ) == "-o" ) )
{
if ( P4PERL_DEBUG_CMDS )
PerlIO_stdoutf( "[P4]: Resetting connection to avoid obscure 2000.[12] protocol bug\n" );
Error e;
client->Final( &e );
client->Init( &e );
// Pass any errors down to the UI, so they'll get picked up.
if ( e.Test() )
ui->HandleError( &e );
}
}
}
//
// Convert a spec in string form into a hash and return a reference to that
// hash.
//
SV *
PerlClientApi::ParseSpec( const char *type, const char *form )
{
if( P4PERL_DEBUG_FLOW )
PerlIO_stdoutf( "[P4]: Parsing a %s form\n" );
Error e;
SV *spec = specMgr->StringToSpec( type, form, &e );
if( e.Test() )
{
ui->HandleError( &e );
return 0;
}
return spec;
}
//
// Convert a spec in hash form into its string representation
//
SV *
PerlClientApi::FormatSpec( const char *type, HV *hash )
{
if( P4PERL_DEBUG_FLOW )
PerlIO_stdoutf( "[P4]: Formatting a %s form\n" );
// Got a specdef so now we can attempt to convert.
StrBuf buf;
Error e;
specMgr->SpecToString( type, hash, buf, &e );
if( e.Test() )
{
StrBuf m;
m = "P4::FormatSpec(): Error converting hash to a string.";
warn( m.Text() );
e.Fmt( m, EF_PLAIN );
warn( m.Text() );
return &PL_sv_undef;
}
return newSVpv( buf.Text(), buf.Length() );
}