unit EPPJ ;

interface

uses { Delphi... }
     Classes ; { TList }

type TFile_Type = ( FT_Unknown, FT_List, FT_Directory, FT_Password ) ;

     TPrayer_List = class ;

     TPrayer_Item = class
                        public
                            ID : string ; { Unique ID }
                            Title : string ; { Prayer request title }
                            Text : string ; { Prayer request text }
                            More : string ; { URL for more information }
                            Image : string ; { URL for image }
                            Answered : string ; { "answered" text }
                            _Set : string ; { Name of set }
                            Startdate : string ; { Date or start date }
                            Enddate : string ; { End date }
                            Urgent : string ; { Text indicating urgency }
                            Hidden : boolean ;
                            Parent : TPrayer_List ; { Prayer list containing item }
                            Tag : integer ; { For developer use }

                            { Should pass False if not storing data securely }
                            function Serialize : string ;
                    end ;

     TEPPJ_File = class
                      public
                          File_Type : TFile_Type ;

                          function Count : integer ; virtual ;
                  end ;

     TSecurity = class( TEPPJ_File )
                     public
                         constructor Create ;
                end ;

     TPrayer_List = class( TEPPJ_File )
                        public
                            constructor Create ;
                            destructor Destroy ; override ;

                        private
                            _List : TList ;

                        protected
                            function List : TList ;
                            function Get_Item( Index : integer ) : TPrayer_Item ;
                            procedure Set_Item( Index : integer ; Value : TPrayer_Item ) ;

                        public
                            URL : string ;
                            Password : string ; { Reserved for client to save }

                            function Count : integer ; override ;
                            function Add( Value : TPrayer_Item ) : integer ;
                            procedure Delete( Value : integer ) ;

                            { Should pass False if not storing data securely }
                            function Serialize( Include_Password : boolean = True ) : string ;

                            property Items[ Index : integer ] : TPrayer_Item
                                read Get_Item
                                write Set_item ; default ;
                    end ;


type TDirectory_Entry = class
                            public
                                Name : string ;
                                URL : string ;
                                Tag : integer ; { For developer use }
                        end ;

     TDirectory = class( TEPPJ_File )
                      public
                          constructor Create ;
                          destructor Destroy ; override ;

                      private
                          _List : TList ;

                      protected
                          function List : TList ;

                      public
                          function Add( Value : TDirectory_Entry ) : integer ;
                          function Count : integer ; override ;
                          function Name( Index : integer ) : string ;
                          function URL( Index : integer ) : string ;
                          function Entry( Index : integer ) : TDirectory_Entry ;
                          function Indexof_Name( S : string ) : integer ;
                  end ;

type TURL_Source = class
                       public
                           function Get_Text( URL : string ) : string ;
                               virtual ; abstract ;
                   end ;

function Load_EPPJ( const URL : string ; Source : TURL_Source ;
    Redirection : boolean = false ;
    Load_Balance : boolean = false ) : TEPPJ_File ;
function Parse_File( S : string ; Source : TURL_Source ;
    Redirection : boolean = false ;
    Load_Balance : boolean = False ) : TEPPJ_File ;
function URL_Source : TURL_Source ;


implementation

uses { Delphi... }
     Sysutils, { lowercase }
     Strutils, { Posex }

     { C&C... }
     _Types, { Low_String_Index }
     UStrings ; { Left_Of }

var _URL_Source : TURL_Source = nil ;

function URL_Source : TURL_Source ;

begin
    if( _URL_Source = nil ) then
    begin
        _URL_Source := TURL_Source.Create ;
    end ;
    Result := _URL_Source ;
end ;


{ TEPPJ_File methods... }

function TEPPJ_File.Count : integer ;

begin
    Result := 0 ;
end ;



{ TSecurity methods... }

constructor TSecurity.Create ;

begin
    inherited Create ;

    File_Type := FT_Password ;
end ;



{ TPrayer_List methods... }

constructor TPrayer_List.Create ;

begin
    inherited Create ;

    File_Type := FT_List ;
end ;


destructor TPrayer_List.Destroy ;

var Index : integer ;

begin
    for Index := List.Count - 1 downto 0 do
    begin
        if( _List[ Index ] <> nil ) then
        begin
            TPrayer_Item( _List[ Index ] ).Free ;
        end ;
    end ;

    inherited Destroy ;
end ;


function TPrayer_List.List : TList ;

begin
    if( _List = nil ) then  _List := TList.Create ;
    Result := _List ;
end ;


function TPrayer_List.Get_Item( Index : integer ) : TPrayer_Item ;

begin
    Result := TPrayer_Item( List[ Index ] ) ;
end ;


procedure TPrayer_List.Set_Item( Index : integer ; Value : TPrayer_Item ) ;

