Get userpic and jabber/icq from foaf

Fix multiple slashes in the generated URLs

diff --git a/forum/dumpbase b/forum/dumpbase
index 1652e6a985f9c5aa59d2c39dbfb05799dc581dcd..4d3902a4e62b51905aaf9ed9405836c852ade767 100644 (file)
--- a/forum/dumpbase
+++ b/forum/dumpbase
@@ -1,10 +1,17 @@
 #!/usr/bin/perl
-
+use strict;
 use Data::Dumper;
 use Storable qw(thaw);
-
+use Getopt::Std;
+use vars qw($opt_d);
+getopts("d:");
+my %x;
 dbmopen %x,$ARGV[0],0644;
 
+if ($opt_d) {
+       delete $x{$opt_d};
+}      
+
 while (my ($key,$val) = each %x) {
        my $data;
        eval {
@@ -17,3 +24,5 @@ while (my ($key,$val) = each %x) {
        }       
        print $data,"\n";
 }      
+
+dbmclose %x;

diff --git a/forum/forum b/forum/forum
index 3faec6039281b856667341360cf03c030470cc14..5d56642520e6ab0a7edccee849b7225d981c5bf7 100755 (executable)
--- a/forum/forum
+++ b/forum/forum
@@ -152,6 +152,7 @@ sub dir2url {
 
 sub get_forum_config {
        $path_translated = $1 if $ENV{PATH_TRANSLATED}=~/^(\S+)$/;
+       $path_translated=~s/\/+$//;
        my @path=split("/",$path_translated);
        while (@path>1) {
                if (-r (my $config=join("/",@path,".forum")) ) {
@@ -358,7 +359,10 @@ sub show_template {
 #
 sub fix_forum_links {
        my ($forum,$tree,$path_info) = @_;
-       $path_info=$ENV{'PATH_INFO'} if (!defined $path_info);
+       if (!defined $path_info) {
+               $path_info = $ENV{PATH_INFO};
+               $path_info =~ s/\/+/\//g;
+       }               
        my $script_with_path = $ENV{SCRIPT_NAME}.$path_info;
        ELEMENT:
        for my $element ($tree->find_by_tag_name("form","img","link","script","a")) {
@@ -438,8 +442,17 @@ if (defined $user) {
        substinfo($tree,["_tag"=>"a","class"=>"author"],
         href=>$userpage,_content=>$userinfo{"user"});
        delete $userinfo{"user"};
-       substinfo($tree,["_tag"=>"img","class"=>"avatar"],
-       src=>$userinfo{"avatar"}||$forum->{templatesurl}."/1x1.gif");
+       if (ref $userinfo{"avatar"} eq "HASH") {
+               substinfo($tree,["_tag"=>"img","class"=>"avatar"],
+               %{$userinfo{'avatar'}});
+       } elsif ($userinfo{'avatar'})  {        
+               substinfo($tree,["_tag"=>"img","class"=>"avatar"],
+               src=>$userinfo{"avatar"});
+       } else {
+               substinfo($tree,["_tag"=>"img","class"=>"avatar"],
+                       src=>$forum->{templatesurl}."/1x1.gif",
+                       width=>1,height=>1);
+       }               
        delete $userinfo{"avatar"};
 
        for my $element ( $tree->look_down("class",qr/^ap-/)) {
@@ -906,13 +919,15 @@ sub new_topic {
                form_error($form,$cgi,$forum,"Тема с urlname $urlname уже
                существует");
        }       
+       my $url = $cgi->url(-absolute=>1,-path_info=>1)."/$urlname.html";
+               $url =~ s/\/+/\//g;
        if (!$cgi->param("title")) {
                form_error($form,$cgi,$forum,"Тема должна иметь непустое название");
        }       
        #
        # Создаем собственно тему
        #
-       my $tree = gettemplate($forum,"topic",$cgi->path_info."/$urlname.html");
+       my $tree = gettemplate($forum,"topic",$url);
     # Заполнить название и аннотацию 
        my $abstract = input2tree($cgi,$forum,"abstract");
        substinfo($tree,[_tag=>"meta","name"=>"description"],content=>$abstract->as_trimmed_text);
@@ -951,14 +966,13 @@ sub new_topic {
        $newtopic->attr("id",$urlname);
        my $controlform = $newtopic->look_down(_tag=>"form",class=>"topicinfo");
        if ($controlform) {
-               $controlform->attr("action"=>$cgi->url(-absolute=>1,-path_info=>1).
-               "/$urlname.html");
+               $controlform->attr("action"=>$url);
                substinfo($controlform,[_tag=>"input",name=>"author"],value=>
                        $forum->{authenticated}{user});
        }               
        savetree($path_translated."/".$forum->{"indexfile"},$tree,$lockfd);
        record_statistics($forum,"topic");
-       forum_redirect($cgi,$forum,$cgi->path_info."/$urlname.html");
+       forum_redirect($cgi,$forum,$cgi->url(-base=>1).$url);
 }
 
 sub new_forum {
@@ -1023,8 +1037,9 @@ sub new_forum {
        # Создаем собственно оглавление форума
        #
        
-
-       my $tree = gettemplate($forum,"forum",$cgi->path_info."/$urlname");
+       my $url = $cgi->path_info."/$urlname";
+       $url =~ s/\/+/\//g;
+       my $tree = gettemplate($forum,"forum",$url);
     # Заполнить название и аннотацию 
        my $abstract = input2tree($cgi,$forum,"abstract");
        substinfo($tree,[_tag=>"meta","name"=>"description"],content=>$abstract->as_trimmed_text);
@@ -1069,15 +1084,15 @@ sub new_forum {
        $newforum->attr("id",$urlname);
        my $controlform = $newforum->look_down(_tag=>"form",class=>"foruminfo");
        if ($controlform) {
-               $controlform->attr("action"=>$cgi->url(-absolute=>1,-path_info=>1).
-               "/$urlname");
+               $controlform->attr("action"=>$cgi->url(-absolute=>1,-path_info=>0).
+               $url);
                substinfo($controlform,[_tag=>"input",name=>"author"],value=>
                        $forum->{authenticated}{user});
        }               
        savetree($path_translated."/".$forum->{"indexfile"},$tree,$lockfd);
        record_statistics($forum,"forum");
        }
-       forum_redirect($cgi,$forum,$cgi->path_info."/$urlname");
+       forum_redirect($cgi,$forum,$cgi->url(-base=>1).$url);
 }
        
 #---------------------------------------------------------- 
@@ -1187,6 +1202,7 @@ sub savetree {
 
 sub gettemplate {
        my ($forum, $template,$url) = @_;
+       $url =~ s/\/+/\//g;
        my $filename=$forum->{"templates"}."/$template.html";
        if (! -r $filename) {
                show_error($forum,"Нет шаблона $template");
@@ -1220,7 +1236,7 @@ sub get_uid {
 sub create_openid_consumer {
        my ($cgi,$forum) = @_;
        return Net::OpenID::Consumer ->new(
-               ua => LWP::UserAgent->new(),
+               ua => LWP::UserAgent->new( agent => "Stilllife/1.0"),
                args => $cgi,
                consumer_secret=>"X9RWPo0rBE7yLja6VB3d",
                required_root => $cgi->url(-base=>1));
@@ -1281,7 +1297,14 @@ sub openid_verify {
                my $username = $user; 
                $username =~ s/^http:\/\///;
                if (!$userbase{$username}) {
-                       $userbase{$username} = freeze($forum->{authenticated}={"openiduser"=>1});
+                       # Тащим foaf, если получится
+                       my %info=get_foaf($csr->ua,$vident->declared_foaf);
+                       if (ref($info{'avatar'}) eq "HASH" ) {
+                               delete $info{'avatar'}{'type'};
+                       }       
+                       $info{"openiduser"}=1;
+                       $forum->{authenticated}=\%info;
+                       $userbase{$username} = freeze(\%info);
                } else {
                        $forum->{authenticated} = thaw ($userbase{$username});
                }
@@ -1300,6 +1323,43 @@ sub openid_verify {
                exit;
        }       
 }
+
+sub get_foaf {
+       my ($ua,$foaf_url) = @_; 
+       my $response = $ua->get($foaf_url);
+       unless ($response->is_success) {
+               print STDERR "Error geting foaf from $foaf_url\n";
+               return ();
+       }       
+       my $foaf = $response->content;
+       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;
+}
 #-----------------------------------------------------------------
 # Обработка форматированных текстовых полей
 #-----------------------------------------------------------------