File : adagio-searches-hit_family.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.                                --

------------------------------------------------------------------------------

--  $Id: adagio-upload.ads,v 1.4 2004/01/21 21:05:51 Jano Exp $


--  Root package for all search packages


with Adagio.Convert;
with Adagio.G2.Hit;
with Adagio.Misc;
with Adagio.Trace;

with Agpl.Counter.Multi;
with Agpl.Sequence;
with Agpl.Strings;

with Aws.Url;

with Ada.Tags; use Ada.Tags;
with Ada.Unchecked_Deallocation;

package body Adagio.Searches.Hit_Family is

   package Id_Sequence is new Agpl.Sequence (Family_Id);
   Ids : Id_Sequence.Object;

   ------------------------------------------------------------------------

   -- Add_Hit                                                            --

   ------------------------------------------------------------------------

   -- Adds a hit. It must be compatible

   procedure Add_Hit (This : in out Object; H : in Hit.Object'Class) is
      New_Hit : Hit.Object_Access := new Hit.Object'Class'(H);
      Success : Boolean;
      J       : Hit_Map.Iterator_Type;
   begin
      -- Merge hits just in case

      Hash_Dictionary.Merge (This.Hashes, Hit.Get_Hashes (H));
      -- Add the hit

      Hit_Map.Insert (This.Hits, Hit.Get_Id (H), New_Hit, J, Success);
      if not Success then
         Hit.Free (New_Hit);
         Trace.Log ("FAILED HIT ADDITION: " & Hit.Get_Id (H), Trace.Always);
      end if;
   exception
      when E : others =>
         Trace.Log ("Hit_Family.Add_Hit: " & Trace.Report (E), Trace.Error);
         Hit.Free (New_Hit);
   end Add_Hit;

   ------------------------------------------------------------------------

   -- Contains                                                           --

   ------------------------------------------------------------------------

   function Contains (This : in Object; H : in Hit.Object'Class) return Boolean is
      use Hit_Map;
   begin
      return Is_In (Hit.Get_Id (H), This.Hits);
   end;

   ------------------------------------------------------------------------

   -- Create                                                             --

   ------------------------------------------------------------------------

   -- A seed hit is needed

   procedure Create (This : out object; From : in Hit.Object'Class) is
      New_Hit : Hit.Object_Access := new Hit.Object'Class'(From);
   begin
      Ids.Get_Next (This.Id);
      This.Name   := U (Hit.Get_Name (From));
      This.Size   := Hit.Get_Size (From);
      This.Hashes := Hit.Get_Hashes (From);
      Hit_Map.Insert (This.Hits, Hit.Get_Id (From), New_Hit);
   exception
      when E : others =>
         Trace.Log ("Hit_Family.Create: " & Trace.Report (E), Trace.Error);
         Hit.Free (New_Hit);
   end Create;

   ------------------------------------------------------------------------

   -- Equal                                                              --

   ------------------------------------------------------------------------

   function Equal (L, R : in Object) return Boolean is
   begin
      return L.Id = R.Id;
   end Equal;

   ------------------------------------------------------------------------

   -- Free                                                               --

   ------------------------------------------------------------------------

   procedure Free (This : in out Object_Access) is
      procedure Del is new Unchecked_Deallocation (Object, Object_Access);
   begin
      Del (This);
   end Free;

   ------------------------------------------------------------------------

   -- Finalize                                                           --

   ------------------------------------------------------------------------

   procedure Finalize (This : in out Object) is
      use Hit_Map;
      I : Iterator_Type := First (This.Hits);
   begin
      while I /= Back (This.Hits) loop
         Hit.Free (Element (I));
         I := Succ (I);
      end loop;
   end Finalize;

   ------------------------------------------------------------------------

   -- Get_Id                                                             --

   ------------------------------------------------------------------------

   -- Get an unique id for the family (meaningless, for indexing)

   function Get_Id (This : in Object) return String is
   begin
      return Agpl.Strings.Trim (This.Id'Img);
   end Get_Id;

   ------------------------------------------------------------------------

   -- Get_Link                                                           --

   ------------------------------------------------------------------------

   -- Will provide a link for the hit

   -- Will try to get a Sha1 magnet and if not, a ed2k link

   -- May raise No_Such_Hash if none of the two available

   function Get_Link (This : in Object) return String is
   begin
      return Get_Magnet (This);
   end Get_Link;

   ------------------------------------------------------------------------

   -- Get_Magnet                                                         --

   ------------------------------------------------------------------------

   -- Will try to get a magnet link for sha1 hashes

   -- Raise No_Such_Hash if unable to obtain it

   function Get_Magnet (This : in Object) return String is
      use Hash_Dictionary;
      Hashes : Pair_Array := Get_Contents (This.Hashes);
   begin
      for I in Hashes'Range loop
         if S (Hashes (I).Key) = "sha1" then
            return 
               "magnet:?xt=urn:sha1:" &
               S (Hashes (I).Value) &
               "&dn=" & Aws.Url.Encode (S (This.Name));
         end if;
      end loop;
      raise No_Such_Hash;
   end Get_Magnet;

   ------------------------------------------------------------------------

   -- Has_New_Hits                                                       --

   ------------------------------------------------------------------------

   function Has_New_Hits (This : in Object) return Boolean is
      use Hit_Map;
      I : Iterator_Type := First (This.Hits);
   begin
      while I /= Back (This.Hits) loop
         if Hit.Is_New (Element (I).all) then
            return true;
         end if;
         I := Succ (I);
      end loop;
      return false;
   end Has_New_Hits;

   ------------------------------------------------------------------------

   -- Is_Compatible                                                      --

   ------------------------------------------------------------------------

   -- Says if a hit is compatible with this family

   function Is_Compatible (This : in Object; H : in Hit.Object'Class) return Boolean is
   begin
      return Hash_Dictionary.Are_Compatible (
         This.Hashes,
         Hit.Get_Hashes (H));
   end Is_Compatible;

   ------------------------------------------------------------------------

   -- Num_Firewalled_Hits                                                --

   ------------------------------------------------------------------------

   function Num_Firewalled_Hits (This : in Object) return Natural is
      use Hit_Map;
      I   : Iterator_Type := First (This.Hits);
      Num : Natural       := 0;
   begin
      while I /= Back (This.Hits) loop
         if Hit.Is_Firewalled (Element (I).all) then
            Num := Num + 1;
         end if;
         I := Succ (I);
      end loop;
      return Num;
   end Num_Firewalled_Hits;

   ------------------------------------------------------------------------

   -- Num_Hits                                                           --

   ------------------------------------------------------------------------

   function Num_Hits (This : in Object) return Natural is
   begin
      return Hit_Map.Length (This.Hits);
   end Num_Hits;

   ------------------------------------------------------------------------

   -- Num_New_Hits                                                       --

   ------------------------------------------------------------------------

   function Num_New_Hits (This : in Object) return Natural is
      use Hit_Map;
      I   : Iterator_Type := First (This.Hits);
      Num : Natural       := 0;
   begin
      while I /= Back (This.Hits) loop
         if Hit.Is_New (Element (I).all) then
            Num := Num + 1;
         end if;
         I := Succ (I);
      end loop;
      return Num;
   end Num_New_Hits;

   ------------------------------------------------------------------------

   -- Set_Expanded                                                       --

   ------------------------------------------------------------------------

   procedure Set_Expanded (This : in out Object; Expanded : in Boolean := true) is
   begin
      This.Expanded := Expanded;
   end Set_Expanded;

   ------------------------------------------------------------------------

   -- Http_Report                                                        --

   ------------------------------------------------------------------------

   procedure Http_Report (This : in out Object; Data : in out Data_Set) is
      use Hit_Map;
      I      : Iterator_Type   := First (This.Hits);
      NHits  : Natural := Length (This.Hits);
      Extra  : Ustring;
      use ASU;
   begin
      if NHits = 1 then
         Extra := U (Hit.Get_Extra (Element (First (This.Hits)).all));
      end if;
      -- Get common name, size, extras:

      declare
         Names, Sizes : Agpl.Counter.Multi.Object;
         I            : Iterator_Type := First (This.Hits);
         package MCounter renames Agpl.Counter.Multi;
         Aux_Hit      : G2.Hit.Object;
         Inited       : Boolean := false;
      begin
         while I /= Back (This.Hits) loop
            -- Merge extra info

            if Element (I).all'Tag = G2.Hit.Object'Tag then
               if Inited then
                  G2.Hit.Merge (Aux_Hit, G2.Hit.Object (Element (I).all));
               else
                  Aux_Hit := G2.Hit.Object (Element (I).all);
                  Inited  := true;
               end if;
            end if;

            -- Name & Size

            MCounter.Add (Names, Hit.Get_Name (Element (I).all));
            MCounter.Add (Sizes, File_Size'Image (Hit.Get_Size (Element (I).all)));
            I := Succ (I);
         end loop;
         This.Name := U (MCounter.Max_Key (Names));
         This.Size := File_Size'Value (MCounter.Max_Key (Sizes));
         if Extra = Null_Ustring and then Inited then
            Extra := U (G2.Hit.Get_Extra (Aux_Hit));
         end if;
      end;
      -- Firstly, the family header

      declare
         Row : Data_Row;
         Prefix : constant String := S (Rpad (Natural (This.Id))) & "1";
      begin
         -- Hits

         Append (Row, (
            U (Misc.To_String (Num_Hits (This))),
            U (S (Rpad (Num_Hits (This))) & Prefix)));
         -- New hits

         Append (Row, (
            U (Misc.To_String (Num_New_Hits (This))),
            U (S (Rpad (Num_New_Hits (This))) & Prefix)));
         -- Fwd hits

         Append (Row, (
            U (Misc.To_String (Num_Firewalled_Hits (This))),
            U (S (Rpad (Num_Firewalled_Hits (This))) & Prefix)));
         -- Name

         Append (Row, (
            This.Name,
            U (S (This.Name) & Prefix)));
         -- Size

         Append (Row, (
            U (Convert.To_Size (This.Size)),
            U (S (Rpad (This.Size)) & Prefix)));
         -- Extra

         Append (Row, (Extra, Extra & U (Prefix)));
         -- Hit?

         Append (Row, (
            U (Boolean'Image (false)), 
            U (Boolean'Image (false) & Prefix)));
         -- Expanded?

         Append (Row, (
            U (Boolean'Image (This.Expanded)), 
            U (Boolean'Image (This.Expanded) & Prefix)));
         -- Id

         Append (Row, (
            U (Misc.To_String (Natural (This.Id))), 
            U (Misc.To_String (Natural (This.Id)) & Prefix)));
         -- Magnet

         Append (Row, (
            U (Get_Link (This)),
            U (Get_Link (This) & Prefix)));

         Append (Data, Row);
      end;
      -- Hits

      declare
         Prefix : constant String  := S (Rpad (Natural (This.Id))) & "0";
         Nums   : array (Boolean) of Natural := (false => 0, true => 1);
      begin
         while I /= Back (This.Hits) loop
            declare
               Row    : Data_Row;
               H      : Hit.Object'Class renames Element (I).all;
            begin
               if This.Expanded then
                  -- Hits

                  Append (Row, (
                     Null_Ustring,
                     U (S (Rpad (Num_Hits (This))) & Prefix)));
                  -- New hits

                  Append (Row, (
                     U (Misc.To_String (Nums (Hit.Is_New (H)))),
                     U (S (Rpad (Num_New_Hits (This))) & 
                        Prefix & S (Rpad (Nums (Hit.Is_New (H)), 2)))));
                  -- Fwd hits

                  Append (Row, (
                     U (Misc.To_String (Nums (Hit.Is_Firewalled (H)))),
                     U (S (Rpad (Num_Firewalled_Hits (This))) & 
                        Prefix & S (Rpad (Nums (Hit.Is_Firewalled (H)), 2)))));
                  -- Name

                  Append (Row, (
                     U (Hit.Get_Name (H)),
                     U (S (This.Name) & Prefix & Hit.Get_Name (H))));
                  -- Size

                  Append (Row, (
                     U (Convert.To_Size (Hit.Get_Size (H))),
                     U (S (Rpad (This.Size)) & Prefix & S (Rpad (Hit.Get_Size (H))))));
                  -- Extra

                  Append (Row, (
                     U (Hit.Get_Extra (H)),
                     Extra & Prefix & Hit.Get_Extra (H)));
                  -- Hit?

                  Append (Row, (
                     U (Boolean'Image (true)), 
                     U (Boolean'Image (false) & Prefix & Boolean'Image (true))));
                  -- Expanded?

                  Append (Row, (
                     U (Boolean'Image (This.Expanded)), 
                     U (Boolean'Image (This.Expanded) & Prefix & 
                        Boolean'Image (This.Expanded))));
                  -- Id

                  Append (Row, (
                     U (Misc.To_String (Natural (This.Id))), 
                     U (Misc.To_String (Natural (This.Id)) & Prefix)));
                  -- Magnet

                  Append (Row, (
                     U (Get_Link (This)),
                     U (Get_Link (This) & Prefix)));

                  Append (Data, Row);
               end if;
               Hit.Set_New (H, false);
            end;
            I := Succ (I);
         end loop;
      end;
   end Http_Report;

end Adagio.Searches.Hit_Family;