Task: Rosetta Code_Rank languages by popularity








VB:     
    
    
    


URL1 = "http://www.rosettacode.org/mw/api.php?format=json&action=query&generator=categorymembers&gcmtitle=Category:Programming%20Languages&gcmlimit=500&prop=categoryinfo&rawcontinue"
URL2 = "http://www.rosettacode.org/mw/api.php?format=json&action=query&generator=categorymembers&gcmtitle=Category:Programming%20Languages&gcmlimit=500&prop=categoryinfo&gcmcontinue="


Function ScrapeGoat(link)
    On Error Resume Next
    ScrapeGoat = ""
    Err.Clear
    Set objHttp = CreateObject("Msxml2.ServerXMLHTTP")
    objHttp.Open "GET", link, False
    objHttp.Send
    If objHttp.Status = 200 And Err = 0 Then ScrapeGoat = objHttp.ResponseText
    Set objHttp = Nothing
End Function


Set HTML = CreateObject("HtmlFile")
Set HTMLWindow = HTML.ParentWindow


    
    
    

On Error Resume Next

isComplete = 0    
cntLoop = 0       
Set outputData = CreateObject("Scripting.Dictionary")

Do
    
    If cntLoop = 0 Then strData = ScrapeGoat(URL1) Else strData = ScrapeGoat(URL2 & gcmCont)
    If Len(strData) = 0 Then
        Set HTML = Nothing
        WScript.StdErr.WriteLine "Processing of data stopped because API query failed."
        WScript.Quit(1)
    End If

    
    HTMLWindow.ExecScript "var json = " & strData, "JavaScript"
    Set ObjJS = HTMLWindow.json

    Err.Clear    
    batchCompl = ObjJS.BatchComplete
    If Err.Number = 438 Then
        
        gcmCont = ObjJS.[Query-Continue].CategoryMembers.gcmContinue
    Else
        isComplete = 1    
    End If

    
    HTMLWindow.ExecScript "var langs=new Array(); for(var lang in json.query.pages){langs.push(lang);}" & _
                          "var nums=langs.length;", "JavaScript"
    Set arrLangs = HTMLWindow.langs
    arrLength = HTMLWindow.nums

    For i = 0 to arrLength - 1
        BuffStr = "ObjJS.Query.Pages.[" & Eval("arrLangs.[" & i & "]") & "]"
        EachStr = Eval(BuffStr & ".title")

        Err.Clear
        CntLang =  Eval(BuffStr & ".CategoryInfo.Pages")
        If InStr(EachStr, "Category:") = 1 And Err.Number = 0 Then
            outputData.Add Replace(EachStr, "Category:", "", 1, 1), CntLang
        End If
    Next

    cntLoop = cntLoop + 1
Loop While isComplete = 0



arrRelease = Array()
ReDim arrRelease(UBound(outputData.Keys), 1)

outKeys = outputData.Keys
outItem = outputData.Items
For i = 0 To UBound(outKeys)
    arrRelease(i, 0) = outKeys(i)
    arrRelease(i, 1) = outItem(i)
Next


For i = 0 to UBound(arrRelease, 1)
    For j = 0 to UBound(arrRelease, 1) - 1
        If arrRelease(j, 1) < arrRelease(j + 1, 1) Then
            temp1 = arrRelease(j + 1, 0)
            temp2 = arrRelease(j + 1, 1)
            arrRelease(j + 1, 0) = arrRelease(j, 0)
            arrRelease(j + 1, 1) = arrRelease(j, 1)
            arrRelease(j, 0) = temp1
            arrRelease(j, 1) = temp2
        End If
    Next
Next


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set txtOut = objFSO.CreateTextFile(".\OutVBRC.txt", True, True)

txtOut.WriteLine "As of " & Now & ", RC has " & UBound(arrRelease) + 1 & " languages."
txtOut.WriteLine ""
For i = 0 to UBound(arrRelease)
    txtOut.WriteLine arrRelease(i, 1) & " Examples - " & arrRelease(i, 0)
Next


Set HTML = Nothing
Set objFSO = Nothing
WScript.Quit(0)




Ada: with Ada.Integer_Text_IO;   use Ada.Integer_Text_IO;
with Ada.Strings.Fixed;     use Ada.Strings.Fixed;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO;           use Ada.Text_IO;

with Ada.Containers.Ordered_Sets;
with Ada.Strings.Less_Case_Insensitive;

with AWS.Client;
with AWS.Response;

procedure Test is

   use Ada.Strings;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   type A_Language_Count is
      record
         Count    : Integer := 0;
         Language : Unbounded_String;
      end record;

   function "=" (L, R : A_Language_Count) return Boolean is
   begin
      return L.Language = R.Language;
   end "=";

   function "<" (L, R : A_Language_Count) return Boolean is
   begin
      
      return L.Count < R.Count
        or else (L.Count = R.Count
                 and then Less_Case_Insensitive (Left  => To_String (L.Language),
                                                 Right => To_String (R.Language)));
   end "<";

   package Sets is new Ada.Containers.Ordered_Sets (A_Language_Count);
   use Sets;

   Counts : Set;

   procedure Find_Counts (S : String) is
      Title_Str : constant String  := "title=""Category:";
      End_A_Str : constant String  := "</a> (";

      Title_At   : constant Natural := Index (S, Title_Str);
   begin
      if Title_At /= 0 then
         declare
            Bracket_At : constant Natural := Index (S (Title_At   + Title_Str'Length .. S'Last), ">");
            End_A_At   : constant Natural := Index (S (Bracket_At + 1                .. S'Last), End_A_Str);
            Space_At   : constant Natural := Index (S (End_A_At   + End_A_Str'Length .. S'Last), " ");
            Count      : constant Natural := Natural'Value (S (End_A_At + End_A_Str'Length .. Space_At - 1));
            Language   : constant String  :=                S (Title_At + Title_Str'Length .. Bracket_At - 2);
         begin
            if Bracket_At /= 0 and then End_A_At /= 0 and then Space_At /= 0 then
               begin
                  Counts.Insert (New_Item => (Count, +Language));
               exception
                  when Constraint_Error =>
                     Put_Line (Standard_Error, "Warning: repeated language: " & Language);
                     
                     null;
               end;
            end if;
            
            Find_Counts (S (Space_At + 1 .. S'Last));
         end;
      end if;

   end Find_Counts;

   Place : Natural := 1;

   procedure Display (C : Cursor) is
   begin
      Put (Place, Width => 1);             Put (". ");
      Put (Element (C).Count, Width => 1); Put (" - ");
      Put_Line (To_String (Element (C).Language));
      Place := Place + 1;
   end Display;
 
   Http_Source : constant AWS.Response.Data :=
     AWS.Client.Get ("http://rosettacode.org/mw/index.php?title=Special:Categories&limit=5000");
begin
   Find_Counts (AWS.Response.Message_Body (Http_Source));
   Counts.Reverse_Iterate (Display'Access);
end Test;