unit HttpData;

{==========================================================}
{                                                          }
{  unit HttpSvr                        11/12/2002          }
{                                                          }
{  Data HTTP serveru                                       }
{                                                          }
{                                                          }
{  (C)2002, SofCon, Stresovicka 49, 160 00 Praha 6         }
{           Petr Cernin                                    }
{                                                          }
{==========================================================}

interface

{$I SETS.INC} { Nastaveni podmineneho prekladu }

uses
  Http;

  {-------------------------------
  { GetDocumentsForGet
  {---
  { Funkce vraci ukazatel na tabulku dokumentu zpracovavanych
  { metodou GET
  {---
  { Funkci volat jednotka HttpSvr
  }

  function  GetDocumentsForGet: PHttpDispatchItem;

  {-------------------------------
  { GetDocumentsForPost
  {---
  { Funkce vraci ukazatel na tabulku dokumentu zpracovavanych
  { metodou Post
  {---
  { Funkci volat jednotka HttpSvr
  }

  function  GetDocumentsForPost: PHttpDispatchItem;


implementation

uses
  Process,
  Strings,
  Kernel;


var
  { Parser parametru dotazu (http://server/dokument?parametry) }

  QParser : THttpQueryParser;

  {-------------------------------
  { GetDocRoot
  {---
  { Vyplneni odpovedi na dotaz GET /
  {---
  }

  function GetDocRoot( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far;
  begin
    with ASession^.Response do
    begin
      StatusCode := HTE_OK;

      BeginEntity;
      with Content do
      begin
        Append( '<HTML>' );
        Append( '<HEAD></HEAD>' );

        Append( '<BODY><B>WWW Server - HttpEx2</B><BR>' );
        AppendTime( HttpGetTime );
        Append( '<P>' );

        Append( '<A HREF="/state.xml">state.xml</A><BR>' );
        Append( '<A HREF="/params.xml">params.xml</A><BR>' );
        Append( '<A HREF="/archive.xml">archive.xml<A><BR>' );

        Append( '</BODY></HTML>' );
      end;

      EndEntity;
    end;

    GetDocRoot := True;
  end;


  {-------------------------------
  { GetDocState
  {---
  { Vyplneni odpovedi na dotaz GET /state.xml
  {---
  }

  function GetDocState( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far;
  begin
    with ASession^.Response do
    begin
      StatusCode := HTE_OK;
      ContentType := 'text/xml';

      BeginEntity;
      with Content do
      begin
        Append( '<state>');

        Append(   '<pressure>' );
        Append(      '<p1>' );
        AppendInt(      ProcState.Pressure.P1 );
        Append(      '</p1>' );
        Append(      '<p2>' );
        AppendInt(      ProcState.Pressure.P2 );
        Append(      '</p2>' );
        Append(      '<p3>' );
        AppendInt(      ProcState.Pressure.P3 );
        Append(      '</p3>' );
        Append(   '</pressure>' );

        Append(   '<temperature>' );
        Append(      '<t1>' );
        AppendInt(      ProcState.Temperature.T1 );
        Append(      '</t1>' );
        Append(      '<t2>' );
        AppendInt(      ProcState.Temperature.T2 );
        Append(      '</t2>' );
        Append(      '<t3>' );
        AppendInt(      ProcState.Temperature.T3 );
        Append(      '</t3>' );
        Append(   '</temperature>' );

        Append( '</state>' );
      end;
      EndEntity;
    end;

    GetDocState := True;
  end;

  {-------------------------------
  { GetDocArchive
  {---
  { Vyplneni odpovedi na dotaz GET /archive.xml
  {---
  }

  function GetDocArchive( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far;
  var
    ItemCount : Integer;
    ItemTime  : Longint;
    ItemValue : string;
    Idx       : Integer;
  begin
    with ASession^.Response do
    begin
      StatusCode := HTE_OK;
      ContentType := 'text/xml';

      BeginEntity;
      with Content do
      begin
        Lock; {--k archivu nemohou dva procesy pristupovat soucasne }

        ItemCount := 8;
        if ItemCount > ProcArchive.Count then ItemCount := ProcArchive.Count;

        Append( '<archive>');
        Append(   '<count>' );
        AppendInt(   ItemCount );
        Append(   '</count>' );
        Append(   '<items>' );

        for Idx := 0 to ItemCount - 1 do
        begin

          if archGetItem( - Idx - 1, ItemTime, ItemValue ) then
          begin
            Append( '<i'); AppendInt( Idx ); Append( '>' );
            Append(   '<time>' );
            AppendTime(  ItemTime);
            Append(   '</time>' );
            Append(   '<value>' );
            AppendStr(   ItemValue );
            Append(   '</value>' );
            Append( '</i'); AppendInt( Idx ); Append( '>' );
          end;
        end;

        Unlock;

        Append(   '</items>' );
        Append( '</archive>');
      end;
      EndEntity;
    end;

    GetDocArchive := True;
  end;


  {-------------------------------
  { GetDocParams
  {---
  { Vyplneni odpovedi na dotaz GET /params.xml
  {---
  }

  function GetDocParams( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far;
  begin
    with ASession^.Response do
    begin
      StatusCode := HTE_OK;
      ContentType := 'text/xml';
      BeginEntity;
      with Content do
      begin
        Append( '<params>');

        { Parametry regulatoru jsou typu real. Jejich kopirovani
          neni atomicke a proto je potreba zamezit prepnuti kontextu }

        Lock;

        Append(   '<regulatorA>' );
        Append(      '<P>' );
        AppendReal(     ProcParams.RegulatorA.P, 0, 3 );
        Append(      '</P>' );
        Append(      '<I>' );
        AppendReal(     ProcParams.RegulatorA.I, 0, 3 );
        Append(      '</I>' );
        Append(      '<D>' );
        AppendReal(     ProcParams.RegulatorA.D, 0, 3 );
        Append(      '</D>' );
        Append(   '</regulatorA>' );

        Append(   '<regulatorB>' );
        Append(      '<P>' );
        AppendReal(     ProcParams.RegulatorB.P, 0, 3 );
        Append(      '</P>' );
        Append(      '<I>' );
        AppendReal(     ProcParams.RegulatorB.I, 0, 3 );
        Append(      '</I>' );
        Append(      '<D>' );
        AppendReal(     ProcParams.RegulatorB.D, 0, 3 );
        Append(      '</D>' );
        Append(   '</regulatorB>' );

        Unlock;

        Append( '</params>' );
      end;
      EndEntity;
    end;

    GetDocParams := True;
  end;

  {-------------------------------
  { PostDocProc
  {---
  { Zpracovani dotazu POST /proc
  {---
  }

  function PostDocProc( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far;
  var
    Idx : Integer;

    procedure ModifyReal( var R: Real; Text: PChar );
    var
      Code  : Word;
      Value : Real;
    begin
      Val( StrPas( Text ), Value, Code );

      if Code = 0 then
      begin
        asm CLI end; { Zakaz preruseni }
        R := Value;
        asm STI end; { Povoleni preruseni }
      end;
    end;

  begin
    { Data jsou ulozena v promenna Request^.Content ve formatu
      ident1=value&ident2=value&. Nasledujici funkce provede
      preklad tohoto retezce }

    QParser.Parse( ASession^.Request.Content );

    with ASession^.Response do
    begin
      StatusCode := HTE_NO_CONTENT;

      for Idx := 0 to QParser.Count - 1 do
      begin
        with QParser.Params^[ Idx ] do
        begin
          {$ifdef DISPLAY}
          WriteLn( Name, ' = ', Value );
          {$endif}

          { Zjistime typ parametru a provedeme zmenu. V realne
            aplikace je potreba, zvlaste pak, pokud parametru bude vice,
            potreba tento krok udelat ponekud efektivneji... }

          if StrComp( Name, 'RegA.P' ) = 0 then
          begin
            ModifyReal( ProcParams.RegulatorA.P, Value );
          end
          else
          if StrComp( Name, 'RegA.I' ) = 0 then
          begin
            ModifyReal( ProcParams.RegulatorA.I, Value );
          end
          else
          if StrComp( Name, 'RegA.D' ) = 0 then
          begin
            ModifyReal( ProcParams.RegulatorA.D, Value );
          end
          else
          if StrComp( Name, 'RegB.P' ) = 0 then
          begin
            ModifyReal( ProcParams.RegulatorB.P, Value );
          end
          else
          if StrComp( Name, 'RegB.I' ) = 0 then
          begin
            ModifyReal( ProcParams.RegulatorA.I, Value );
          end
          else
          if StrComp( Name, 'RegB.D' ) = 0 then
          begin
            ModifyReal( ProcParams.RegulatorA.D, Value );
          end;

        end;
      end;

    end;

    PostDocProc := True;
  end;


  {-------------------------------
  { PostDocCmd
  {---
  { Zpracovani dotazu POST /cmd
  {---
  }

  function PostDocCmd( ASession: PHttpSession; APath: PChar;
    AIndex: Integer ): Boolean; far;
  var
    Cmd : PChar;
  begin
    { Data jsou ulozena v promenna Request^.Content ve formatu
      ident1=value&ident2=value&. Nasledujici funkce provede
      preklad tohoto retezce }

    QParser.Parse( ASession^.Request.Content );

    with ASession^.Response do
    begin
      StatusCode := HTE_NO_CONTENT;

      { Zjistime hodnotu parametu command }
      Cmd := QParser.GetValueOf( 'command' );

      if Cmd <> nil then
      begin

        if StrComp( Cmd, 'ClearArchive' ) = 0 then
        begin
          { Smazani archivu }
          archClear;
        end
        else begin
          { Jiny neobsluhovany prikaz }

          {$ifdef DISPLAY}
          WriteLn( 'Command = ', cmd );
          {$endif}
        end;

      end
      else begin
        { Parametry metody POST neobsahuji polozku command }
      end;

    end;

    PostDocCmd := True;
  end;


  {-------------------------------
  { GetDocumentsForGet
  {---
  { Funkce vraci ukazatel na tabulku dokumentu zpracovavanych
  { metodou GET
  {---
  { Funkci volat jednotka HttpSvr
  }

  function GetDocumentsForGet: PHttpDispatchItem;
  const
    DocumentsForGet: array[0..4] of THttpDispatchItem =
    (
      ( Segment: '';             Dispatcher: GetDocRoot  ),
      ( Segment: 'state.xml';    Dispatcher: GetDocState ),
      ( Segment: 'params.xml';   Dispatcher: GetDocParams ),
      ( Segment: 'archive.xml';  Dispatcher: GetDocArchive ),
      ( Segment: nil;            Dispatcher: nil )
    );

  begin
    GetDocumentsForGet := @DocumentsForGet;
  end;


  {-------------------------------
  { GetDocumentsForPost
  {---
  { Funkce vraci ukazatel na tabulku dokumentu zpracovavanych
  { metodou Post
  {---
  { Funkci volat jednotka HttpSvr
  }

  function GetDocumentsForPost: PHttpDispatchItem;
  const
    DocumentsForPost: array[0..2] of THttpDispatchItem =
    (
      ( Segment: 'proc';         Dispatcher: PostDocProc ),
      ( Segment: 'cmd';          Dispatcher: PostDocCmd ),
      ( Segment: nil;            Dispatcher: nil )
    );
  begin
    GetDocumentsForPost := @DocumentsForPost;
  end;

begin
  { Inicializace parseru parametru dotazu }
  QParser.Init( 8 {Max pocet parametru}  );
end.
