From c0de684114322075aa63b2478f98406397d58f78 Mon Sep 17 00:00:00 2001 From: loesje_ Date: Sat, 24 Oct 2015 09:48:42 +0000 Subject: [PATCH] * Added new application fppkgrepotest git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4379 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../trunk/fppkgrepotest.ini.template | 2 + .../fppkgrepotest/trunk/fppkgrepotest.lpi | 63 ++++ .../fppkgrepotest/trunk/fppkgrepotest.lpr | 288 ++++++++++++++++++ 3 files changed, 353 insertions(+) create mode 100644 applications/fppkgrepotest/trunk/fppkgrepotest.ini.template create mode 100644 applications/fppkgrepotest/trunk/fppkgrepotest.lpi create mode 100644 applications/fppkgrepotest/trunk/fppkgrepotest.lpr diff --git a/applications/fppkgrepotest/trunk/fppkgrepotest.ini.template b/applications/fppkgrepotest/trunk/fppkgrepotest.ini.template new file mode 100644 index 000000000..84994f8b6 --- /dev/null +++ b/applications/fppkgrepotest/trunk/fppkgrepotest.ini.template @@ -0,0 +1,2 @@ +[Settings] +repodir=~/repotest diff --git a/applications/fppkgrepotest/trunk/fppkgrepotest.lpi b/applications/fppkgrepotest/trunk/fppkgrepotest.lpi new file mode 100644 index 000000000..1ba340543 --- /dev/null +++ b/applications/fppkgrepotest/trunk/fppkgrepotest.lpi @@ -0,0 +1,63 @@ + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <CommandLineParams Value="-t all"/> + </local> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="fppkgrepotest.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="fppkgrepotest"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/applications/fppkgrepotest/trunk/fppkgrepotest.lpr b/applications/fppkgrepotest/trunk/fppkgrepotest.lpr new file mode 100644 index 000000000..d8a35eb9a --- /dev/null +++ b/applications/fppkgrepotest/trunk/fppkgrepotest.lpr @@ -0,0 +1,288 @@ +program fppkgrepotest; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Classes, + SysUtils, + CustApp, + pkgrepos, + pkgoptions, + pkgcommands, + pkgfpmake, + pkgglobals, + pkghandler, + typinfo, + fprepos, + IniFiles, + {$if (defined(unix) and not defined(android)) or defined(windows)} + pkgwget, + pkglnet, + {$endif} + fpjson; + +type + + { TfppkgRepoTest } + + TfppkgRepoTest = class(TCustomApplication) + private + FJsonResult: TJSONObject; + FJsonCommandArr: TJSONArray; + FCurrentCommand: TJSONObject; + FRepoDir: String; + function GetJsonLogArray(ForceCreate: Boolean): TJSONArray; + function SetupRepository(): Boolean; + function LastError: String; + procedure LoadIniFile(); + protected + procedure DoRun; override; + procedure TestPackage(APackageName: String); + procedure TestSinglePackage(APackage: TFPPackage); + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + procedure WriteHelp; virtual; + procedure AddLogLine(Level:TLogLevel; Const Msg: String); + end; + +var + Application: TfppkgRepoTest; + +procedure LogCmd(Level:TLogLevel; Const Msg: String); +begin + if (Level in LogLevels) then + Application.AddLogLine(Level, Msg); +end; + +{ TfppkgRepoTest } + +function TfppkgRepoTest.GetJsonLogArray(ForceCreate: Boolean): TJSONArray; +var + Parent: TJSONObject; +begin + if Assigned(FCurrentCommand) then + Parent := FCurrentCommand + else + Parent := FJsonResult; + + Result := Parent.Find('log', jtArray) as TJSONArray; + if ForceCreate and not assigned(Result) then + begin + Result := TJSONArray.Create; + Parent.Add('log', Result); + end; +end; + +function TfppkgRepoTest.SetupRepository: Boolean; +begin + Result := False; + try + LogLevels:=DefaultLogLevels; + pkgoptions.LoadGlobalDefaults(FRepoDir+'etc/fppkg.cfg'); + LoadCompilerDefaults; + + FPMakeCompilerOptions.CheckCompilerValues; + CompilerOptions.CheckCompilerValues; + + LoadLocalAvailableRepository; + FindInstalledPackages(CompilerOptions); + CheckFPMakeDependencies; + + LoadLocalAvailableMirrors; + + Result := True; + except + on E: Exception do + Log(etError, Format('Failed to setup repository: %s', [E.Message])); + end; +end; + +function TfppkgRepoTest.LastError: String; +var + LogArr: TJSONArray; + LogItem: TJSONObject; + i: Integer; +begin + result := ''; + LogArr := GetJsonLogArray(False); + if Assigned(LogArr) then + begin + for i := LogArr.Count-1 downto 0 do + begin + LogItem := (LogArr.Items[i]) as TJSONObject; + if LogItem.Get('LogLevel', '') = GetEnumName(TypeInfo(TLogLevel),LongInt(llError)) then + begin + result := LogItem.Get('Message', ''); + break; + end; + end; + end; +end; + +procedure TfppkgRepoTest.LoadIniFile; +var + IniFile: TIniFile; + CfgFile: String; +begin + CfgFile:=ChangeFileExt(ParamStr(0), '.ini'); + IniFile := TIniFile.Create(CfgFile); + try + FRepoDir := IncludeTrailingPathDelimiter(ExpandFileName(IniFile.ReadString('Settings','repodir','repotest'))); + finally + IniFile.Free; + end; +end; + +procedure TfppkgRepoTest.DoRun; +var + ErrorMsg: String; +begin + // quick check parameters + ErrorMsg:=CheckOptions('htdv', ['help','test','init']); + if ErrorMsg<>'' then + begin + ShowException(Exception.Create(ErrorMsg)); + Terminate; + Exit; + end; + + // parse parameters + + if HasOption('v','verbose') then + LogLevels:=AllLogLevels; + if HasOption('d','debug') then + LogLevels:=AllLogLevels+[llDebug]; + + LoadIniFile(); + + if HasOption('h', 'help') then + begin + WriteHelp; + Terminate; + Exit; + end; + + if HasOption('t','test') then + begin + TestPackage(GetOptionValue('t','test')); + end; + + // stop program loop + Terminate; + + WriteLn(FJsonResult.FormatJSON); +end; + + +procedure TfppkgRepoTest.TestSinglePackage(APackage: TFPPackage); +var + JsonResult: TJSONObject; + ErrMsg: String; +begin + FCurrentCommand := TJSONObject.Create; + try + FJsonCommandArr.Add(FCurrentCommand); + + FCurrentCommand.Add('action', 'test'); + JsonResult := TJSONObject.Create; + FCurrentCommand.Add('result', JsonResult); + + if not Assigned(APackage) then + begin + JsonResult.Add('status','failed'); + JsonResult.Add('message', 'Package not found'); + exit; + end; + + if not (CompilerOptions.CompilerCPU in APackage.CPUs) or + not (CompilerOptions.CompilerOS in APackage.OSes) then + begin + JsonResult.Add('status','skipped'); + JsonResult.Add('message', 'Package '+APackage.Name+' is not supported fot this target'); + exit; + end; + + FCurrentCommand.Add('packagename', APackage.Name); + + try + pkghandler.ExecuteAction(APackage.Name, 'install'); + except + on E: Exception do + pkgglobals.Log(llError, Format('Failed to install package %s: %s', [APackage.Name, E.Message])) + end; + + ErrMsg:=LastError; + if ErrMsg<>'' then + begin + JsonResult.Add('status','failed'); + JsonResult.Add('message', Format('Test failed: %s', [ErrMsg])); + end + else + begin + JsonResult.Add('status','ok'); + JsonResult.Add('message', 'Test passed'); + end; + finally + FCurrentCommand := nil; + end; +end; + +procedure TfppkgRepoTest.TestPackage(APackageName: String); +var + i: Integer; +begin + if SetupRepository then + begin + if APackageName='all' then + begin + for i:=0 to AvailableRepository.PackageCount-1 do + TestSinglePackage(AvailableRepository.Packages[i]); + end + else + TestSinglePackage(AvailableRepository.FindPackage(APackageName)); + end; +end; + +constructor TfppkgRepoTest.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + LogHandler := @LogCmd; + FJsonResult := TJSONObject.Create; + FJsonCommandArr := TJSONArray.Create; + FJsonResult.Add('commands',FJsonCommandArr); + StopOnException:=True; +end; + +destructor TfppkgRepoTest.Destroy; +begin + FJsonResult.Free; + inherited Destroy; +end; + +procedure TfppkgRepoTest.WriteHelp; +begin + { add your help code here } + writeln('Usage: ', ExeName, ' -h'); +end; + +procedure TfppkgRepoTest.AddLogLine(Level: TLogLevel; const Msg: String); +var + AJsonObj: TJSONObject; +begin + AJsonObj := TJSONObject.Create; + GetJsonLogArray(True).Add(AJsonObj); + AJsonObj.Add('LogLevel', GetEnumName(TypeInfo(TLogLevel),LongInt(Level))); + AJsonObj.Add('Message', Msg); +end; + +begin + Application:=TfppkgRepoTest.Create(nil); + Application.Title:='Fppkg repository tester'; + Application.Run; + Application.Free; +end. +