unit Sparkle.Uri;

{$I Sparkle.Inc}

interface

uses
  SysUtils;

type
  UriBadFormatException = class(Exception)
  end;

  TUri = class
  {
  scheme ":"
    authority [userinfo "@"] host [":" port]   termina com /, ? ou #
  }
  private
    FScheme: string;
    FFragment: string;
    FOriginalFragment: string;
    FQuery: string;
    FOriginalQuery: string;
    FHost: string;
    FPath: string;
    FOriginalPath: string;
    FUserInfo: string;
    FPort: integer;
    FUri: string;
    FSegments: TArray<string>;
//    function GetPathEncoded: string;
    function GetAuthority: string;
    const ReservedChars = ':/?#[]@';
    const SubDelimChars = '!$&''()*+,;=';
    procedure ParseUri(Uri: string);
    function IsDefaultPort: boolean;
    class function ExtractScheme(var S: string): string;
  public
    class function PercentEncode(const S: string): string; deprecated 'Use TSparkleUtils.PercentEncode instead';
    class function PercentDecode(const S: string): string; deprecated 'Use TSparkleUtils.PercentDecode instead';
    class function HasScheme(S: string): Boolean;
  public
    constructor Create(const AUri: string);
    function Clone: TUri;
    property Scheme: string read FScheme;
    property Host: string read FHost;
    property Query: string read FQuery;
    property OriginalQuery: string read FOriginalQuery;
    property Fragment: string read FFragment;
    property OriginalFragment: string read FOriginalFragment;
    property Path: string read FPath;
    property OriginalPath: string read FOriginalPath;
    property UserInfo: string read FUserInfo;
    property Port: integer read FPort;
    property Segments: TArray<string> read FSegments;
    property OriginalUri: string read FUri;
    property Authority: string read GetAuthority;
  end;

  TUriSegmentStack = class
  strict private
    FSegments: TArray<string>;
    FLength: integer;
    FCurrent: integer;
  public
    constructor Create(const ASegments: TArray<string>);
    function Count: integer;
    function Peek: string;
    function Pop: string;
    procedure Push;
  end;

implementation

uses
  Bcl.Utils, Sparkle.Utils, Character;

{ TUri }

function TUri.Clone: TUri;
begin
  Result := TUri.Create(FUri);
end;

constructor TUri.Create(const AUri: string);
begin
  ParseUri(AUri);
  FUri := AUri;
end;

class function TUri.ExtractScheme(var S: string): string;
var
  I: integer;
begin
  I := 1;
  Result := '';
  while (I <= Length(S)) and TBclUtils.IsLetter(S[I]) do
    Inc(I);

  if (I + 2) <= Length(S) then
    if (S[I] = ':') and (S[I + 1] = '/') and (S[I + 2] = '/') then
    begin
      Result := Copy(S, 1, I - 1);
      Delete(S, 1, I + 2);
    end;
end;

function TUri.GetAuthority: string;
begin
  if UserInfo <> '' then
    Result := UserInfo + '@' + Host
  else
    Result := Host;
  if not IsDefaultPort then
    Result := Result + ':' + IntToStr(Port);
end;

class function TUri.HasScheme(S: string): Boolean;
begin
  Result := ExtractScheme(S) <> ''
end;

//function TUri.GetPathEncoded: string;
//var
//  I: integer;
//begin
//  Result := '';
//  for I := 0 to Length(Segments) - 1 do
//    Result := Result + '/' + TSparkleUtils.PercentEncode(Segments[I]);
//  if Path[Length(Path)] = '/' then
//    Result := Result + '/';
//end;

function TUri.IsDefaultPort: boolean;
begin
  Result := (Port = 0)
    or ((Port = 80) and ((Scheme = 'http') or (Scheme = '')))
    or ((Port = 443) and (Scheme = 'https'));
end;

procedure TUri.ParseUri(Uri: string);

  function CharInArray(C: Char; Chars: array of Char): boolean;
  var
    C1: Char;
  begin
    for C1 in Chars do
      if C = C1 then
        Exit(true);
    Result := false;
  end;

  function ExtractStr(var S: string; Delims: array of Char; RemoveDelim: boolean): string;
  var
    I: integer;
  begin
    I := 1;
    Result := '';
    while (I <= Length(S)) and not CharInArray(S[I], Delims) do
      Inc(I);
    Result := Copy(S, 1, I - 1);
    if RemoveDelim then
      Delete(S, 1, I)
    else
      Delete(S, 1, I - 1);
  end;

