----------------------------------------------------------------------------- -- -- libwww-ada95 : A World Wide Web client library for Ada95 -- -- O N I O N S . I N S T R E A M S . H T M L _ D I R -- -- 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 Roy T. Fielding and Yuzo Kanomata ----------------------------------------------------------------------------- -- -- The HTML Directory Stream is an input stream filter that takes a -- stream of filenames (assumed to be generated by Onions.Instreams.Dir), -- gets the file info for each one via Onions.OS.Stat, and outputs an -- HTML formatted listing similar to that seen on a modern browser. -- with Ada.Streams; use Ada.Streams; with Interfaces.C.Strings; with Onions.Buckets; use Onions.Buckets; with Onions.OS; with Unchecked_Conversion; with Unchecked_Deallocation; package body Onions.Instreams.HTML_Dir is use Bucket_Queues; --------------------------------------------- -- Dispatching Stream Control Operations -- --------------------------------------------- procedure Dispose is new Unchecked_Deallocation (HTML_Dir_Stream, HTML_Dir_Stream_Ptr); -- Free the storage associated with a stream object. -- procedure Free (SP : in out HTML_Dir_Stream_Ptr) is ItemList : Bucket_List; begin if SP /= null then if Length (SP.Unprocessed) > 0 then Dequeue (SP.Unprocessed, ItemList); Free (ItemList); end if; if Length (SP.Processed) > 0 then Dequeue (SP.Processed, ItemList); Free (ItemList); end if; Dispose (SP); end if; end Free; -- Close a stream object and propagate the close upstream. -- procedure Close (Stream : in out HTML_Dir_Stream) is begin Close (Stream.Outbound); end Close; -- Abort_Stream should only be used if a stream is interrupted -- by the user, or an error occurs that makes the whole stream bad. -- It forces the stream closed without a flush. -- procedure Abort_Stream (Stream : in out HTML_Dir_Stream) is ItemList : Bucket_List; begin if Length (Stream.Unprocessed) > 0 then Dequeue (Stream.Unprocessed, ItemList); Free (ItemList); end if; if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); Free (ItemList); end if; Abort_Stream (Stream.Outbound); end Abort_Stream; -- Reset is like Close, but resets the stream to the state -- it would be in if it was just created. It discards -- anything in its own buffers. -- procedure Reset (Stream : in out HTML_Dir_Stream) is ItemList : Bucket_List; begin if Length (Stream.Unprocessed) > 0 then Dequeue (Stream.Unprocessed, ItemList); Free (ItemList); end if; if Length (Stream.Processed) > 0 then Dequeue (Stream.Processed, ItemList); Free (ItemList); end if; Stream.Byte_Count := 0; Stream.Timeout := 0; Stream.System_Error := 0; Stream.Total_Files := 0; Stream.Total_Bytes := 0; Stream.Done_Trailer := False; if Stream.Outbound /= null then Reset (Stream.Outbound); end if; end Reset; -- Drain the stream by reading once from outbound and processing any -- unprocessed data as if it were the end-of-stream. -- procedure Drain (Stream : in out HTML_Dir_Stream; ItemList : out Bucket_List) is begin if Stream.Outbound /= null then Drain (Stream.Outbound, ItemList); Enqueue (Stream.Unprocessed, ItemList); end if; Process (Stream, True); Dequeue (Stream.Processed, ItemList); end Drain; ------------------------------------ -- Ada.Streams Dispatching Read -- ------------------------------------ -- Read obtains stream elements from Stream and places them into -- the components of Item until each component is filled or -- no elements remain on the stream or a complete line has been read. -- Last is set to the index of the last filled component of Item. -- This interface is defined by Ada.Streams for abstract stream -- operations. We won't use it much because it forces a full data copy -- when filtering. -- procedure Read (Stream : in out HTML_Dir_Stream; Item : out Stream_Element_Array; Last : out Stream_Element_Offset) is ReadList : Bucket_List; begin Last := Item'First - 1; while Length (Stream.Processed) = 0 loop Process (Stream, False); end loop; Dequeue (Stream.Processed, ReadList); Dump_Into (ReadList, Item, Last); if not IsEmpty (ReadList) then Undequeue (Stream.Processed, ReadList); end if; exception when End_Error => if Last < Item'First then raise End_Error; end if; end Read; ---------------------------------- -- Data Processing Operations -- ---------------------------------- use Onions.OS; use type C.int; -- Process does the magic necessary to read from the upstream object -- and move the data from the Unprocessed read queue to the Processed -- read queue. In this case, it takes each filename read from the -- outbound stream object and wraps it in HTML table stuff. -- If Everything, then process the entire Unprocessed buffer as if -- it were the end-of-stream. Raises End_Error if end-of-stream -- is encountered and we have already produced the HTML trailer, -- or Status_Error if the outbound stream is not connected. -- procedure Process (Stream : in out HTML_Dir_Stream; Everything : Boolean) is ItemList : Bucket_List; Bucko : Bucket; EOS : Boolean := Everything; Fname : C.Strings.chars_ptr; Stat_Buf : Stat_Access; Title_Pre : constant String := "" & New_Line & "Index of "; Title_Post : constant String := "" & New_Line & "" & New_Line; Head_Pre : constant String := "

