------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
--
AWS " & Version & "
No rule found for '" & URI & "' in dispatch URI call and no " & "default dispatcher defined."); end Dispatch; -------------- -- Finalize -- -------------- overriding procedure Finalize (Dispatcher : in out Handler) is procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Regpat.Pattern_Matcher, Regpat_Access); Ref_Counter : constant Natural := Dispatcher.Ref_Counter; Item : URI_Class_Access; begin Finalize (AWS.Dispatchers.Handler (Dispatcher)); if Ref_Counter = 1 then while not Dispatcher.Table.Is_Empty loop Item := Dispatcher.Table.Last_Element; Dispatcher.Table.Delete_Last; Free (Item.Action); if Item.all in Reg_URI then Unchecked_Free (Reg_URI (Item.all).Reg_URI); end if; Unchecked_Free (Item); end loop; Free (Dispatcher.Action); end if; end Finalize; ----------- -- Match -- ----------- function Match (URI : Std_URI; Value : String) return Boolean is U : constant String := To_String (URI.URI); begin if URI.Prefix then if U'Length <= Value'Length then return Value (Value'First .. Value'First + U'Length - 1) = U; else return False; end if; else return U = Value; end if; end Match; overriding function Match (URI : Reg_URI; Value : String) return Boolean is begin return Regpat.Match (URI.Reg_URI.all, Value) = Value'First; end Match; -------------- -- Register -- -------------- procedure Register (Dispatcher : in out Handler; URI : String; Action : AWS.Dispatchers.Handler'Class; Prefix : Boolean := False) is Value : constant URI_Class_Access := new Std_URI'(new AWS.Dispatchers.Handler'Class'(Action), To_Unbounded_String (URI), Prefix); begin URI_Table.Append (Dispatcher.Table, Value); end Register; procedure Register (Dispatcher : in out Handler; URI : String; Action : Response.Callback; Prefix : Boolean := False) is begin Register (Dispatcher, URI, AWS.Dispatchers.Callback.Create (Action), Prefix); end Register; ------------------------------- -- Register_Default_Callback -- ------------------------------- procedure Register_Default_Callback (Dispatcher : in out Handler; Action : AWS.Dispatchers.Handler'Class) is begin if Dispatcher.Action /= null then Free (Dispatcher.Action); end if; Dispatcher.Action := new AWS.Dispatchers.Handler'Class'(Action); end Register_Default_Callback; --------------------- -- Register_Regexp -- --------------------- procedure Register_Regexp (Dispatcher : in out Handler; URI : String; Action : AWS.Dispatchers.Handler'Class) is Value : constant URI_Class_Access := new Reg_URI' (new AWS.Dispatchers.Handler'Class'(Action), To_Unbounded_String (URI), False, new Regpat.Pattern_Matcher'(Regpat.Compile (URI))); begin URI_Table.Append (Dispatcher.Table, Value); end Register_Regexp; procedure Register_Regexp (Dispatcher : in out Handler; URI : String; Action : Response.Callback) is begin Register_Regexp (Dispatcher, URI, AWS.Dispatchers.Callback.Create (Action)); end Register_Regexp; ---------------- -- Unregister -- ---------------- procedure Unregister (Dispatcher : in out Handler; URI : String) is begin for K in 1 .. Natural (URI_Table.Length (Dispatcher.Table)) loop declare Item : URI_Class_Access := URI_Table.Element (Dispatcher.Table, K); begin if To_String (Item.URI) = URI then Free (Item.Action); Unchecked_Free (Item); URI_Table.Delete (Dispatcher.Table, K); return; end if; end; end loop; raise Constraint_Error with "URI distpatcher " & URI & " not found"; end Unregister; end AWS.Services.Dispatchers.URI;