var
  E: integer;
  RequiresScheme: boolean;
  LocalScheme: string;
  LocalPath: string;
  LocalQuery: string;
  LocalPortStr: string;
  LocalPort: integer;
  LocalHost: string;
  LocalFragment: string;
  LocalUserInfo: string;
  LocalSegments: string;
  LocalSegment: string;
  LocalAuthority: string;
begin
  RequiresScheme := false;
  // Quick parse. This can be later optimized/improved, but right now
  // we don't need a too complex just to parse 98% of existing Uri's
  // Also this just parses Uri, not general URN/URI syntax

  // get scheme
  LocalScheme := ExtractScheme(Uri);
  if (LocalScheme = '') and RequiresScheme then
    raise UriBadFormatException.Create('Scheme not specified');

  // get and parse authority
  LocalAuthority := ExtractStr(Uri, ['/', '?', '#'], false);
  if Pos('@', LocalAuthority) > 0 then
    LocalUserInfo := ExtractStr(LocalAuthority, ['@'], true)
  else
    LocalUserInfo := '';
  if Pos(':', LocalAuthority) > 0 then
  begin
    LocalHost := ExtractStr(LocalAuthority, [':'], true);
    LocalPortStr := LocalAuthority;
  end else
  begin
    LocalHost := LocalAuthority;
    LocalPortStr := '0';
  end;

  // get remaining Uri
  // check path
  if (Length(Uri) > 0) and (Uri[1] = '/') then
    LocalPath := ExtractStr(Uri, ['?', '#'], false)
  else
    LocalPath := '/';

  // check query
  if (Length(Uri) > 0) and (Uri[1] = '?') then
    LocalQuery := ExtractStr(Uri, ['#'], false)
  else
    LocalQuery := '';

  // remaing Uri is fragment
  LocalFragment := Uri;

  // Extract segments
  if (Length(LocalPath) > 0) and (LocalPath[1] = '/') then
    LocalSegments := Copy(LocalPath, 2, MaxInt)
  else
    LocalSegments := LocalPath;
  SetLength(FSegments, 0);
  while LocalSegments > '' do
  begin
    LocalSegment := ExtractStr(LocalSegments, ['/'], true);
    if LocalSegment <> '' then
    begin
      SetLength(FSegments, Length(FSegments) + 1);
      FSegments[Length(FSegments) - 1] := TSparkleUtils.PercentDecode(LocalSegment);
    end;
  end;

  // Final processing
//  LocalScheme := TSparkleUtils.PercentDecode(LocalScheme);
//  LocalUserInfo := TSparkleUtils.PercentDecode(LocalUserInfo);
//  LocalHost := TSparkleUtils.PercentDecode(LocalHost);
  Val(LocalPortStr, LocalPort, e);
//  LocalPath := TSparkleUtils.PercentDecode(LocalPath);
//  LocalQuery := TSparkleUtils.PercentDecode(LocalQuery);
//  LocalFragment := TSparkleUtils.PercentDecode(LocalFragment);

  // Default port
  if LocalPort = 0 then
  begin
    if (LocalScheme = '') or SameText(LocalScheme, 'http') then
      LocalPort := 80
    else
    if SameText(LocalScheme, 'https') then
      LocalPort := 443;
  end;

  // Copy to class. We could make this deferred later to improve performance, if needed
  FScheme := Lowercase(LocalScheme);
  FUserInfo := LocalUserInfo;
  FHost := LocalHost;
  FPort := LocalPort;
  FOriginalPath := LocalPath;
  FPath := TSparkleUtils.PercentDecode(LocalPath);
  FOriginalQuery := LocalQuery;
  FQuery := TSparkleUtils.PercentDecode(LocalQuery);
  FOriginalFragment := LocalFragment;
  FFragment := TSparkleUtils.PercentDecode(LocalFragment);
end;

class function TUri.PercentDecode(const S: string): string;
begin
  Result := TSparkleUtils.PercentDecode(S);
end;

class function TUri.PercentEncode(const S: string): string;
begin
  Result := TSparkleUtils.PercentEncode(S);
end;

{ TUriSegmentStack }

function TUriSegmentStack.Count: integer;
begin
  Result := FLength - FCurrent;
end;

constructor TUriSegmentStack.Create(const ASegments: TArray<string>);
begin
  FSegments := ASegments;
  FCurrent := 0;
  FLength := Length(FSegments);
end;

function TUriSegmentStack.Peek: string;
begin
  if FCurrent < FLength then
    Result := FSegments[FCurrent]
  else
    Result := '';
end;

function TUriSegmentStack.Pop: string;
begin
  Result := Peek;
  Inc(FCurrent);
end;

procedure TUriSegmentStack.Push;
begin
  Dec(FCurrent);
  if FCurrent < 0 then
    FCurrent := 0;
end;

end.