begin
    List[ Index ] := Value ;
end ;


function TPrayer_List.Count : integer ;

begin
    Result := List.Count ;
end ;


function TPrayer_List.Add( Value : TPrayer_Item ) : integer ;

begin
    Result := List.Count ;
    _List.Add( Value ) ;
    Value.Parent := self ;
end ;


procedure TPrayer_List.Delete( Value : integer ) ;

begin
    _List.Delete( Value ) ;
end ;


function TPrayer_List.Serialize( Include_Password : boolean = True ) : string ;

var I : integer ;
    Item : TPrayer_Item ;

begin
    Result := '<url>' + URL + '</url>' ;
    if( Include_Password ) then
    begin
        Result := Result + '<pass>' + Password + '</pass>' ;
    end ;
    for I := 0 to List.Count - 1 do
    begin
        Item := Items[ I ] ;
        Result := Result + '<item>' + Item.Serialize + '</item>' ;
    end ;
end ;


{ TDirectory methods... }
constructor TDirectory.Create ;

begin
    inherited Create ;

    File_Type := FT_Directory ;
end ;


destructor TDirectory.Destroy ;

var Index : integer ;

begin
    for Index := List.Count - 1 downto 0 do TDirectory_Entry( _List[ Index ] ).Free ;

    inherited Destroy ;
end ;


function TDirectory.List : TList ;

begin
    if( _List = nil ) then  _List := TList.Create ;
    Result := _List ;
end ;


function TDirectory.Add( Value : TDirectory_Entry ) : integer ;

begin
    Result := List.Count ;
    _List.Add( Value ) ;
end ;


function TDirectory.Count : integer ;

begin
    Result := List.Count ;
end ;


function TDirectory.Name( Index : integer ) : string ;

begin
    Result := TDirectory_Entry( List[ Index ] ).Name ;
end ;


function TDirectory.URL( Index : integer ) : string ;

begin
    Result := TDirectory_Entry( List[ Index ] ).URL ;
end ;


function TDirectory.Entry( Index : integer ) : TDirectory_Entry ;

begin
    Result := TDirectory_Entry( List[ Index ] ) ;
end ;


function TDirectory.Indexof_Name( S : string ) : integer ;

var I : integer ;

begin
    Result := -1 ;
    for I := 0 to Count - 1 do
    begin
        if( Entry( I ).Name = S ) then
        begin
            Result := I ;
            exit ;
        end ;
    end ;
end ;


type TLoad_Balance = class
                         public
                             Percent : integer ;
                             URL : String ;
                     end ;

type TLoad_Balance_List = class
                              public
                                  destructor Destroy ; override ;

                              private
                                  _List : TList ;

                              protected
                                  function List : TList ;

                              public
                                  procedure Append( Spec : string ) ;
                                  procedure Prepend( P : integer ; Spec : string ) ;
                                  function Pick_URL( Source : TURL_Source ) : string ;
                          end ;

destructor TLoad_Balance_List.Destroy ;

var Index : integer ;

begin
    for Index := List.Count - 1 downto 0 do TLoad_Balance( _List[ Index ] ).Free ;
    _List.Free ;

    inherited Destroy ;
end ;


function TLoad_Balance_List.List : TList ;

begin
    if( _List = nil ) then _List := TList.Create ;
    Result := _List ;
end ;


procedure TLoad_Balance_List.Append( Spec : string ) ;

var Balance : TLoad_Balance ;

begin
    Balance := TLoad_Balance.Create ;
    Balance.URL := Spec ;
    List.Add( Balance ) ;
end ;


procedure TLoad_Balance_List.Prepend( P : integer ; Spec : string ) ;

var Balance : TLoad_Balance ;

begin
    Balance := TLoad_Balance.Create ;
    Balance.URL := Spec ;
    Balance.Percent := P ;
    List.Insert( 0, Balance ) ;
end ;


function TLoad_Balance_List.Pick_URL( Source : TURL_Source ) : string ;

    function Get_URL( U : string ) : string ;

    begin
        Result := '' ;
        if( Source <> nil ) then
        begin
            Result := Source.Get_Text( U ) ;
        end ;
    end ;

var Count, Total, Index, P : integer ;

