1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822
|
unit uExampleData;
{
**********************************************************************
This file is part of a Lazarus Package, Examples Window.
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
**********************************************************************
This unit is the backend that provides a List that contains details of Lazarus
Example Projects. It might get its data from one of two different places,
* The LazarusDir, thats the SRC dir, examples shipped with Lazarus.
* Any Packages installed in Lazarus, looks in <pcp>staticpackages.inc and in
<pcp>packagefiles.xml. staticpackages.inc tells us its currently installed
but need to check in packagefiles.xml to find if its (a) a User install and
(b) if it has an example directory declared <ExamplesDirectory Value="../demo"/>
This list can be used to populate the Lazarus Examples Window or used during the
markup of existing Lazarus Projects. The unit is used by the Lazarus Package and
a simple tool used to manage the meta data files.
As of April 12, 2023, this unit no longer includes code to get and manage example
project in a remote git repo. As we now do cover third party project, a remote
"lazarus src only" example repo sounds out of scope.
}
{$mode ObjFPC}{$H+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
interface
uses
Classes, SysUtils, fpjson, jsonparser, jsonscanner, // these are the FPC JSON tools
httpprotocol, // for http encoding
base64,
Laz2_XMLRead, Laz2_DOM, LazFileUtils, FileUtil, LazLoggerBase
{$ifndef EXTESTMODE}
, IDEOptionsIntf
{$endif};
const
MetaFileExt = '.ex-meta'; // Extension of meta files.
type
TExampleDataSource = (FromGitlabTree, // Read all remote project meta files not used
FromLocalTree, // Read all local Git project meta files not used
FromThirdParty, // Packages listed in first block of packagefiles.xml
FromCacheFile, // Load data from Local Cache File not used
FromLazSrcTree); // Searches the Lazarus Src Tree, eg ~/examples; ~/components
PExRec=^TExRec;
TExRec = record
EName : string; // CamelCase version of the example name, filenameonly of metadata file.
Category : string; // eg Beginner, General, ThirdParty (read from remote data)
Keywords : TStringList; // a list of (possibly multi-word) words, nil acceptable
FFName : string; // An Absolute Path and filename of meta file in its original position, not copy.
Desc : string; // 1..many lines of description
ThirdParty : boolean; // False if examples are shipped in Lazarus Src.
end;
{ TExampleList }
TExampleList = class(TFPList)
private
procedure DumpList(wherefrom: string; ShowDesc: boolean = false);
function Get(Index: integer): PExRec;
function IsInKeywords(St : string; AnIndex : integer) : boolean;
public
constructor Create();
destructor Destroy; override;
// Public - Puts new entry in List, Keys may be Nil
function InsertData(Cat, Desc, FFName, AName: string; Keys: TStringList; IsTP: boolean=true): boolean;
function Find(const FFname: string): PExRec;
// function AsJSON(Index: integer): string;
// Ret T if all the strings in STL can match something in this record.
function IsInKeyWords(STL : TStringList; AnIndex : integer) : boolean;
property Items[Index: integer]: PExRec read Get; default;
end;
{ TExampleData }
TExampleData = class
private
ErrorString : String;
GetListDataIndex : integer;
// Passed full file name of the packagesfiles.xml file in PCP, returns
// with the list filled with paths to some directory above the package
// lpk file being a suitable place to start searching for Examples.
procedure CollectThirdPartyPackages(PkgFilesXML: String; AList, SList: TStrings);
function GetTheRecord(const FFname: string): PExRec;
// Returns true if it has altered FullPkgFileName to where we can expect to find Examples
function GetThirdPartyDir(var FullPkgFileName: string; CheckRunTimeOnly: boolean): boolean;
procedure ScanLazarusSrc;
// Triggers a search of installed Third Party packages. Iterates over packagefiles.xml
// and puts any potential paths to example directories in a list. Then iterates over
// that list scanning blow each path looking for example directories (ie ones with a
// ex_meta file). Any it finds are added to ExList.
procedure ScanThirdPartyPkg;
//function EscJSON(InStr: string): string;
function ExtractArrayFromJSON(const Field: string; jItem: TJSONData; STL: TStringList): boolean;
// Passed a json block, returns the indicated field, cannot handle arrays.
function ExtractFromJSON(const Field: string; const jItem: TJSONData; out Res: string; Base64: boolean = false): boolean;
// Receives a pretested JSON (not just a field) containing metadata of an Example
// Returns false if data missing, drops msg to console about bad field.
// Path may be relative or absolute (ie starting with '/' or '\'). Ones without
// a leading slash are remote, ie gitlab. Ones with a slash should be resolvable
// locally. Note when indexing a local git tree, relative must be used, ie top of
// git tree. In this mode of course, the entry will not be resolvable locally.
function InsertJSONData(jItem: TJSONData; FFName: string; IsTP : boolean; AName: string = ''): boolean;
// Gets passed a block of json, wrapped in {} containing several fields relating
// one example project. Path is ready to use in the List. Not suited to json
// With an internal Path field (ie master.ex-meta)
function ReadSingleJSON(FileContent: TStringList; IsTP : boolean; PathToStore: string = ''): boolean;
// Scans local tree below 'Path' looking for any likely Example Metadata files.
// For each, it loads content into a StringList and passes it to an Insert method.
// Path should be absolute and points to an 'Examples' or 'Demo' dir in a Third Party
// project (where it may find several project directories below).
function ScanLocalTree(Path: string): boolean;
procedure fSetErrorString(Er : string);
// Passed a full path to a metadata file, will open and process it.
function UseMetaDataFile(FFName: string; IsThirdParty : Boolean): boolean;
function DoesNameExist(AName : string) : boolean;
public
ExList : TExampleList;
CatList : TStringList; // A list of the categories we found in our examples, used by GUI.
LazConfigDir : string; // Where Lazarus keeps it config. Comes from uLaz_Examples, uIntf, LazarusIDE.GetPrimaryConfigPath
ExamplesHome : string; // dir above examples_working_dir where we copy examples to, set by uintf.pas, usually <lazConf>/
LazSrcDir : string; // Laz dir where, eg ~/examples lives
KeyFilter : string; // A list of words, possibly grouped by " to filter Keywords
// CatFilter : string; // A string that may contain 0 to n words, each word being a category as filtered by GetListData()
// Returns an index to EXList complying with supplied KeyWords and or CatFilter,
// if GetFirst, starts with lowest complient entry, then, increasing. Returns -1
// when it can find no more
function FindListData(GetFirst: boolean; TheCatFilter: string; KeyList: TStringList=nil): integer;
// A service function, tests passed St to ensure its
// a valid lump of Example Meta Data.
function TestJSON(const J: string; out Error, Cat: string): boolean;
// Returns a path (with trailing delim) to where we will putting our downloaded
// or copied Example Projects. It includes the working dir. Usually something
// like <lazConfig>/examples_work_dir/ but is user configurable via Laz Settings.
function ExampleWorkingDir: string;
// Public, returns with next set of data, false if no more available.
// Filters using CatFilter if CatFilter is not empty.
// If passed KeyList is not nil, filters keywords against KeyList.
// function GetListData(out Proj, Cat, Path, Keys: string; out Index: integer; // ToDo : remove this ?
// GetFirst: boolean; KeyList: TStringList=nil): boolean;
// Passed a created TStrings that it clears and fills in with all know categories
function getCategoryData(const ACatList : TStrings) : boolean;
constructor Create;
// This is the main "do it" call for this unit. It populates the list from the
// indicated source and sorts it on a pre determined category.
procedure LoadExData(DataSource: TExampleDataSource);
// Passed a index to the ExList.
// Returns a FullFilename to a lpi file of an Example, it might be the original one
// in a ThirdParty Package or the one copied to the Example Working Area.
// Ret '' if the lpi file is not found (because the project has not been copied or
// because it somehow lacks an lpi file).
function GetProjectFile(ExIndex: integer): string;
// Returns true if the item refered to has an .lpi file in either its original
// directory (ThirdParty) or in the copy in ExampleWorkArea (Lazarus SRC).
function IsValidProject(ExIndex: integer): boolean;
destructor Destroy; override;
function Count : integer;
property ErrorMsg : string read ErrorString write FSetErrorString;
class function EscJSON(InStr: string): string;
end;
implementation
uses
uConst {$ifdef EXTESTMODE}, Main_Examples{$endif} ;
// =============================================================================
// T E X A M P L E L I S T
//==============================================================================
function TExampleList.Get(Index: integer): PExRec;
begin
Result := PExRec(inherited get(Index));
end;
function TExampleList.InsertData(Cat, Desc, FFName, AName : string; Keys: TStringList; IsTP : boolean = true): boolean;
var
ExRecP : PExRec;
begin
ExRecP := find(FFName);
new(ExRecP);
ExRecP^.Category := Cat;
ExRecP^.KeyWords := Keys; // Nil is acceptable
ExRecP^.Desc := Desc;
ExRecP^.FFName := FFName;
ExRecP^.EName := AName;
ExRecP^.ThirdParty := IsTP;
result := (inherited Add(ExRecP) > -1);
end;
// Returns an unquoted string being one JSON Escaped record from list.
(*function TExampleList.AsJSON(Index : integer) : string; // Not used, maybe remove ? Or Add in EName
begin
Result := '';
Result := Result + 'Category : ' + Items[Index]^.Category + #10;
Result := Result + 'Keywords : ' + Items[Index]^.Keywords.Text + #10#10;
Result := Result + Items[Index]^.Desc;
Result := Result.Replace('\', '\\', [rfReplaceAll] );
Result := Result.Replace('"', '\"', [rfReplaceAll] );
end; *)
function TExampleList.IsInKeywords(St: string; AnIndex: integer): boolean;
var KeyWord : String;
begin
result := false;
if pos(lowercase(St), lowercase(Items[AnIndex]^.EName)) > 0 then exit(true);
for KeyWord in Items[AnIndex]^.Keywords do begin
if pos(lowercase(St), lowercase(Keyword)) > 0 then exit(True);
end;
end;
// Passed a List of keywords, tests each one against the list in the indicated
// TExampleList item, returns false if if finds a string that if not included
// in the TExampleList item keywords. Not a 1:1 match, the passed string can be
// a substring of the TExampleList item keyword. Not visa versa. Case Insensitive
function TExampleList.IsInKeyWords(STL: TStringList; AnIndex: integer): boolean;
var
St : string;
begin
for St in STL do
if not IsInKeywords(St, AnIndex)
then exit(False);
result := true;
end;
procedure TExampleList.DumpList(wherefrom: string; ShowDesc : boolean = false); // ToDo : remove this, its just a debug method
var
i : integer = 0;
begin
DebugLn('-------- ExampleData Examples List ' + Wherefrom + '----------');
while i < count do begin
DebugLn('----- List - FFName=[' + Items[i]^.FFName +'] Cat=[' + Items[i]^.Category
+ '] EName=' + Items[i]^.EName
+ '] ThirdParty=' + booltostr(Items[i]^.ThirdParty, True));
// + '] Key=[' + Items[i]^.Keywords.Text + ']');
if ShowDesc then
DebugLn(Items[i]^.Desc);
inc(i);
end;
end;
constructor TExampleList.Create();
begin
inherited Create;
end;
destructor TExampleList.Destroy;
var
i : integer;
begin
for I := 0 to Count-1 do begin
if Items[i]^.Keywords <> nil then
Items[i]^.Keywords.free;
dispose(Items[i]);
end;
inherited Destroy;
end;
function TExampleList.Find(const FFname: string): PExRec;
var
i : integer = 0;
begin
while i < count do begin
if Items[i]^.FFname = FFname then
exit(Items[i]);
inc(i);
end;
Result := nil;
end;
// =============================================================================
// T E X A M P L E D A T A
// =============================================================================
procedure TExampleData.CollectThirdPartyPackages(PkgFilesXML: String; AList, SList: TStrings);
// Think of this as iterating over the packagefiles.xml file, UserPkgLinks. If
// pkg is mentioned in staticpackages.inc, we tell GetThirdPartyDir() to not
// worry about testing for RunTimeOnly.
var
doc: TXMLDocument;
userPkgLinks, pkgNode: TDOMNode;
NameNode, FileNameNode: TDOMNode;
FileNameAttr, NameAttr : TDOMNode;
St : String;
OnlyIfRunTime : boolean = false; // if it turns out that it was not listed in staticpackages.inc
begin
if not FileExists(PkgFilesXML) then
exit;
ReadXMLFile(doc, PkgFilesXML);
try
userPkgLinks := doc.DocumentElement.FindNode('UserPkgLinks');
if userPkgLinks = nil then
exit;
pkgNode := userPkgLinks.FirstChild;
while pkgNode <> nil do begin
NameNode := pkgNode.FindNode('Name');
FileNameNode := pkgNode.FindNode('Filename');
if not ((NameNode = nil) or (FileNameNode = nil)) then begin
FileNameAttr := FileNameNode.Attributes.GetNamedItem('Value');
NameAttr := NameNode.Attributes.GetNamedItem('Value');
if not ((FileNameAttr = nil) or (NameAttr = nil)) then begin
St := NameAttr.Nodevalue;
OnlyIfRunTime := SList.IndexOf(St) < 0; // Comment this line to disallow RunTimeOnly
St := filenameAttr.Nodevalue;
ForcePathDelims(St);
if GetThirdPartyDir(St, OnlyIfRunTime) then begin
{$ifdef SHOW_DEBUG}debugln('CollectThirdPartyPackages adding St [' + St + ']');{$endif}
AList.Add(St);
end;
end;
end;
pkgNode := pkgNode.NextSibling;
end;
finally
doc.Free;
end;
end;
{ We look for a tag like <ExampleDirectory="../."/> just below <Package....
If we find it, we use that, relative to the actual path of the LPK file to
determine where we should, later, look for Examples.
if CheckRunTimeOnly, then it has aleady failed the staticpackages.inc test,
we give it a second chance, is it a RunTimeOnly ?
That is one without a <Type Value=xxx> element OR one with a <Type Value="RunTimeOnly"/>
But still must have the <ExampleDirectory Value=yyy> element.
}
function TExampleData.GetThirdPartyDir(var FullPkgFileName: string; CheckRunTimeOnly : boolean): boolean;
var
doc: TXMLDocument;
NodeA, NodeB: TDOMNode;
ADir : string = 'INVALID'; // Set to relative path from .lpk file to a dir above examples if available.
begin
Result := true;
{$ifdef SHOW_DEBUG}debugln('TExampleData.GetThirdParty - looking at [' + FullPkgFileName + ']');{$endif}
if not FileExists(FullPkgFileName) then
exit(false); // only real error return code
try
ReadXMLFile(doc, FullPkgFileName);
except on E: Exception do begin
debugln('Warning : [TExampleData.GetThirdPartyDir] XML Error : ' + E.Message);
if assigned(doc) then
doc.free;
exit(false);
end;
end;
try
FullPkgFileName := ExtractFileDir(FullPkgFileName); // Remove the LPK name, might be best we can do.
NodeB := doc.DocumentElement.FindNode('Package');
if NodeB = nil then exit;
NodeA := NodeB.FindNode('ExamplesDirectory');
if NodeA <> nil then begin
NodeB := NodeA.Attributes.GetNamedItem('Value');
if NodeB <> nil then // Leave existing path in FullPkgFileName, ie assumes LPK file is level or above examples
ADir := NodeB.NodeValue; // maybe something like eg ../../Examples
end;
{$ifdef SHOW_DEBUG}
debugln('TExampleData.GetThirdParty - ADir=[' + ADir + '] and FullPkgFileName=[' + FullPkgFileName +']');
{$endif}
if ADir = 'INVALID' then
exit(False)
else FullPkgFileName := ExpandFileName(appendPathDelim(FullPkgFileName) + ADir);
if not DirectoryExists(FullPkgFileName) then begin
debugln('Warning : [TExampleData.GetThirdPartyDir] : invalid directory for examples - ' + FullPkgFileName);
exit(False);
end;
if CheckRunTimeOnly then begin // seems it must be a RunTimeOnly package, was not found in staticfiles.inc
NodeA := NodeB.FindNode('Type');
if NodeA <> nil then begin // Not being there is good, indicates its RunTimeOnly
NodeB := NodeA.Attributes.GetNamedItem('Value');
if NodeB.NodeValue <> 'RunTimeOnly' then // if anything there, only RunTimeOnly works.
exit(False);
end;
end;
{$ifdef SHOW_DEBUG}
debugln('TExampleData.GetThirdParty - returning FullPkgFileName=[' + FullPkgFileName +']');
{$endif}
finally
doc.free;
end;
end;
(* An LPK file might look like this -
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<PathDelim Value="\"/>
<Name Value="my_great_package"/>
<Type Value="RunAndDesignTime"/>
<Author Value="David Bannon"/>
<ExampleDirectory Value="../Examples/"> // Maybe not there ....
.....
*)
procedure TExampleData.ScanThirdPartyPkg();
var
STL : TStringList; // The list we collect potential example directories in.
SSlist : TStringList; // The list of installed packages from staticpackages.inc
i : integer;
St : string;
begin
if not FileExists(LazConfigDir + 'staticpackages.inc') then
exit; // No third party packages installed yet, that was easy !
SSList := TStringList.Create;
// SSList.Sorted := true; // Don't sort 'cos we need edit each line below :-)
SSList.Duplicates := dupIgnore;
SSlist.LoadFromFile(LazConfigDir + 'staticpackages.inc');
if SSList.Count < 1 then begin // an empty file, unlikely
SSList.Free;
exit;
end;
for i := 0 to SSList.Count -1 do begin
if SSList[i].EndsWith(',') then begin
St := SSList[i];
delete(St, length(St), 1);
SSList[i] := St;
end;
end;
STL := TStringList.Create;
STL.Sorted := true;
STL.Duplicates := dupIgnore;
try
CollectThirdPartyPackages(LazConfigDir + 'packagefiles.xml', STL, SSList);
for i := 0 to Stl.Count -1 do begin
ScanLocalTree(STL[i]);
{$ifdef SHOW_DEBUG}
debugln('ScanThirdPartyPkg - Scanning ' + STL[i]);
{$endif}
end;
finally
STL.Free;
SSList.Free;
end;
//ExList.DumpList('After ScanThirdPartyPkg');
end;
// Address of this function is passed to a list sort call. We sort on category, Beginners at top
function CategorySorter( Item1: Pointer; Item2: Pointer) : Integer;
begin
result := CompareStr(PExRec(Item1)^.Category, PExRec(Item2)^.Category);
end;
function TExampleData.Count: integer;
begin
result := ExList.Count;
end;
procedure TExampleData.fSetErrorString(Er : string);
begin
ErrorString := Er;
Debugln('Warning : [TExampleData]' + ErrorString);
end;
function TExampleData.ExampleWorkingDir() : string;
begin
result := AppendPathDelim(ExamplesHome) + cExamplesDir + PathDelim ;
end;
function TExampleData.DoesNameExist(AName: string): boolean;
var
P : PExRec;
begin
for P in ExList do
if lowercase(AName) = lowercase(P^.EName) then
exit(True);
result := False;
end;
function TExampleData.TestJSON(const J : string; out Error, Cat : string) : boolean;
var
jData, jItem : TJSONData;
begin
Result := true;
if (J.Length = 0) or (J[1] <> '{') then begin // Ignore obvious non JSON
Error := 'Empty text or does not start with {';
exit(False)
end;
try
try
jData := GetJSON(J); // Is it valid JSON ?
jItem := jData.Items[0];
except
on E: EJSONParser do begin
Error := 'ERROR Parsing- invalid JSON ' + E.Message;
jData := Nil; // Appears nothing is allocated on error ?
exit(false);
end;
on E: EScannerError do begin
Error := 'ERROR Scanning- invalid JSON ' + E.Message;
jData := Nil; // Appears nothing is allocated on error ?
exit(false);
end;
end;
if TJSONObject(jItem).Count = 0 then begin
Error := 'WARNING - file does not contain suitable JSON : ';
exit(false);
end;
if not ExtractFromJSON('Category', jItem, Cat) then begin
Error := 'WARNING - Category Not Set ';
exit(false);
end;
finally
jData.free;
end;
end;
// jItem never contains Project Path, its either found in json Name (master)
// or derived from where we found the project (individual). So, always passed here.
function TExampleData.InsertJSONData(jItem : TJSONData; FFName : string; IsTP : boolean; AName : string = ''): boolean;
var
Cat, Desc, AnotherName : String;
// index : integer;
KeyWords : TStringList;
begin
Result := False;
if not ExtractFromJSON('Category', jItem, Cat) then // An empty field here is acceptable but undesirable.
debugln('Hint: (Lazarus) [TExampleData.InsertJSONData] Metadata file has no category : ' + FFName);
if not ExtractFromJSON('Description', jItem, Desc) then
debugln('Hint: (Lazarus) [TExampleData.InsertJSONData] Metadata file has no description : ' + FFName);
{$ifdef WINDOWS}
Desc := Desc.Replace(#10, #13#10, [rfReplaceAll]);
{$endif}
KeyWords := TStringList.Create;
ExtractArrayFromJSON('Keywords', jItem, Keywords);
if AName <> '' then
AnotherName := AName
else
if not ExtractFromJSON('Name', jItem, AnotherName) then
AnotherName := '';
if DoesNameExist(AnotherName) then
debugln('Warning: [TExampleData.InsertJSONData] duplicate Example Name found = '
+ AnotherName + ' ' + FFName)
else begin
Result := ExList.InsertData(Cat, Desc, FFName, AnotherName, KeyWords, IsTP);
if Result then
if CatList.Indexof(Cat) < 0 then
CatList.Add(Cat);
end;
if not Result then KeyWords.Free; // false means its not gone into list so our responsibility to free
end;
// Opens the examples.txt file in Examples dir of Lazarus Src, reads each line
// as a ex-meta file, adds that example to List.
procedure TExampleData.ScanLazarusSrc();
var
LazExList : TStringList;
FFName, St : string;
begin
FFName := LazSrcDir + 'examples' + PathDelim + 'examples.txt';
if not fileexists(FFName) then begin
debugln('Warning [TExampleData.ScanLazarusSrc] : ' + FFName + ' does not exist');
exit;
end;
LazExList := TStringList. Create;
LazExList.LoadFromFile(FFName);
for St in LazExList do
UseMetaDataFile(ExpandFileName(SetDirSeparators(LazSrcDir + St)), False);
LazExList.Free;
end;
function TExampleData.UseMetaDataFile(FFName : string; IsThirdParty : Boolean) : boolean;
var
FileContent : TStringList;
begin
FileContent := TStringList.Create;
try try
FileContent.LoadFromFile(FFName); // That is contents of one individual metadata file
except on E: Exception do
debugln('Warning : [TExampleData.UseMetaDataFile] ' + E.message);
end;
Result := ReadSingleJSON(FileContent, IsThirdParty, FFName); // Calls InsertJSONData() if successful
if not Result then begin
debugln('Warning : [TExampleData.UseMetaDataFile] Bad Example Meta File : ' + FFName);
debugln(ErrorMsg);
exit;
end;
finally
FileContent.Free;
end;
end;
function TExampleData.ScanLocalTree(Path : string) : boolean;
var
STL : TStringList = nil;
St : string;
begin
Result := True;
STL := FindAllFiles(Path, '*' + MetaFileExt, True);
try
for St in STL do begin
if St.EndsWith(MetaFileExt) then
UseMetaDataFile(ExpandFileName(SetDirSeparators(St)), True);
end;
finally
STL.Free;
end;
end;
function TExampleData.ReadSingleJSON(FileContent : TStringList; IsTP : boolean; PathToStore : string = '') : boolean;
var
jData, jItem : TJSONData;
begin
Result := true;
if (FileContent.Count > 0) and (FileContent[0][1] = '{') then begin // Ignore obvious non JSON
try
try
jData := GetJSON(FileContent.Text); // Is it valid JSON ?
jItem := jData.Items[0];
except
on E: EJSONParser do begin
ErrorMsg := 'Error in EJSONParser- invalid JSON in ' + PathToStore
+ ' ' + E.Message;
jData := Nil; // Appears nothing is allocated if error ?
exit(false);
end;
on E: EScannerError do begin // Thats in jsonscanner unit, Must doc on Wiki !!!
ErrorMsg := 'Error in EScanner- invalid JSON in ' + PathToStore // this is typically a single \
+ ' ' + E.Message;
jData := Nil; // Appears nothing is allocated if error ?
exit(false);
end;
end;
if TJSONObject(jItem).Count = 0 then begin
debugln('WARNING : [TExampleData.ReadSingleJSON] - file ' + PathToStore + ' does not contain suitable JSON : ');
exit(false);
end;
InsertJSONData(jItem, PathToStore, IsTP, TJSONObject(jData).Names[0]);
finally
jData.free;
end;
end;
end;
destructor TExampleData.Destroy;
begin
CatList.Free;
ExList.free;
inherited Destroy;
end;
constructor TExampleData.Create();
begin
ExList := TExampleList.Create;
CatList := TStringList.Create;
LazSrcDir := IDEEnvironmentOptions.GetParsedLazarusDirectory;
end;
procedure TExampleData.LoadExData(DataSource: TExampleDataSource);
begin
// If we are loading the data from either the remote gitlab tree or a local
// git tree, we save the master file.
if not DirectoryExists(ExampleWorkingDir()) then
if not ForceDirectory(ExampleWorkingDir()) then exit;
case DataSource of
FromLazSrcTree : ScanLazarusSrc(); // get 'built in' examples from Lazarus
FromThirdParty : ScanThirdPartyPkg(); // Get, eg, any OPM Examples or ones manually installed by user.
end;
ExList.Sort(@CategorySorter);
end;
class function TExampleData.EscJSON(InStr : string) : string;
begin
Result := InStr.Replace('\', '\\', [rfReplaceAll]);
Result := Result.Replace('"', '\"', [rfReplaceAll]);
Result := Result.Replace(#10, '\n', [rfReplaceAll] ); // LF
Result := Result.Replace(#13, '', [rfReplaceAll] ); // CR
Result := Result.Replace(#09, '', [rfReplaceAll] ); // tab
end;
// ******************** Methods relating to using the data *******************
function TExampleData.FindListData(GetFirst: boolean; TheCatFilter : string; KeyList : TStringList = nil) : integer;
begin
Result := -1;
if TheCatFilter = '' then exit;
if GetFirst then
GetListDataIndex := -1;
while True do begin
inc(GetListDataIndex);
if GetListDataIndex >= ExList.Count then exit; // end of list
if pos(ExList.Items[GetListDataIndex]^.Category, TheCatFilter) < 1 then
continue;
// if to here, have an entry thats a match for category, how about keywords ?
if KeyList = nil then exit(GetListDataIndex); // thats all we need then
if ExList.IsInKeywords(KeyList, GetListDataIndex) then // Found one !
exit(GetListDataIndex);
end;
end;
function TExampleData.getCategoryData(const ACatList: TStrings): boolean;
var
P : PExRec;
begin
if ACatList = nil then exit(false);
ACatList.Clear;
for P in ExList do begin
if ACatList.Indexof(P^.Category) < 0 then
ACatList.Add(P^.Category);
end;
Result := True;
end;
function TExampleData.IsValidProject(ExIndex : integer) : boolean;
var
CheckPath : string;
begin
CheckPath := GetProjectFile(ExIndex);
result := CheckPath <> '';
end;
function TExampleData.GetProjectFile(ExIndex : integer) : string;
var
CheckPath : string;
Info : TSearchRec;
begin
Result := '';
if not ExList[ExIndex]^.ThirdParty then
CheckPath := ExampleWorkingDir + lowercase(ExList[ExIndex]^.EName) + PathDelim
else
CheckPath := ExtractFilePath(ExList[ExIndex]^.FFName); // Remove metadata file name
{$ifdef SHOW_DEBUG} debugln('TExampleData.GetProjectFile Checking ' + CheckPath + ' for lpi file');{$endif}
if FindFirst(CheckPath + '*.lpi', faAnyFile, Info) = 0 then begin
Result := CheckPath + Info.Name;
end;
FindClose(Info);
end;
function TExampleData.GetTheRecord(const FFname: string) : PExRec;
begin
for Result in ExList do begin
if (lowercase(Result^.FFname) = lowercase(FFname)+MetaFileExt) then begin // extension must remain lower case
exit;
end;
end;
Result := Nil;
end;
// ************* Methods relating to getting REMOTE data *******************
// Passed some json, returns the indicated field IFF its an arrays. The TStringList
// must have been created before being passed.
function TExampleData.ExtractArrayFromJSON(const Field : string; jItem : TJSONData; STL : TStringList) : boolean;
// ToDo : better to handle this with a set or array ? Once populated, it does not change
var
JObject : TJSONObject;
jArray : TJSONArray;
i : integer;
begin
result := true;
try
JObject := TJSONObject(jItem); // does not require a free
if jObject.Find(Field, JArray) then
for i := 0 to JArray.count -1 do
STL.Add(JArray.Items[i].asstring);
except
on E:Exception do begin
Result := False; // Invalid JSON or content not present
ErrorMsg := 'Exception while decoding JSON looking for ' + Field;
end;
end;
end;
// Returns false if cannot parse passed jItem, thats not necessarily an error,
// Path will not be here if reading individual metadata files.
// If it is an error, ErrorString is set.
function TExampleData.ExtractFromJSON(const Field : string; const jItem : TJSONData;
out Res : string; Base64 : boolean=false) : boolean;
var
JObject : TJSONObject;
jStr : TJSONString;
begin
res := '';
try
JObject := TJSONObject(jItem); // does not require a free
if jObject.Find(Field, Jstr) then begin
if Base64 then
Res := DecodeStringBase64(jStr.AsString)
else Res := jStr.AsString;
end else if Field <> 'Path' then begin
ErrorMsg := 'Response has no ' + Field + ' field';
end;
except
on E:Exception do // Invalid JSON or content not present
ErrorMsg := 'Exception while decoding JSON looking for ' + Field;
end;
Result := (Res <> '');
end;
end.
|