Limpiando “Ad-Free Blogs”

Ad-Free Blogs es una iniciativa para crear una lista de weblogs libres de publicidad comercial de empresas. Microsiervos en su wiki creó la iniciativa en español de este movimiento. Un blog que quiera unirse, solo debe poner la imagen del buho y añadirse al wiki él mismo, y de ese modo incluso se tiene un enlace para navegar al azar por estos blogs (libres de publicidad).
 
Hasta aquí no estoy contanto nada nuevo. Hoy, aunque debería de haber estado estudiando, me he quedado en casa (solo “sé” estudiar en la biblio :P) y cuando por la tarde estaba con mi bocata y mi coke todo feliz vagueando y tal, le he dado al link de blog al azar (el del buho) y de diez veces que le he dado, solo uno de los diez blogs era en verdad libre de publicidad (y que contuviese la imagen del buho). Como esto me ha molestado bastante, me he puesto a hacer un script simple que pilla el contenido de la página del wiki de microsiervos (hay que descargarlo y ponerlo en un txt) y va buscando en qué blogs tienen la imagen del buho y en cuales no. El script es simple y se puede mejorar por todos lados, lo acabo de hacer :P, pero los resultado creo que son buenos, aunque quiero comprobar más a fondo las direcciones que salen como malas antes de editar el wiki de Microsiervos. Concretamente los resultados que obtengo son:

En total de 393 blogs. Hay 143 MALOS y 213 BUENOS

Eso hace un 36,4% de blogs malos y 9,4% erroneos (URL incorrecta)! Una cifra bastante considerable. El script es este:

#!/usr/bin/perl -w
################################################################################
# adFreeClean v0.1 (menos da una piedra | A stone give you less) lol           #
#                                                                              #
# Author: Blaxter (blaxter at gmail dot com)                                   #
# Date: 03/sept/2006                                                           #
# Requiere:                                                                    # 
#     apt-get install libterm-progressbar-perl                                 #
# Description:                                                                 #
#     Mayormente pilla el archivo que se le indique, esperando que sea con el  #
# formato wiki de http://wiki.microsiervos.com/Ad-Free_Blogs, y para cada url  #
# de blog que encuentra, lo descarga y mira si tiene enlace a la página del    #
# wiki o a la página adfreeblog.org                                            #
#                                                                              #
################################################################################
#                                                                              #
#                                GNU GPL license                               #
#                                                                              #
################################################################################
require LWP::UserAgent;
use Term::ProgressBar;
$| = 1;
################################################################################
my $FICHERO = 'content.txt'; # You should modify this
my $FICHERO_OUT = 'out.txt'; # You should modify this
################################################################################
################################################################################
sub getURL
# Descarga una página
# @param $1 la URL a bajar
{
	my $ua = LWP::UserAgent->new;
	$ua->timeout(5);
	$ua->env_proxy;	
 
	my $response = $ua->get(shift);
 
	return $response->content if ($response->is_success);
	'';
}
###########################################
sub checkadfree
# comprueba si una página tiene referencia a adfree
# @param $1 Código Html de la página
{
	my $pagina = shift;
	@expresiones = (
		"adfreeblog\.org",
		"wiki\.microsiervos\.com\/Ad\-Free_Blogs"
	);
 
	foreach (@expresiones)
	{
		return 1 if ($pagina =~ /$_/);
	}
	return 0;
}
################################################################################
################################################################################
my @data; # donde se guardarán los blogs
my $total_n = 0; # numero total de blogs
# abrir fichero del wiki...
open IN, "<$FICHERO" or die "Andandara el fichero!";
# leemos todas las url's de paginas apuntadas
while(<IN>)
{
	if(/^\*[^\[]*\[[^\]]*\]$/io)
	{
		# guardamos url, web(no usada, pero para otras versiones...), y linea 
		# entera para sacarla en el fichero resultado si es blog bueno
		$data[$total_n]{'linea'} = 
		$data[$total_n]{'url'} = 
		$data[$total_n]{'web'} = 
		$_;
		$data[$total_n]{'url'} =~ s/^\*[^\[]*\[([^\] ]*)[^\]]*\]$/$1/io;
		$data[$total_n]{'web'} =~ s/^\*[^\[]*\[[^\] ]*\s([^\]]*)\]$/$1/io;		
		$total_n++;
	}
}
close IN; # done
# Creamos barra guays
my $next_update = 0;
my $n = 0;
my $progress = Term::ProgressBar->new(
	{
		name => 'AdFree',
		count => $total_n,
		ETA => 'linear'
	}
);
$progress->minor(0);          
$progress->max_update_rate(1);
 
