Task: Rosetta Code_Rank languages by popularity


C++: #include <string>
#include <boost/regex.hpp>
#include <boost/asio.hpp>
#include <vector>
#include <utility>
#include <iostream>
#include <sstream>
#include <cstdlib>
#include <algorithm>
#include <iomanip>

struct Sort { 
   bool operator( ) ( const std::pair<std::string,int> & a , const std::pair<std::string,int> & b ) 
      const {
	 return a.second > b.second ;
      }
} ;

int main( ) {
   try {
      
      boost::asio::io_service io_service ; 
      boost::asio::ip::tcp::resolver resolver ( io_service ) ;
      boost::asio::ip::tcp::resolver::query query ( "rosettacode.org" , "http" ) ;
      boost::asio::ip::tcp::resolver::iterator endpoint_iterator = resolver.resolve( query ) ;
      boost::asio::ip::tcp::resolver::iterator end ;
      boost::asio::ip::tcp::socket socket( io_service ) ;
      boost::system::error_code error = boost::asio::error::host_not_found ;
      
      while ( error && endpoint_iterator != end ) {
	 socket.close( ) ;
	 socket.connect( *endpoint_iterator++ , error ) ;
      }
      if ( error ) 
	 throw boost::system::system_error ( error ) ;
      
      boost::asio::streambuf request ;
      std::ostream request_stream( &request ) ;
      request_stream << "GET " << "/mw/index.php?title=Special:Categories&limit=5000" << " HTTP/1.0\r\n" ;
      request_stream << "Host: " << "rosettacode.org" << "\r\n" ;
      request_stream << "Accept: */*\r\n" ;
      request_stream << "Connection: close\r\n\r\n" ;
      
      boost::asio::write( socket , request ) ;
      
      boost::asio::streambuf response ;
      std::istream response_stream ( &response ) ;
      boost::asio::read_until( socket , response , "\r\n\r\n" ) ;
      boost::regex e( "<li><a href=\"[^<>]+?\">([a-zA-Z\\+#1-9]+?)</a>\\s?\\((\\d+) members\\)</li>" ) ;
      
      std::ostringstream line ;
      std::vector<std::pair<std::string , int> > languages ; 
      boost::smatch matches ;
      while ( boost::asio::read( socket , response , boost::asio::transfer_at_least( 1 ) , error ) ) {
	 line << &response ;
	 if ( boost::regex_search( line.str( ) , matches , e ) ) {
	    std::string lang( matches[2].first , matches[2].second ) ;
	    int zahl = atoi ( lang.c_str( ) ) ;
	    languages.push_back( std::make_pair( matches[ 1 ] , zahl ) ) ;
	 }
	 line.str( "") ;
      }
      if ( error != boost::asio::error::eof ) 
	 throw boost::system::system_error( error ) ;
      
      std::sort( languages.begin( ) , languages.end( ) , Sort( ) ) ;
      int n = 1 ;
      for ( std::vector<std::pair<std::string , int> >::const_iterator spi = languages.begin( ) ;
	    spi != languages.end( ) ; ++spi ) {
	 std::cout << std::setw( 3 ) << std::right << n << '.' << std::setw( 4 ) << std::right <<  
	 spi->second   << " - " << spi->first << '\n' ;
	 n++ ;
      }
   } catch ( std::exception &ex ) {
      std::cout << "Exception: " << ex.what( ) << '\n' ;
   }
   return 0 ;
}







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)