File : adagio-upload-mesh.adb
------------------------------------------------------------------------------
-- ADAGIO - ADALID - AENEA. --
-- --
-- Copyright (C) 2003 --
-- A. Mosteo. --
-- --
-- Authors: A. Mosteo. (adagio@mosteo.com) --
-- --
-- If you have any questions in regard to this software, please address --
-- them to the above email. --
-- --
-- This program 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 program 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. --
-- --
-- You are not allowed to use any part of this code to develop a program --
-- whose output would be used to harass or prosecute other users of the --
-- networks Adagio connects with. All data collected with Adagio or a tool --
-- containing Adagio code about other network users must remain --
-- confidential and cannot be made public by any mean, nor be used to --
-- harass or legally prosecute these users. --
------------------------------------------------------------------------------
with Adagio.Chronos;
with Adagio.Convert;
with Adagio.Statistics;
with Adagio.Statistics.Integers;
with Adagio.Statistics.Strings;
with Adagio.Trace;
with Gnat.Os_lib;
use Gnat;
with Ada.Streams.Stream_io;
package body Adagio.Upload.Mesh is
------------------------------------------------------------------------
-- Object --
------------------------------------------------------------------------
-- A mesh with given Id (for example network).
protected body Object is
procedure Update_stats is
use Element_list;
begin
Statistics.Object.Set ("Uploads - " & Id.all & " mesh entries",
Statistics.Integers.Create (Length (Elements)));
Statistics.Object.Set ("Uploads - " & Id.all & " mesh memory",
Statistics.Strings.Create (
Convert.To_size (Length (Elements) *
(Element_type'Size / 8))));
end Update_stats;
------------------------------------------------------------------------
-- Configure --
------------------------------------------------------------------------
-- Set the number of alt-sources to keep for an item and
-- the time they will last.
procedure Configure (
Sources : in Positive := Default_cached_elements;
TTL : in Duration := 24.0 * 60.0 * 60.0) is
begin
Max_sources := Sources;
Time_to_live := TTL;
end Configure;
------------------------------------------------------------------------
-- Restore --
------------------------------------------------------------------------
-- Restore a mesh from hard disk or stream
procedure Restore (Path : in String) is
use Stream_io;
F : File_type;
C : Chronos.Object;
begin
if not Os_lib.Is_regular_file (Path) then
Trace.Log ("Upload.Mesh.Restore: File " & Path & " does not exist");
return;
end if;
Open (F, Name => Path, Mode => In_file);
Restore (Stream (F));
Close (F);
Trace.Log ("Mesh for " & Id.all & " restored (" &
Chronos.Image (C) & ").");
Update_stats;
exception
when E : others =>
if Is_open (F) then
Close (F);
end if;
Trace.Log ("Upload.Mesh.Restore: " & Trace.Report (E), Trace.Error);
end Restore;
procedure Restore (Stream : access Root_stream_type'Class) is
Num : Natural;
Slot : Slot_type;
use Element_list;
begin
-- Num of slots
Natural'Read (Stream, Num);
-- Slots
for N in 1 .. Num loop
Slot := Slot_type'Input (Stream);
Insert (Elements, Key (Slot.Element), Slot);
end loop;
end Restore;
------------------------------------------------------------------------
-- Save --
------------------------------------------------------------------------
-- Save to a file or stream
procedure Save (Path : in String) is
use Stream_io;
F : File_type;
C : Chronos.Object;
begin
Purge;
Trace.Log ("Mesh for " & Id.all & " purged (" &
Chronos.Image (C) & ").");
Chronos.Reset (C);
Create (F, Name => Path, Mode => Out_file);
Save (Stream (F));
Close (F);
Trace.Log ("Mesh for " & Id.all & " saved correctly (" &
Chronos.Image (C) & ").");
exception
when E : others =>
if Is_open (F) then
Close (F);
end if;
Trace.Log ("Upload.Mesh.Save: " & Trace.Report (E), Trace.Error);
end Save;
procedure Save (Stream : access Root_stream_type'Class) is
use Element_list;
I : Iterator_type := First (Elements);
begin
-- Num of slots
Natural'Write (Stream, Length (Elements));
-- Slots
while I /= Back (Elements) loop
Slot_type'Output (Stream, Element (I));
I := Succ (I);
end loop;
end Save;
------------------------------------------------------------------------
-- Add --
------------------------------------------------------------------------
-- Add an element to the mesh with a given age under a given key.
procedure Add (
Element : in Element_type;
Born : in Calendar.Time := Calendar.Clock) is
begin
if Contains_better (Element) then
return;
else
Remove (Key (Element), Location (Element));
end if;
Element_list.Insert (Elements, Key (Element),
(Element => Element, Born => Born));
Update_stats;
end Add;
------------------------------------------------------------------------
-- Remove --
------------------------------------------------------------------------
-- Removes any elements for the give Key/Location.
procedure Remove (Key : in String; Loc : in String) is
use Element_list;
From : Element_list.Iterator_type := Lower_bound (Elements, Key);
To : Element_list.Iterator_type := Upper_bound (Elements, Key);
I : Element_list.Iterator_type := From;
begin
while I /= To loop
if Location (Element (I).Element) = Loc then
Delete (Elements, I);
return;
else
I := Succ (I);
end if;
end loop;
end Remove;
------------------------------------------------------------------------
-- Get an array of objects (the N youngest) --
------------------------------------------------------------------------
-- We'll create a sorted list of the elements for the key and return
-- the first and best ones.
function Get (
Key : in String;
Amount : in Positive := Default_cached_elements) return Element_array
is
use Element_set;
use Element_list;
From : Element_list.Iterator_type := Lower_bound (Elements, Key);
To : Element_list.Iterator_type := Upper_bound (Elements, Key);
I : Element_list.Iterator_type := From;
R : Element_set.Container_type;
begin
while I /= To loop
Insert (R, Element (I).Element);
I := Succ (I);
end loop;
declare
I : Element_set.Iterator_type := First (R);
Result : Element_array (1 .. Amount);
Pos : Natural := 1;
begin
while I /= Back (R) and then Pos <= Result'Last loop
Result (Pos) := Element (I);
I := Succ (I);
Pos := Pos + 1;
end loop;
return Result (1 .. Pos - 1);
end;
end Get;
------------------------------------------------------------------------
-- Contains --
------------------------------------------------------------------------
-- Says if a Key/Location are already present:
function Contains (Key : in String; Loc : in String) return Boolean is
use Element_list;
From : Element_list.Iterator_type := Lower_bound (Elements, Key);
To : Element_list.Iterator_type := Upper_bound (Elements, Key);
I : Element_list.Iterator_type := From;
begin
while I /= To loop
if Location (Element (I).Element) = Loc then
return true;
end if;
I := Succ (I);
end loop;
return false;
end Contains;
------------------------------------------------------------------------
-- Contains_better --
------------------------------------------------------------------------
-- Says if a Key/Location are already present and are better:
function Contains_better (E : in Element_type) return Boolean is
use Element_list;
From : Element_list.Iterator_type :=
Lower_bound (Elements, Key (E));
To : Element_list.Iterator_type :=
Upper_bound (Elements, Key (E));
I : Element_list.Iterator_type := From;
begin
while I /= To loop
if Location (Element (I).Element) = Location (E) then
return Better (Element (I).Element, E);
end if;
I := Succ (I);
end loop;
return false;
end Contains_better;
------------------------------------------------------------------------
-- Count --
------------------------------------------------------------------------
-- Says the number of elements stored under a given key:
function Count (Key : in String) return Natural is
begin
return Element_list.Count (Elements, Key);
end Count;
------------------------------------------------------------------------
-- Purge --
------------------------------------------------------------------------
-- Deletes elements too old
procedure Purge is
use Calendar;
use Element_list;
I : Iterator_type := First (Elements);
begin
while I /= Back (Elements) loop
if Clock - Element (I).Born > Time_to_live then
Delete (Elements, I);
else
I := Succ (I);
end if;
end loop;
Update_stats;
end;
end Object;
end Adagio.Upload.Mesh;