# y ahora a comprobar cuales tienen add-free
foreach (@data)
{
	$next_update = $progress->update($n)if $n >= $next_update; # actuliza barra!
 
	$url = $_->{'url'}; # pilla url!	
	# bajamos la pagina
	$pagina = &getURL($url);
	if($pagina ne '')
	{
		$_->{'adfree'} = checkadfree($pagina);
	}
	else
	{
		$_->{'adfree'} = -1;
	}
	$n++; # para la barra!
}
# Completamos barra, pa por si aca...
$progress->update($total_n);
 
open OUT, ">$FICHERO_OUT";
open OUT_MALOS, ">$FICHERO_OUT.malos";
$malos = $buenos = $notfound = 0;
foreach (@data)
{
	if($_->{'adfree'} eq 0)
	{
		$malos++;
		print OUT_MALOS $_->{'url'};
	}
	elsif($_->{'adfree'} eq 1)
	{
		$buenos++;
		print OUT $_->{'linea'};
	}
	elsif($_->{'adfree'} eq -1)
	{
		$notfound++;
	}
}
close OUT;
close OUT_MALOS;
print "En total de $n blogs. Hay $malos MALOS y $buenos BUENOS\n";

Puedes descargarlo aquí, incluye el script (adfreeclean.pl), la página del wiki de microsiervos (content.txt) y los resultados despues de la ejecución (out.txt y out.txt.malos).

Actualización [4 sept @ 23.20]: El script falla para todas las webs que usan frames (es decir, todas con redirecciones…). Hay un modulo para perl que teoricamente lo resuelve, pero va dos veces, así que tendría que hacer la iteración y busqueda de los frames a pelo. Para otro día, que ahora no me apetece :P

7 Thoughts on “Limpiando “Ad-Free Blogs”

  1. Hay gente que por tener visitas hace cualquier cosa…

    La excusa de que sólo sé estudiar en la biblioteca me suena mucho… no mamá… no puedo estudiar en casa, ya sólo puede estudiar en la biblioteca… y claro… a vaguear se ha dicho :D

    Por cierto, ¿no puedes mandarle un email a la gente de microsiervos para que haga una limpieza de los blogs? un poco de escarmiento público no viene mal :D

  2. pos el mio bien pronto estará porque he cambiado el hosting :P

  3. Yo puse lo del buho el otro día en mi blog y me añadí a la lista, lo único que la imagen del buho la coloqué en mi servidor porque le cambié el color para que quedara mejor y el link de blogs libres en español es el mismo pero lo puse en spanish. ¿no afectará no?.

  4. perl me acaba de matar con expresiones tan faciles como “” s/^\*[^\[]*\[[^\] ]*\s([^\]]*)\]$/$1/io; “” o_O

    Miguel, no afectara porque el script busca patrones en los enlaces (o eso creo, porque mi no hablar perl) … asi que si apuntan al sitio bueno, no habra problema

  5. Miguel, no afecta no (es mas, lo correcto es hacer lo que has hecho, alojar la imagen en tu servidor y si es necesario se adapta). Si bajas el archivo con el script y los resultados, verás que tu blog si que aparece en la lista de blogs buenos.

    Luego por la noche revisaré la lista de los blogs “malos” y si todo va bien, a editar a saco paco el wiki con la lista de blogs

Post Navigation