begin
    Result := '' ;

    { Determine metrics... }
    Count := 0 ;
    Total := 0 ;
    for Index := 0 to List.Count - 1 do
    begin
        Total := Total + TLoad_Balance( _List[ Index ] ).Percent ;
        if( TLoad_Balance( _List[ Index ] ).Percent = 0 ) then
        begin
            inc( Count ) ;
        end ;
    end ;

    { For specs without a percentage, spread any remaning percentage among them...}
    if( Count > 0 ) then { Have unspecified specs }
    begin
        Total := ( 100 - Total ) div Count ; { Remaining percentage to split between specs }
        if( Total < 1 ) then Total := 1 ; { No less than 1% to each spec}
        for Index := 0 to List.Count - 1 do
        begin
            if( TLoad_Balance( _List[ Index ] ).Percent = 0 ) then
            begin
                TLoad_Balance( _List[ Index ] ).Percent := Total ;
            end ;
        end ;
    end ;

    { Now pick one at random... }
    randomize ;
    while( true ) do { Loop until we find a valid url }
    begin
        P := random( 100 ) ; { Determine percentage }
        for Index := 0 to _List.Count - 1 do
        begin
            if(
                ( TLoad_Balance( _List[ Index ] ).Percent <= P )
                or
                ( Index = _List.Count - 1 )
              ) then
            begin
                { Found a match, or ran out of possible targets... }
                Result := Get_URL( TLoad_Balance( _List[ Index ] ).URL ) ;
                if( pos( '<eppj>', Result ) > 0 ) then exit ; { Exit with our find }
                Result := '' ; { Otherwise, the target is not valid }
                _List.Delete( Index ) ; { Remove URL from choices }
                break ; { Try another random choice }
            end else
            begin
                P := P - TLoad_Balance( _List[ Index ] ).Percent ; { Adjust for next check}
            end ;
        end ;
    end ;
end ;


function TPrayer_Item.Serialize : string ;

begin
    Result := '<id>' + ID + '</id>' +
        '<title>' + Title + '</title>' +
        '<text>' + Text + '</text>' +
        '<more>' + More + '</more>' +
        '<image>' + Image + '</image>' +
        '<answered>' + Answered + '</answered>' +
        '<set>' + _Set + '</set>' +
        '<startdate>' + Startdate + '</startdate>' +
        '<enddate>' + Startdate + '</enddate>' +
        '<urgent>' + Urgent + '</urgent>' ;
    if( Hidden ) then
    begin
        Result := Result + '<hidden>' ;
    end ;
end ;


function Get_Tag_Contents( Name : string ; var S : string ) : string ;
{ Get text up to specified tag }

var I : integer ;

begin
    I := pos( '<' + Name + '>', S ) ;
    if( I < Low_String_Index ) then I := length( S ) + 1 ;
    Result := Left_Of( S, I ) ;
    S := Right_Of( S, I + length( Name ) + 1 ) ;
end ;


function Next_Tag( var S : string ) : string ;

var E, I : integer ;

begin
    Result := '' ;
    I := pos( '<', S ) ;
    if( I < Low_String_Index ) then exit ; { No more tags }
    E := posex( '>', S, I ) ;
    if( E < Low_String_Index ) then E := length( S ) + 1 ;
    Result := lowercase( copy( S, I, E - I + 1 ) ) ;
    S := Right_Of( S, E ) ;
end ;


function Parse_Load_Balance( S : string ) : TLoad_Balance_List ;

var I : integer ;
    Spec : string ;

begin
    Result := TLoad_Balance_List.Create ;
    while( S <> '' ) do
    begin
        Spec := Get_Tag_Contents( '</balance>', S ) ;
        I := pos( '%:', Spec ) ;
        if( I = 0 ) then
        begin
            Result.Append( Spec ) ;
        end else
        begin
            if( trystrtoint( copy( Spec, 1, I - 2 ), I ) ) then
            begin
                Result.Prepend( I, Spec ) ;
            end ;
        end ;

        S := Get_Tag_Contents( '<balance>', S ) ; { Find next balance tag }
    end ;
end ;


function Parse_File( S : string ; Source : TURL_Source ;
    Redirection : boolean = false ; Load_Balance : boolean = False ) : TEPPJ_File ;

var LBL : TLoad_Balance_List ;
    Dir : TDirectory ;
    Entry : TDirectory_Entry ;
    Item : TPrayer_Item ;
    SS, Tag : string ;

