{ This file is part of the Free Pascal test suite. Copyright (c) 2002 by the Free Pascal development team. This program inserts the last tests run into TESTSUITE database. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$mode objfpc} {$h+} {$ifndef win32} {$linklib pthread} {$endif} program dbdigest; uses types, classes, custapp, sysutils, inifiles, teststr, testu, tresults, dbtests, digestanalyst; Type { TDBDigestApplication } TDBDigestApplication = class(TCustomApplication) Const ShortOpts = 'd'+ { coDatabaseName } 'h'+ { coHost } 'u'+ { coUserName } 'p'+ { coPassword } 'P'+ { coPort } 'l'+ { coLogFile } 'L'+ { coLongLogFile } 'o'+ { coOS } 'c'+ { coCPU } 'a'+ { coCategory } 'v'+ { coVersion } 't'+ { coDate } 's'+ { coSubmitter } 'm'+ { coMachine } 'C'+ { coComment } 'S'+ { coTestSrcDir } 'r'+ { coRelSrcDir } 'V'+ { coVerbose } 'Q' { coSQL } ; LongOpts : Array of string = ( 'databasename', 'host', 'username', 'password', 'port', 'logfile', 'longlogfile', 'os', 'cpu', 'category', 'version', 'date', 'submitter', 'machine', 'comment', 'testsrcdir', 'relsrcdir', 'verbose', 'sql', 'compilerdate', 'compilerfullversion', 'svncompilerrevision', 'svntestsrevision', 'svnrtlrevision', 'svnpackagesrevision' ); // Return true if we can continue function ProcessCommandLine(var aConfig: TDigestConfig; var aData: TTestRunData): Boolean; private class function ExtractDate(aValue: string): TDateTime; procedure Analyze(const aConfig: TDigestConfig; const aData: TTestRunData); procedure ProcessConfigfile(const aFileName: String; var aConfig: TDigestConfig; var aData: TTestRunData); function ProcessOption(const aOption: String; aValue: String; var aConfig: TDigestConfig; var aData: TTestRunData): Boolean; procedure ReadSystemDBConfig(var aConfig: TDigestConfig); protected procedure DoRun; override; procedure Usage(const aMsg: String); end; class Function TDBDigestApplication.ExtractDate(aValue : string) : TDateTime; var year,month,day,min,hour : word; begin if Length(avalue)=12 then begin year:=StrToInt(Copy(avalue,1,4)); month:=StrToInt(Copy(avalue,5,2)); day:=StrToInt(Copy(aValue,7,2)); hour:=StrToInt(Copy(aValue,9,2)); min:=StrToInt(Copy(aValue,11,2)); Result:=EncodeDate(year,month,day)+EncodeTime(hour,min,0,0); end else Verbose(V_Error,'Error in date format, use YYYYMMDDhhmm'); end; Function TDBDigestApplication.ProcessOption(const aOption : String; aValue: String; var aConfig : TDigestConfig; var aData : TTestRunData) : Boolean; begin Result:=True; Verbose(V_DEBUG,'Processing option: '+aOption); Case aOption of 'd','databasename' : aConfig.databasename:=aValue; 'h','host' : aConfig.host:=aValue; 'u','username': aConfig.username:=aValue; 'p','password': aConfig.password:=aValue; 'P','port': aConfig.port:=StrToIntDef(aValue,0); 'l','logfile': aData.logfile:=aValue; 'L','longlogfile': aData.longlogfile:=aValue; 'o','os': aData.os:=aValue; 'c','cpu': aData.cpu:=aValue; 'a','category': aData.category:=aValue; 'v','version': aData.version:=aValue; 't','date': aData.date:=ExtractDate(aValue); 's','submitter': aData.submitter:=aValue; 'm','machine': aData.machine:=aValue; 'C','comment': aData.config:=aValue; 'D','description': aData.description:=aValue; 'S','testsrcdir': aConfig.testsrcdir:=aValue; 'r','relsrcdir': aConfig.relsrcdir:=aValue; 'V','verbose': DoVerbose:=True; // 'S','sql': aConfig.sql:=aValue; 'compilerdate': aData.CompilerDate:=aValue; 'compilerfullversion': aData.CompilerFullVersion:=aValue; 'svncompilerrevision': aData.CompilerRevision:=aValue; 'svntestsrevision': aData.TestsRevision:=aValue; 'svnrtlrevision': aData.RTLRevision:=aValue; 'svnpackagesrevision' : aData.PackagesRevision:=aValue; else Verbose(V_ERROR,'Unknown processing option: '+aOption); end; end; Procedure TDBDigestApplication.ProcessConfigfile(const aFileName : String; var aConfig : TDigestConfig; var aData : TTestRunData); Var Cfg : TStrings; aLine,S,N,V : String; I : Integer; begin // Set the default value for old digests without RelSrcDir to the rtl/compiler // testsuite If Not FileExists(aFileName) Then Exit; Verbose(V_DEBUG,'Parsing config file: '+aFileName); Cfg:=TStringList.Create; try Cfg.LoadFromFile(aFileName); For aLine in Cfg do begin S:=Trim(aLine); I:=Pos('#',S); If I<>0 then S:=Copy(S,1,I-1); If (S<>'') then begin I:=Pos('=',S); if (I=0) then Verbose(V_ERROR,'Unknown processing option: '+S) else begin N:=LowerCase(Copy(S,1,I-1)); V:=Copy(S,I+1,Length(S)-I); ProcessOption(N,V,aConfig,aData); end; end; end; finally Cfg.Free; end; end; { TDBDigestApplication } Procedure TDBDigestApplication.Usage(const aMsg : String); begin if (aMsg<>'') then Writeln('Error : ',aMsg); Writeln('Usage: ',ExeName,' [options] [test run data options]'); Writeln('Configuration options:'); Writeln('-H --help show this help'); Writeln('-d --databasename=NAME database name'); Writeln('-f --config=FILENAME config file. If not set, dbdigest.cfg is used.'); Writeln('-h --host=HOST database hostname'); Writeln('-p --password=PWD database user password'); Writeln('-P --port=NNN database connection port'); Writeln('-r --relsrcdir relative source dir'); Writeln('-S --testsrcdir test source dir'); Writeln('-u --username=USER database user name'); Writeln('-V --verbose be more verbose'); Writeln('Test run data:'); Writeln('-l --logfile=FILE set log file to analyse'); Writeln('-L --longlogfile=FILE set long log filename (logs of run tests)'); Writeln('-o --os=OS set OS for testrun'); Writeln('-c --cpu=CPU set CPU'); Writeln('-a --category=CAT set category'); Writeln('-v --version=VER set compiler version'); Writeln('-t --date=DATE date in YYYMMDD(hhmmnn) format'); Writeln('-s --submitter=NAME submitter name'); Writeln('-m --machine=NAME set machine name on which testsuite was run'); Writeln('-C --compile-flags=FLAGS set used compilation flags'); Writeln(' --comment=FLAGS backwards compatible way to set compilation flags (deprecated)'); Writeln('-D --description=DESC set config description (helpful comment)'); Writeln(' --compilerdate=DATE set compiler date'); Writeln(' --compilerfullversion=VERSION set full compiler version'); Writeln(' --svncompilerrevision=REV set revision of used compiler'); Writeln(' --svntestsrevision=REV set revision of testsuite files'); Writeln(' --svnrtlrevision=REV set revision of RTL'); Writeln(' --svnpackagesrevision=REV set revison of packages'); Writeln(''); Writeln('The config file can contain the same options as the command-line in the form.'); Writeln('option=value'); Writeln('where option is the long or short version of the option'); Writeln('comments may be included using the # character.'); ExitCode:=Ord(aMsg<>''); end; function TDBDigestApplication.ProcessCommandLine(var aConfig: TDigestConfig; var aData : TTestRunData): Boolean; Function MakeOpts(s : string) : string; var C : char; begin Result:=''; For C in s do begin Result:=Result+C; if not (C in ['V','Q']) then Result:=Result+':'; end; end; Function MakeLongOpts(s : array of string) : TStringDynArray; var I : Integer; begin Result:=['help']; SetLength(Result,1+Length(S)); For I:=0 to Length(S)-1 do Result[1+i]:=S[I]+':' end; var Long,ErrMsg,lValue : String; Short : Char; I : integer; lHas : boolean; begin ErrMsg:=CheckOptions(MakeOpts(ShortOpts)+'H',MakeLongOpts(LongOpts)); Result:=(ErrMsg=''); if (not Result) or HasOption('H','help') then begin Usage(ErrMsg); Exit(false); end; I:=0; For Long in LongOpts do begin Inc(I); if I<=Length(ShortOpts) then begin Short:=ShortOpts[I]; if Short='r' then Writeln('ag'); lHas:=HasOption(Short,Long); lValue:=GetOptionValue(Short,Long); end else begin Short:=#0; lHas:=HasOption(Long); lValue:=GetOptionValue(Long); end; if lHas then ProcessOption(long,lValue,aConfig,aData); end; Result:=True; end; procedure TDBDigestApplication.Analyze(const aConfig : TDigestConfig; const aData : TTestRunData); var lSQL : TTestSQL; lDigest : TDBDigestAnalyzer; begin lDigest:=Nil; With aConfig do lSQL:=TTestSQL.create(databasename,host,username,password,port); try lSQL.ConnectToDatabase; lDigest:=TDBDigestAnalyzer.Create(lSQL); lDigest.Analyse(aConfig,aData); finally lDigest.Free; lSQL.Free; end; end; procedure TDBDigestApplication.ReadSystemDBConfig(var aConfig : TDigestConfig); // Keep filename in sync with algorithm in dbadd var lFileName : String; Ini : TCustomIniFile; begin lFileName:='/etc/dbdigest.ini'; if not FileExists(lFileName) then exit; Ini:=TMemIniFile.Create(lFileName); With Ini do try aConfig.DatabaseName:=ReadString(SSection,KeyName,'testsuite'); aConfig.Host:=ReadString(SSection,KeyHost,'localhost'); aConfig.UserName:=ReadString(SSection,KeyUser,''); aConfig.Password:=ReadString(SSection,KeyPassword,''); aConfig.Port:=ReadInteger(SSection,KeyPort,0); finally Ini.Free; end; end; procedure TDBDigestApplication.DoRun; var lConfigFile : String; lConfig : TDigestConfig; lData : TTestRunData; begin Terminate; lConfigFile:=GetOptionValue('f','config'); if lConfigFile='' then lConfigFile:='dbdigest.cfg'; lData:=Default(TTestRunData); lConfig:=Default(TDigestConfig); lConfig.RelSrcDir:='tests/'; ReadSystemDBConfig(lConfig); ProcessConfigFile(lConfigFile,lConfig,lData); if ProcessCommandLine(lConfig,lData) then Analyze(lConfig,lData); end; var Application : TDBDigestApplication; begin Application:=TDBDigestApplication.Create(Nil); Application.Initialize; Application.Run; Application.Free; end.