----------------------------------------------------------------------------- -- -- libwww-ada95 : A World Wide Web client library for Ada95 -- -- W W W . M E S S A G E -- -- B o d y -- -- Copyright (C) 1997-1998 Regents of the University of California -- -- libwww-ada95 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, with or without the single exception listed below; -- either version 2, or (at your option) any later version. libwww-ada95 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 -- distributed with libwww-ada95; see the file COPYING. If not, write to the -- Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. -- -- As a special exception, if other files instantiate generics from this -- library, or you link this library with other files to produce an -- executable, this library 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 General Public License. -- -- Created in 1997 by Kari Nies ----------------------------------------------------------------------------- with Text_IO; with Onions; package body WWW.Message is package VLs renames Value_Lists; -- required by style-checker function Lower_Case (UBS : UB_String) return UB_String; -- return a lower case copy of an unbounded string function Lower_Case (UBS : UB_String) return UB_String is LC_UBS : UB_String := UBS; C : CHARACTER; begin for i in 1 .. UB_Strings.Length (LC_UBS) loop C := UB_Strings.Element (LC_UBS, i); if C in 'A' .. 'Z' then UB_Strings.Replace_Element (LC_UBS, i, CHARACTER'Val (CHARACTER'Pos (C) + CHARACTER'Pos ('a') - CHARACTER'Pos ('A'))); end if; end loop; return LC_UBS; end Lower_Case; ---------------------------------------------------------------- -- insert header into the message object -- if header with given field name already exists, append the -- value [list] to the existing header -- resets Values to empty ---------------------------------------------------------------- procedure Insert_Header (Message : in out Message_Object; Field_Name : UB_String; Values : in out Value_List) is LC_Field_Name : UB_String := Lower_Case (Field_Name); MH : Message_Header; begin MH := Hash_Table.Fetch (Message.Message_Headers, LC_Field_Name); -- must be in table, append to the existing value list Value_Lists.Append (MH.Values, Values); exception when Hash_Table.Not_Bound => -- not already in table, insert it Hash_Table.Bind (Message.Message_Headers, LC_Field_Name, Message_Header'(Field_Name, Values)); Values := Value_Lists.Empty_List; end Insert_Header; procedure Insert_Header (Message : in out Message_Object; Field_Name : STRING; Values : in out Value_List) is begin Insert_Header (Message, UB_Strings.To_Unbounded_String (Field_Name), Values); end Insert_Header; procedure Insert_Header (Message : in out Message_Object; Field_Name : UB_String; Value : UB_String) is VL : Value_List; begin Value_Lists.Insert (VL, Value); Insert_Header (Message, Field_Name, VL); end Insert_Header; procedure Insert_Header (Message : in out Message_Object; Field_Name : STRING; Value : STRING) is VL : Value_List; begin Value_Lists.Insert (VL, UB_Strings.To_Unbounded_String (Value)); Insert_Header (Message, UB_Strings.To_Unbounded_String (Field_Name), VL); end Insert_Header; ---------------------------------------------------------------- -- returns a list of values associated with the given field name ---------------------------------------------------------------- function Get_Value_List (Message : Message_Object; Field_Name : UB_String) return Value_List is MH : Message_Header; begin MH := Hash_Table.Fetch (Message.Message_Headers, Lower_Case (Field_Name)); return MH.Values; end Get_Value_List; function Get_Value_List (Message : Message_Object; Field_Name : STRING) return Value_List is begin return Get_Value_List (Message, UB_Strings.To_Unbounded_String (Field_Name)); end Get_Value_List; ---------------------------------------------------------------- -- returns a ordered, concatenated, comma-separated string of all -- values associated with the given field name ---------------------------------------------------------------- use UB_Strings; function Get_Header_Value_String (Message : Message_Object; Field_Name : UB_String) return UB_String is VL : Value_List; VL_Iter : Value_Lists.List_Iterator; UBS : UB_String; UBS_Sub : UB_String; begin VL := Get_Value_List (Message, Field_Name); VL_Iter := Value_Lists.New_Iterator (VL); if Value_Lists.More (VL_Iter) then Value_Lists.Next (VL_Iter, UBS); while Value_Lists.More (VL_Iter) loop Value_Lists.Next (VL_Iter, UBS_Sub); -- ! note & is probably too inefficent UBS := UBS & "," & UBS_Sub; end loop; end if; return UBS; exception when Hash_Table.Not_Bound => raise Invalid_Field_Name; end Get_Header_Value_String; function Get_Header_Value_String (Message : Message_Object; Field_Name : STRING) return UB_String is begin return Get_Header_Value_String (Message, UB_Strings.To_Unbounded_String (Field_Name)); end Get_Header_Value_String; function Image (Version : Version_Record) return String is begin return Onions.Image (Version.Major_Revision) & "." & Onions.Image (Version.Minor_Revision); end Image; procedure Print_Message (Message : Message_Object) is MHT_Iter : Hash_Table.Values_Iter; MH : Message_Header; VL_Iter : Value_Lists.List_Iterator; UBS : UB_String; begin -- only printing headers for now, add body later MHT_Iter := Hash_Table.Make_Values_Iter (Message.Message_Headers); -- iterate through all message header lists stored in hash table while Hash_Table.More (MHT_Iter) loop Hash_Table.Next (MHT_Iter, MH); Text_IO.Put (UB_Strings.To_String (MH.Field_Name) & ": "); -- iterate through message header value list VL_Iter := Value_Lists.New_Iterator (MH.Values); if Value_Lists.More (VL_Iter) then Value_Lists.Next (VL_Iter, UBS); Text_IO.Put (UB_Strings.To_String (UBS)); while Value_Lists.More (VL_Iter) loop Value_Lists.Next (VL_Iter, UBS); Text_IO.Put ("," & UB_Strings.To_String (UBS)); end loop; end if; Text_IO.New_Line; end loop; exception when Hash_Table.Not_Bound => raise Invalid_Field_Name; end Print_Message; end WWW.Message;