И еще об интероперабельности

[vitus_wagner]

А вот маленькая парсилка foaf. Добывает юзерпик (а потом делает на него запрос, и определяет размеры и тип) jabber и icq.
Кому нужны aim и msn пусть сами по аналоги дописывают. Сделана на регекспах, без полноценного XML-парсера, потому что мне в моем движке полноценный XML парсер пока не нужен. И тащить зависимость от модуля, которого у хостера может не оказаться ,только ради foaf мне показалось излишним.

#!/usr/bin/perl
use LWP;
use Data::Dumper;
use Image::Size;
my %info;
if ($ARGV[0]=~/^http:/) {
    %info = get_foaf($ARGV[0]);
} else {
    open F, "<",$ARGV[0];
    $/=undef;
    my $foaf = <F>;
    close F;
   %info=foaf_parse($foaf);
}

print Data::Dumper->Dump([\%info],[qw(%info)]),"\n";

sub get_foaf {
    my $ua = LWP::UserAgent->new(agent => "Stilllife/1.0");
    my $response = $ua->get($ARGV[0]);
    die $response->status_line unless $response->is_success;
    $foaf = $response->content;
    my $url = shift;
    my %info = foaf_parse($foaf);
    if ($info{avatar}) {
        $response = $ua->get($info{avatar});
        if ($response->is_success) {
            my $image = $response->content;
            my ($w,$h,$type) = imgsize(\$image);
            $info{avatar}={width=>$w,height=>$h,type=>$type,src=>$info{avatar}};
        } else {
            print STDERR "Error getting $info{avatar}: ".      $response->status_line,"\n";
        }
    }
    return %info;
}
sub foaf_parse {
    my $foaf = shift;
    my ($starttag) = $foaf =~ /<(\w+(:\w+)?[^>]+)>/sg;
    my %ns = reverse ($starttag =~ /xmlns:(\w+)="([^"]+)"/sg);
    my $foaf_prefix = $ns{"http://xmlns.com/foaf/0.1/"};
    my $rdf_prefix = $ns{"http://www.w3.org/1999/02/22-rdf-syntax-ns#"};
    my ($userpic) = $foaf=~/<$foaf_prefix:img[^>]* $rdf_prefix:resource="([^"]+)"/s;
    my @info;
    push @info, avatar =>$userpic if $userpic;
    my ($icq) = $foaf =~/<$foaf_prefix:icqChatID>([^<]*)<\/$foaf_prefix:icqChatID>/s;
    push @info, icq => $icq if ($icq);
    my ($jabber) = $foaf =~/<$foaf_prefix:jabberID>([^<]*)<\/$foaf_prefix:jabberID>/s;
    push @info, jabber => $jabber if ($jabber);
    return @info;
}