Barrapunto

Aprovechando que me manejo bastante bien con Perl, que me gusta Barrapunto y que a mí también me gustaría que su RSS estuviera completo, he programado un pequeño script que genera un RSS a partir de un archivo HTML con la página principal de /., que se suma a algún otro otros filtro ya existente. ¡Quizá también les sirva a los administradores de Barrapunto para ofrecernos una sindicación de contenidos decente!

Aquí os presento a mi bp2xml.pl:
#!/usr/bin/perl
use strict;
use warnings;
# transforma la pagina principal de Barrapunto en un XML util para sindicarlo:
my $html;
{ local $/; $html = <>; }
my $xml = '';
$xml .= qq(<?xml version="1.0" encoding="ISO-8859-1"?>\n) .
        qq(<rss version="2.0">\n) .
        "<channel>\n";
$xml .= "<title>Barrapunto" . "</title>\n" .
        "<link>http://barrapunto.com/" . "</link>\n" .
        "<description>La informaci&#243;n que te interesa</description>\n";
$xml .= "<image>\n" .
        "<title>Barrapunto</title>\n" .
        "<url>http://barrapunto.com/" .
                "topics/topicbarrapunto.png" . "</url>\n" .
        "<link>http://barrapunto.com/" . "</link>\n" .
        "</image>\n";
my ($title, $desc, $description, $link);
while ($html =~ m/<FONT FACE="[^"]*" SIZE="3" COLOR="#FF6600"><B>/) {
        substr($html, 0, $+[0], ''); # borra hasta el final
        $xml .= "<item>\n";
        if ($html =~ m/<\/B>/) {
                $title = substr($html, 0, $-[0]); # recoge hasta el principio
                substr($html, 0, $+[0], '');
                $title =~ s/<[^>]*>//g;
                $xml .= "<title>$title</title>\n";
        }
        $description = '';
        if ($html =~ m/<FONT FACE="[^>]*" SIZE="1">/) {
                substr($html, 0, $+[0], '');
                if ($html =~ m/\s*<\/FONT>/) {
                        $desc = substr($html, 0, $-[0]);
                        $desc =~ s/&/\&amp;/g;
                        $desc =~ s/</\&lt;/g;
                        $desc =~ s/>/\&gt;/g;
                        $desc =~ s/"/\&quot;/g;
                        $description .= "$desc&lt;br/&gt;\n";
                }
        }
        if ($html =~ m/<FONT FACE="[^>]*" SIZE="1">/) {
                substr($html, 0, $+[0], '');
                if ($html =~ m/\s*<\/FONT>/) {
                        $desc = substr($html, 0, $-[0]);
                        $desc =~ s/<[^>]*>//g;
                        $description .= "$desc&lt;br/&gt;\n";
                }
        }
        if ($html =~ m/<\/TD><\/TR>/) {
                $desc = substr($html, 0, $-[0]); # recoge hasta el principio
                substr($html, 0, $+[0], '');
                if ($desc =~ m/<A [^>]*>\s*<IMG [^>]*><\/A>\s*/) {
                        substr($desc, 0, $+[0], '');
                }
                $desc =~ s/\r//g;
                $desc =~ s/&/\&amp;/g;
                $desc =~ s/</\&lt;/g;
                $desc =~ s/>/\&gt;/g;
                $desc =~ s/"/\&quot;/g;
                $desc =~ s/\s*$//;
                $description .= "$desc\n";
        }
        if ($description ne '') {
                $xml .= "<description>$description" . "</description>\n";
        }
        if ($html =~ m/<FONT FACE="[^"]*" SIZE="2"><B>\[<\/B>/) {
                substr($html, 0, $+[0], '');
                if ($html =~ m/<A HREF="([^"]*)"/) {
                        $link = $1;
                        $xml .= "<link>http:$link</link>\n";
                }
        }
        $xml .= "</item>\n";
}
$xml .= "</channel>\n" .
        "</rss>\n";
print $xml;


Espero comentarios, opiniones, mejoras, lo que queráis, serán bienvenidos. Un saludo.