Index of "; Head_Post : constant String := "

" & New_Line & "" & New_Line; Anchor : constant String := "" & New_Line; Size_Pre : constant String := "" & New_Line; Sum_Pre : constant String := "" & New_Line; Tot_Pre : constant String := "" & New_Line; Trailer : constant String := "
"; Name_Post : constant String := ""; Size_Post : constant String := "
Totals: "; Sum_Post : constant String := " Files"; Tot_Post : constant String := "
" & New_Line; begin if Stream.Done_Trailer then raise End_Error; end if; if not EOS then if Stream.Outbound /= null then begin Read (Stream.Outbound, ItemList); Enqueue (Stream.Unprocessed, ItemList); exception when End_Error => EOS := True; end; else raise Status_Error; end if; end if; if Stream.Total_Files = 0 then -- Do HTML header and start table -- Enqueue (Stream.Processed, New_Bucket (Title_Pre & Name (Stream.Outbound) & Title_Post & Head_Pre & Name (Stream.Outbound) & Head_Post)); end if; Stat_Buf := new Stat_Record; while Length (Stream.Unprocessed) > 0 loop Dequeue (Stream.Unprocessed, Bucko); Stream.Total_Files := Stream.Total_Files + 1; -- Do a stat on Bucko to get the file size. -- Fname := To_Ada (Bucko); if Stat (Fname, Stat_Buf) = 0 then Stream.Total_Bytes := Stream.Total_Bytes + Natural (Stat_Buf.file_size); else Stat_Buf.file_size := 0; end if; -- Build table entry around filename -- Enqueue (Stream.Processed, New_Bucket (Anchor & To_Ada (Bucko) & Name_Pre)); Enqueue (Stream.Processed, Bucko); Enqueue (Stream.Processed, New_Bucket (Name_Post & Size_Pre & C.long'Image (Stat_Buf.file_size) & Size_Post)); C.Strings.Free (Fname); end loop; if EOS then -- Do table summary and HTML trailer -- Enqueue (Stream.Processed, New_Bucket (Sum_Pre & Natural'Image (Stream.Total_Files) & Sum_Post & Tot_Pre & Natural'Image (Stream.Total_Bytes) & Tot_Post & Trailer)); Stream.Done_Trailer := True; end if; end Process; -- Unprocess undoes the magic of Process and UnReads the data to -- the upstream object. -- procedure Unprocess (Stream : in out HTML_Dir_Stream) is ItemList : Bucket_List; Bucko : Bucket; begin while Length (Stream.Processed) > 0 loop Dequeue (Stream.Processed, Bucko); -- -- We can unfilter what we have processed simply by throwing out -- any blocks that do not start with '<', since we were careful -- to construct all but the filenames that way in Process. -- if Val (Address_Of (Bucko)) = '<' then Free (Bucko); else Enqueue (Stream.Unprocessed, Bucko); end if; end loop; if Length (Stream.Unprocessed) > 0 then Dequeue (Stream.Unprocessed, ItemList); if Stream.Outbound /= null then UnRead (Stream.Outbound, ItemList); else Free (ItemList); end if; end if; end Unprocess; end Onions.Instreams.HTML_Dir;