Index: readbookmarks.pas ================================================================== --- readbookmarks.pas +++ readbookmarks.pas @@ -1,10 +1,40 @@ #!/usr/bin/env instantfpc {$mode objfpc}{$H+}{$ASSERTIONS ON} uses - Classes, SysUtils, StrUtils, DateUtils, + Classes, SysUtils, StrUtils, fgl, Regexpr; + +type + TStringArray = array of string; + +function Join(const Strings: TStringArray; const Separator: string = sLineBreak): string; +var + i: integer; +begin + if Length(Strings) = 0 then + Exit; + Result := Strings[Low(Strings)]; + for i := Low(Strings) + 1 to High(Strings) do begin + Result := Result + Separator + Strings[i]; + end; +end {Join}; + +function IndexOfText(const S: string; const Strings: TStringArray): integer; +var + i: integer; +begin + Result := -1; + for i := Low(Strings) to High(Strings) do begin + if SameText(Strings[i], S) then begin + Result := i; + Exit; + end; + end; +end {IndexOfText}; + + type TFolder = class; { TEntry } @@ -44,20 +74,25 @@ private FAdded: TDateTime; FDescription: string; FModified: TDateTime; FName: string; + FAttributes: TStringList; protected procedure DoSetProperty(const Key, Value: string; var HasBeenSet: boolean); virtual; function GetHTMLAttributes: string; virtual; public + constructor Create(const AParent: TFolder; const LineNumber: cardinal); override; + destructor Destroy; override; + procedure ReadProperties(HtmlAttributes: string); property Name: string read FName write FName; property Added: TDateTime read FAdded write FAdded; property LastModified: TDateTime read FModified write FModified; property Description: string read FDescription write FDescription; + property Attributes: TStringList read FAttributes; end; { TFolder } TFolder = class(TContentEntry) @@ -73,79 +108,101 @@ function ToString: AnsiString; override; procedure SaveToStrings(const Strings: TStrings); override; property Entries: TEntries read FEntries; - property IsToolbarFolder: boolean read FToolbar; + property IsToolbarFolder: boolean read FToolbar write FToolbar; end; { TBookmark } TBookmark = class(TContentEntry) private + FURL: string; FFeedURL: string; FKeyword: string; - FURL: string; + FTags: TStringList; protected procedure DoSetProperty(const Key, Value: string; var HasBeenSet: boolean); override; function GetHTMLAttributes: string; override; public + constructor Create(const AParent: TFolder; const LineNumber: cardinal); override; + destructor Destroy; override; + procedure SaveToStrings(const Strings: TStrings); override; - property URL: string read FURL write FURL; - property FeedURL: string read FFeedURL write FFeedURL; - property Keyword: string read FKeyword write FKeyword; + property URL: string read FURL write FURL; + property FeedURL: string read FFeedURL write FFeedURL; + property Keyword: string read FKeyword write FKeyword; + property Tags: TStringList read FTags; end; const // for use both in HTMLDecode and HTMLEncode cEntities: array[0..9] of string = ('amp', '&', 'lt', '<', 'gt', '>', 'quot', '"', 'apos', ''''); function HTMLDecode(const HTML: string): string; var - i, ei: integer; + i: integer; c: char; - InEntity, Found: boolean; + InEntity: boolean; Entity: string; - CharCode: integer; + { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } + procedure ProcessEntity(const FoundSemicolon: boolean); + var + ei: integer; + CharCode: integer; + Found: boolean; + begin + Found := False; + if Length(Entity) > 1 then begin + if Entity[1] = '#' then begin + CharCode := 0; + if Entity[2] = 'x' then begin + Found := TryStrToInt('$' + Copy(Entity, 3, Length(Entity)), CharCode); + end else begin + Found := TryStrToInt(Copy(Entity, 2, Length(Entity)), CharCode); + end; + if Found then + Entity := Char(CharCode); + end else begin + for ei := Low(cEntities) to High(cEntities) do begin + if (ei mod 2) = 0 then begin + if Entity = cEntities[ei] then begin + Entity := cEntities[ei + 1]; + Found := True; + Break; + end; + end; + end {for}; + end; + end; + if Found then + Result := Result + Entity + else begin + Result := Result + '&' + Entity; + if FoundSemicolon then + Result := Result + ';'; + end; + InEntity := False; + Entity := ''; + end {ProcessEntity}; + { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } begin Result := ''; Entity := ''; InEntity := False; for i := 1 to Length(HTML) do begin + if InEntity and (Length(Entity) > 6) then + ProcessEntity(False); c := HTML[i]; if InEntity then begin - if c = ';' then begin - Found := False; - if Length(Entity) > 1 then begin - if Entity[1] = '#' then begin - CharCode := 0; - if Entity[2] = 'x' then begin - Found := TryStrToInt('$' + Copy(Entity, 3, Length(Entity)), CharCode); - end else begin - Found := TryStrToInt(Copy(Entity, 2, Length(Entity)), CharCode); - end; - if Found then - Entity := Char(CharCode); - end else begin - for ei := Low(cEntities) to High(cEntities) do begin - if (ei mod 2) = 0 then begin - if Entity = cEntities[ei] then begin - Entity := cEntities[ei + 1]; - Found := True; - Break; - end; - end; - end {for}; - end; - end; - if Found then - Result := Result + Entity - else - Result := Result + '&' + Entity + ';'; - InEntity := False; - Entity := ''; + if c = '&' then begin + ProcessEntity(False); + InEntity := True; + end else if c = ';' then begin + ProcessEntity(True); end else begin Entity := Entity + c; end; end else begin if c = '&' then begin @@ -154,14 +211,16 @@ end else begin Result := Result + c; end; end; end; + if InEntity then + ProcessEntity(False); end {HTMLDecode}; type - THTMLEncodingContext = (hecText, hecAttribute); + THTMLEncodingContext = (hecText, hecAttribute, hecURI); function HTMLEncode(const Text: string; const Context: THTMLEncodingContext = hecText): string; var i: integer; { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } @@ -182,14 +241,17 @@ { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - } begin Result := Text; for i := Length(Result) downto 1 do begin case Result[i] of - '&', '<', '>', #0: + '<', '>', #0: ReplaceEntity; + '&': + if Context <> hecURI then + ReplaceEntity; '"': - if Context = hecAttribute then + if Context in [hecAttribute, hecURI] then ReplaceEntity; end {case}; end; end {HTMLEncode}; @@ -247,10 +309,26 @@ FParent.Entries.Add(Self); end {TEntry.SetParent}; { TBookmark } + +constructor TBookmark.Create(const AParent: TFolder; const LineNumber: cardinal); +begin + inherited Create(AParent, LineNumber); + FTags := TStringList.Create; + FTags.Delimiter := ','; + FTags.StrictDelimiter := True; + FTags.Sorted := True; + FTags.Duplicates := dupIgnore; +end {TBookmark.Create}; + +destructor TBookmark.Destroy; +begin + FTags.Free; + inherited Destroy; +end {TBookmark.Destroy}; procedure TBookmark.DoSetProperty(const Key, Value: string; var HasBeenSet: boolean); begin inherited DoSetProperty(Key, Value, HasBeenSet); @@ -261,22 +339,28 @@ FFeedURL := Value; HasBeenSet := True; end else if SameText(Key, 'SHORTCUTURL') then begin FKeyword := Value; HasBeenSet := True; + end else if SameText(Key, 'TAGS') then begin + FTags.DelimitedText := Value; + HasBeenSet := True; end; end {TBookmark.DoSetProperty}; function TBookmark.GetHTMLAttributes: string; begin + Result := ''; if FURL <> '' then - Result := ' HREF="' + HTMLEncode(FURL, hecAttribute) + '"'; + Result := Result + ' HREF="' + HTMLEncode(FURL, hecURI) + '"'; if FFeedURL <> '' then - Result := Result + ' FEEDURL="' + HTMLEncode(FFeedURL, hecAttribute) + '"'; + Result := Result + ' FEEDURL="' + HTMLEncode(FFeedURL, hecURI) + '"'; if FKeyword <> '' then Result := Result + ' SHORTCUTURL="' + HTMLEncode(FKeyword, hecAttribute) + '"'; Result := Result + inherited GetHTMLAttributes; + if FTags.Count > 0 then + Result := Result + ' TAGS="' + HTMLEncode(FTags.DelimitedText, hecAttribute) + '"'; end {TBookmark.GetHTMLAttributes}; procedure TBookmark.SaveToStrings(const Strings: TStrings); begin Strings.Add(StringOfChar(' ', 4 * Level) + '
');
end {TFolder.SaveToStrings};
{ TContentEntry }
+
+constructor TContentEntry.Create(const AParent: TFolder; const LineNumber: cardinal);
+begin
+ inherited Create(AParent, LineNumber);
+ FAttributes := TStringList.Create;
+ FAttributes.NameValueSeparator := '=';
+end {TContentEntry.Create};
+
+destructor TContentEntry.Destroy;
+begin
+ FAttributes.Free;
+ inherited Destroy;
+end;
procedure TContentEntry.ReadProperties(HtmlAttributes: string);
+const
+ cKnownKeys: array[0..4] of string = ('ICON', 'ICON_URI', 'WEB_PANEL', 'UNFILED_BOOKMARKS_FOLDER', 'LAST_CHARSET');
var
rxAttr: TRegExpr;
Matches: boolean;
Key, Value: string;
HasBeenSet: boolean;
begin
+ FAttributes.Clear;
HtmlAttributes := TrimLeft(HtmlAttributes);
rxAttr := TRegExpr.Create;
rxAttr.Expression := '(\S+?)\s*=\s*"([^"]*)"';
rxAttr.Compile;
Matches := rxAttr.Exec(HtmlAttributes);
while Matches do begin
- Key := HTMLDecode(LowerCase(rxAttr.Match[1]));
+ Key := HTMLDecode(rxAttr.Match[1]);
Value := HTMLDecode(rxAttr.Match[2]);
HasBeenSet := False;
DoSetProperty(Key, Value, HasBeenSet);
- if not HasBeenSet then
- WriteLn(ErrOutput, '!!! Unprocessed property "', Key, '" in line ', Self.Line,' !!!');
+ if not HasBeenSet then begin
+ if IndexOfText(Key, cKnownKeys) = -1 then
+ WriteLn(ErrOutput, '!!! Unprocessed property "', Key, '" in line ', Self.Line,' !!!');
+ FAttributes.Add(Key + FAttributes.NameValueSeparator + Value);
+ end;
Matches := rxAttr.ExecNext;
end;
end {TContentEntry.ReadProperties};
function TContentEntry.GetHTMLAttributes: string;
+var
+ i: integer;
+ hec: THTMLEncodingContext;
begin
+ Result := '';
if FAdded > 0 then
- Result := ' ADD_DATE="' + IntToStr(SecondsBetween(FAdded, EncodeDate(1970, 1, 1))) + '"';
+ Result := Result + ' ADD_DATE="' + IntToStr(Round((FAdded - EncodeDate(1970, 1, 1)) * SecsPerDay)) + '"';
if FModified > 0 then
- Result := ' LAST_MODIFIED="' + IntToStr(SecondsBetween(FModified, EncodeDate(1970, 1, 1))) + '"';
+ Result := Result + ' LAST_MODIFIED="' + IntToStr(Round((FModified - EncodeDate(1970, 1, 1)) * SecsPerDay)) + '"';
+ for i := 0 to FAttributes.Count - 1 do begin
+ if AnsiContainsText(FAttributes.Names[i], 'URL') or AnsiContainsText(FAttributes.Names[i], 'HREF') or AnsiContainsText(FAttributes.Names[i], 'SRC') then
+ hec := hecURI
+ else
+ hec := hecAttribute;
+ Result := Result + ' ' + HTMLEncode(FAttributes.Names[i]) + '="' + HTMLEncode(FAttributes.ValueFromIndex[i], hec) + '"';
+ end;
end {TContentEntry.GetHTMLAttributes};
procedure TContentEntry.DoSetProperty(const Key, Value: string; var HasBeenSet: boolean);
var
Seconds: Integer;
begin
if SameText(Key, 'ADD_DATE') then begin
if TryStrToInt(Value, Seconds) then
- FAdded := EncodeDate(1970, 1, 1) + (Seconds / 86400)
+ FAdded := EncodeDate(1970, 1, 1) + (Seconds / SecsPerDay)
else
FAdded := 0;
HasBeenSet := True;
end else if SameText(Key, 'LAST_MODIFIED') then begin
if TryStrToInt(Value, Seconds) then
- FModified := EncodeDate(1970, 1, 1) + (Seconds / 86400)
+ FModified := EncodeDate(1970, 1, 1) + (Seconds / SecsPerDay)
else
FModified := 0;
HasBeenSet := True;
end;
end {TContentEntry.DoSetProperty};
-type
- TStringArray = array of string;
-
-function Join(const Strings: TStringArray; const Separator: string = sLineBreak): string;
-var
- i: integer;
-begin
- if Length(Strings) = 0 then
- Exit;
- Result := Strings[Low(Strings)];
- for i := Low(Strings) + 1 to High(Strings) do begin
- Result := Result + Separator + Strings[i];
- end;
-end {Join};
-
type
{ TDuplicateSet }
- TDuplicateSet = class(specialize TFPGObjectList