begin
    Result := nil ;
    if( S = '' ) then exit ; { Probably a failure to load file... }
    if( Left( S, 6 ) = 'secure' ) then
    begin
        Result := TSecurity.Create ;
        exit ;
    end ;
    if( pos( '<eppj>', S ) < Low_String_Index ) then exit ; { Not an eppj file... }
    Dir := nil ;
    Item := nil ;

    Get_Tag_Contents( 'eppj', S ) ; { Read (ignore) up to, and including, <eppj> }

    Tag := Next_Tag( S ) ;
    while( Tag <> '' ) do
    begin
        if( Tag = '<redirect>' ) then
        begin
            Tag := Get_Tag_Contents( '/redirect', S ) ;
            if( not Redirection ) then
            begin
                Load_EPPJ( Tag, Source, True, Load_Balance ) ;
                exit ;
            end ;
        end else
        if( Tag = '<balance>' ) then
        begin
            if( not Load_Balance ) then
            begin
                Load_Balance := True ;
                LBL := Parse_Load_Balance( S ) ;
                S := LBL.Pick_URL( Source ) ;
                LBL.Free ;
                if( S = '' ) then
                begin
                    exit ; { No valid balance target found }
                end ;
            end ;
        end else
        if( Tag = '<dir>' ) then
        begin
            if( Result = nil ) then
            begin
                Dir := TDirectory.Create ;
                Result := Dir ;
            end ;
            if( Result.File_Type = FT_Directory ) then
            begin
                SS := Get_Tag_Contents( '/dir', S ) ;
                Entry := TDirectory_Entry.Create ;
                Dir.Add( Entry ) ;
                while( SS <> '' ) do
                begin
                    Tag := Next_Tag( SS ) ;
                    if( Tag = '<name>' ) then
                    begin
                        Entry.Name := Get_Tag_Contents( '/name', SS ) ;
                    end else
                    if( Tag = '<url>' ) then
                    begin
                        Entry.URL := Get_Tag_Contents( '/url', SS ) ;
                    end else
                    begin
                        { Unrecognized tag - ignore it... }
                        Get_Tag_Contents( '/' + copy( Tag, 2, length( Tag ) ), SS ) ;
                    end ;
                end ;
            end ;
        end else
        if( Tag = '<item>' ) then
        begin
            if( Result = nil ) then
            begin
                Result := TPrayer_List.Create ;
            end ;
            if( Result.File_Type = FT_List ) then
            begin
                if( Item = nil ) then
                begin
                    Item := TPrayer_Item.Create ;
                    TPrayer_List( Result ).Add( Item ) ;
                end ;
            end ;
        end else
        if( Tag = '</item>' ) then
        begin
            Item := nil ;
        end else
        if( Tag = '<id>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.ID := Get_Tag_Contents( '/id', S ) ;
            end ;
        end else
        if( Tag = '<title>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Title := Get_Tag_Contents( '/title', S ) ;
            end ;
        end else
        if( Tag = '<text>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Text := Get_Tag_Contents( '/text', S ) ;
            end ;
        end else
        if( Tag = '<more>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.More := Get_Tag_Contents( '/more', S ) ;
            end ;
        end else
        if( Tag = '<image>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Image := Get_Tag_Contents( '/image', S ) ;
            end ;
        end else
        if( Tag = '<answered>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Answered := Get_Tag_Contents( '/answered', S ) ;
            end ;
        end else
        if( Tag = '<set>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item._Set := Get_Tag_Contents( '/set', S ) ;
            end ;
        end else
        if( Tag = '<pass>' ) then
        begin
            if( Result = nil ) then
            begin
                Result := TPrayer_List.Create ;
            end ;
            if( Result.File_Type = FT_List ) then
            begin
               TPrayer_List( Result ).Password := Get_Tag_Contents( '/pass', S ) ;
            end ;
        end else
        if( Tag = '<url>' ) then
        begin
            if( Result = nil ) then
            begin
                Result := TPrayer_List.Create ;
            end ;
            if( Result.File_Type = FT_List ) then
            begin
               TPrayer_List( Result ).URL := Get_Tag_Contents( '/url', S ) ;
            end ;
        end else
        if( Tag = '<startdate>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Startdate := Get_Tag_Contents( '/startdate', S ) ;
            end ;
        end else
        if( Tag = '<enddate>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Enddate := Get_Tag_Contents( '/enddate', S ) ;
            end ;
        end else
        if( Tag = '<hidden>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Hidden := True ;
            end ;
        end else
        if( Tag = '<urgent>' ) then
        begin
            if( Item <> nil ) then
            begin
                Item.Urgent := Get_Tag_Contents( '/urgent', S ) ;
            end ;
        end else
        begin
            { Unrecognized tag - ignore it... }
            Get_Tag_Contents( '/' + copy( Tag, 2, length( Tag ) ), S ) ;
        end ;
        Tag := Next_Tag( S ) ;
    end ;
end ; { Parse_File }


function Load_EPPJ( const URL : string ; Source : TURL_Source ;
    Redirection : boolean = false ;
    Load_Balance : boolean = false ) : TEPPJ_File ;

    function Get_URL( U : string ) : string ;

    begin
        Result := '' ;
        if( Source <> nil ) then
        begin
            Result := Source.Get_Text( U ) ;
        end ;
    end ;

var S : string ;

begin
    { Setup... }
    S := Get_URL( URL ) ;
    Result := Parse_File( S, Source, Redirection, Load_Balance ) ;
end ;



end.