lang-graph/

#!/usr/bin/perl

# parse-wiki.pl
# (c) Alexandr A Alexeev 2012 | http://remontka.com/

use strict ;
use warnings ;
use LWP :: UserAgent ;

main (
[ ‘Perl’ ] ,
{
Perl => { url => ‘http://en.wikipedia.org/wiki/Perl’ }
}
) ;

sub main {
my ( $queue , $lang_info ) = @_ ;
my %influenced_table ; # {Perl}{Python} = 1

while ( @ { $queue } ) {
my $lang = shift @ { $queue } ;
my $url = $lang_info -> { $lang } { url } ;

warn «Queue size: » . scalar ( @ { $queue } ) .
«, fetching $lang info, url: $url n » ;
my $data = getUrl ( $url ) ;

$lang_info -> { $lang } { year } = parseYear ( $data ) ;

my $influenced = parseInfluenced ( $data ) ;
for my $new_lang ( keys % { $influenced } ) {
$influenced_table { $lang } { $new_lang } = 1 ;
# in queue or allready parsed
next if defined $lang_info -> { $new_lang } ;
$lang_info -> { $new_lang } = {
url => $influenced -> { $new_lang }
} ;
push @ { $queue } , $new_lang ;
}

my $influencedBy = parseInfluencedBy ( $data ) ;
for my $new_lang ( keys % { $influencedBy } ) {
$influenced_table { $new_lang } { $lang } = 1 ;
# in queue or allready parsed
next if defined $lang_info -> { $new_lang } ;
$lang_info -> { $new_lang } = {
url => $influencedBy -> { $new_lang }
} ;
push @ { $queue } , $new_lang ;
}
}
warn «All done, writing result n » ;
dumpInfo ( $lang_info , %influenced_table ) ;
}

sub dumpInfo {
my ( $lang_info , $influenced ) = @_ ;
for my $lang ( keys % { $lang_info } ) {
my $inf_list = join ( «,» , keys % { $influenced -> { $lang } } ) ;
my $year = $lang_info -> { $lang } { year } ;
my $url = $lang_info -> { $lang } { url } ;
print «$year:$lang:$url:$inf_list n » ;
}
}

sub parseYear {
my ( $data ) = @_ ;
my ( $year ) = $data =~ m ! Appeared in </ th > [ ^< ] *< td [ ^> ] *> ( ?:< a [ ^> ] *> ) ? ( ( ?: 19 | 20 ) d { 2 } ) ! si ;
$year = «unknown» unless defined $year ;
return $year ;
}

sub parseInfluenced {
my ( $data ) = @_ ;
return parseLangList ( «Influenced» , $data ) ;
}

sub parseInfluencedBy {
my ( $data ) = @_ ;
return parseLangList ( «Influenced by» , $data ) ;
}

sub parseLangList {
my ( $key , $data ) = @_ ;
my %lang_table ;
my ( $inf_block ) = $data =~ m !< th [ ^> ] *> $key </ th > [ ^< ] *< td class = «» style = «» > ( .*? ) </ td >! si ;
if ( defined $inf_block ) {
while ( my ( $url , $lang , $rest ) = $inf_block =~ m ‘^<a href=»/([^»]+)»[^>]*>([^<]+)</a>(?:, )?(.*)$’ si ) {
$inf_block = $rest ;
next unless ( $url =~ m !^ wiki /! ) ;
$url = «http://en.wikipedia.org/$url» ;
warn »    $key $lang, url: $url n » ;
$lang_table { $lang } = $url ;
}
}
return %lang_table ;
}

sub getUrl {
my ( $url ) = @_ ;
my $lwp = LWP :: UserAgent -> new (
timeout => 30 ,
agent => ‘Opera/9.80 (X11; FreeBSD 8.2-RELEASE i386; U; ru) Presto/2.9.168 Version/11.52’ ,
) ;
my $res = $lwp -> get ( $url ) ;
unless ( $res -> is_success ) {
die «Failed to download $url (» . $res -> status_line . «)» ;
}
return $res -> as_string ;
}