Skip to content

Commit

Permalink
M agpl-strings-fields.adb
Browse files Browse the repository at this point in the history 
M    agpl-strings-fields.ads
M    psql/agpl-db-psql.adb
M    psql/agpl-db-psql.ads
M    agpl-strings.adb
M    agpl-url.adb
M    agpl-url.ads
  • Loading branch information
@mosteo
mosteo committed Jan 15, 2007
1 parent 0b93903 commit 18c88c8
Show file tree
Hide file tree
Showing 7 changed files with 86 additions and 67 deletions.
11 changes: 8 additions & 3 deletions agpl-strings-fields.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,16 +91,21 @@ package body Agpl.Strings.Fields is
-- Returns the head or "" if no tokenizer found.
function String_tail
(s : String;
Separator : Character := '/')
Separator : Character := '/';
Start : Positive := 1)
return String
is
Skip : Natural := 0;
begin
if S = "" then
return S;
end if;
for n in S'Range loop
if S (n) = Separator and n < S'Last then
return S (n + 1 .. S'Last);
if S (n) = Separator then
Skip := Skip + 1;
if Skip = Start and then n < S'Last then
return S (N + 1 .. S'Last);
end if;
end if;
end loop;
return "";
Expand Down
10 changes: 7 additions & 3 deletions agpl-strings-fields.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -70,19 +70,23 @@ package Agpl.Strings.Fields is
-- String_Tail --
------------------------------------------------------------------------
-- Returns "" if no @Separator@ found.
-- Starts counts the amount of separators to skip over
function String_Tail
(S : String;
Separator : Character := '/')
Separator : Character := '/';
Start : Positive := 1)
return String;

function Tail
(S : String;
Separator : Character := '/')
Separator : Character := '/';
Start : Positive := 1)
return String renames String_Tail;

function T
(S : String;
Separator : Character := '/')
Separator : Character := '/';
Start : Positive := 1)
return String renames String_Tail;

------------------------------------------------------------------------
Expand Down
3 changes: 1 addition & 2 deletions agpl-strings.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,7 @@ package body Agpl.Strings is
Wnew : constant Natural := New_Pattern'Length - 1;
I : Positive := S'First;
begin
loop
while I + Wold <= S'Last loop
if S (I .. I + Wold) = Pattern then
Result (Pos .. Pos + Wnew) := New_Pattern;
I := I + Pattern'Length;
Expand All @@ -151,7 +151,6 @@ package body Agpl.Strings is
I := I + 1;
Pos := Pos + 1;
end if;
exit when I + Wold > S'Last;
end loop;

Result (Pos .. Pos + S'Last - I) := S (I .. S'Last);
Expand Down
82 changes: 52 additions & 30 deletions agpl-url.adb
View file
Original file line number Diff line number Diff line change
@@ -1,36 +1,8 @@
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2004 --
-- ACT-Europe --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------

-- $Id: aws-url.adb,v 1.37 2004/11/10 13:53:24 obry Exp $

with Agpl.Conversions;
with Agpl.Ustrings; use Agpl.Ustrings;

with Ada.Characters.Handling;
with Ada.Strings.Fixed;

package body Agpl.URL is

Expand Down Expand Up @@ -156,4 +128,54 @@ package body Agpl.URL is
return Res (1 .. K);
end Encode;

---------------
-- Normalize --
---------------

function Normalize (Url : in String) return String is
Url_Path : Ustring := +Url;

K : Natural;
P : Natural;

use Asu;
begin
-- Checks for current directory and removes all occurences

-- Look for starting ./

if Length (URL_Path) >= 2 and then Slice (URL_Path, 1, 2) = "./" then
Delete (URL_Path, 1, 1);
end if;

-- Look for all /./ references

loop
K := Index (URL_Path, "/./");

exit when K = 0;

Delete (URL_Path, K, K + 1);
end loop;

-- Checks for parent directory

loop
K := Index (URL_Path, "/../");

exit when K = 0;

-- Look for previous directory, which should be removed

P := Strings.Fixed.Index
(Slice (URL_Path, 1, K - 1), "/", Strings.Backward);

exit when P = 0;

Delete (URL_Path, P, K + 2);
end loop;

return +URL_Path;
end Normalize;

end Agpl.URL;
32 changes: 3 additions & 29 deletions agpl-url.ads
View file
Original file line number Diff line number Diff line change
@@ -1,32 +1,3 @@
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2004 --
-- ACT-Europe --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------

-- $Id: aws-url.ads,v 1.18 2004/11/10 13:53:24 obry Exp $

with Ada.Strings.Maps;

Expand Down Expand Up @@ -58,6 +29,9 @@ package Agpl.URL is

Default_Encoding_Set : constant Strings.Maps.Character_Set;

function Normalize (URL : in String) return String;
-- Remove . and .. instances

function Encode
(Str : in String;
Encoding_Set : in Strings.Maps.Character_Set := Default_Encoding_Set)
Expand Down
11 changes: 11 additions & 0 deletions psql/agpl-db-psql.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,17 @@ package body Agpl.Db.Psql is
Log ("Agpl.Db.Psql.Query [Exception for query]: " & Q, Error);
end Query;

-----------
-- Query --
-----------

function Query (Db : Database; Sql : String) return String is
R : Result;
begin
Query (R, Db, Sql);
return Value (R, 0, 0);
end Query;

-----------------------
-- Begin_Transaction --
-----------------------
Expand Down
4 changes: 4 additions & 0 deletions psql/agpl-db-psql.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,10 @@ package Agpl.Db.Psql is
procedure Query (R : out Result; Db : Database; Q : String);
-- Performs the query and checks for failure

function Query (Db : Database; Sql : String) return String;
-- Get the first column of the first row of a query.
-- Useful for count and the like

procedure Begin_Transaction (Db : Database);

procedure Commit_Transaction (Db : Database);
Expand Down

0 comments on commit 18c88c8

Please sign in to comment.