X-Git-Url: http://www.wagner.pp.ru/gitweb/?p=oss%2Fvjournal.git;a=blobdiff_plain;f=lib%2FVJournal%2FSession.pm;fp=lib%2FVJournal%2FSession.pm;h=e8197864dd566298ecebf04aaae4170bf579ff42;hp=99f18e12fc13144a3d177d08063a3a7a8a7a0f38;hb=1d84bf53fde880886b6aee02111c1c8958f5a15b;hpb=647ff52e2181b63cad3d140e038c64be35159f72

diff --git a/lib/VJournal/Session.pm b/lib/VJournal/Session.pm
index 99f18e1..e819786 100644
--- a/lib/VJournal/Session.pm
+++ b/lib/VJournal/Session.pm
@@ -68,12 +68,12 @@ sub new {
 		dbmopen %userbase,$config{-sessionbase},0644;
 
 		return undef if (!exists($userbase{$sess_id}));
-		my ($name,$avatar,$email,$avwidth,$avheight,$ip,$expire) =
+		my ($name,$identity,$avatar,$email,$avwidth,$avheight,$ip,$expire) =
 		split(/:/,$userbase{$sess_id});
 		if ($ip && $ip ne $attrs{-cgi}->remote_addr()) {
 			return undef;
 		}
-		my $me={-id=>$sess_id,-name=>$name,-cgi=>$cgi};
+		my $me={-id=>$sess_id,-name=>$name,-identity=>$identity,-cgi=>$cgi};
 		if ($avatar) {
 			$me->{-avatar}=$avatar;
 			$me->{-avwidth}=$avwidth;
@@ -89,7 +89,7 @@ sub new {
 			return undef;
 		} elsif ($expire < $now - $config{-gracetime}) {
 			$expire+=$config{-sessiontime};
-			$userbase{$sess_id}=join(":",$name,$avatar,$email,$avwidth,$avheight,$ip,$expire);
+			$userbase{$sess_id}=join(":",$name,$identity,$avatar,$email,$avwidth,$avheight,$ip,$expire);
 			$me->{-cookie}=
 			[$cgi->cookie(-name=>COOKIE_NAME,-value=>$sess_id,-expires=>
 				$expire)];
@@ -103,7 +103,8 @@ sub new {
 Creates new session for given user. It is assumet that user have been
 properly authenticated by caller. (i.e. using OpenID).
 
-   $session=VJournal::Session->create(-user=>'user',-cgi=>$cgi,-email=>$mailaddress,
+   $session=VJournal::Session->create(-identity=>'identity-url',
+   	-name=>"user display name",-cgi=>$cgi,-email=>$mailaddress,
 	-avatar=>$uri,
 	-bind_to_ip=>1
    );
@@ -124,15 +125,16 @@ sub create {
 		croak("Invalid call to ".$pkg."->create");
 	}	
 	my %params = @_;
-	croack("User name is required by ".$pkg."->create") unless $params{-user};
+	croack("User identity is required by ".$pkg."->create") unless
+	$params{-identity};
 	$params{-cgi}=CGI->new() if(!$params{-cgi});
 	load_config($params{-cgi});
-	my $user=$params{-user};
+	my $identity=$params{-identity};
 	my %users;
 	my %sessions;
 	dbmopen %users,$config{-userbase},0644;
-	my $session={-cgi=>$params{-cgi},-name=>$params{-user}};
-	if (!exists($users{$user})) {
+	my $session={-cgi=>$params{-cgi},-identity=>$params{-identity}};
+	if (!exists($users{$identity})) {
 		# New user come.
 		require VJournal::Avatar;
 		my @avatar;
@@ -145,9 +147,11 @@ sub create {
 			@avatar = VJournal::Avatar::by_email($params{-email});
 		}
 		my %a = @avatar;
-		$users{$user}=join(":",$params{-email},$a{-src},$a{-width},$a{-height});
+		$users{$identity}=join(":",$params{-name}||$identity
+			,$params{-email},$a{-src},$a{-width},$a{-height});
 	}
-	my ($email,$avatarsrc,$avatarwidth,$avatarheight)=split(":",$users{$user});
+	my ($name,$email,$avatarsrc,$avatarwidth,$avatarheight)=split(":",$users{$user});
+	$session->{-name} = $name;
 	$session->{-email} = $email if $email;
 	if ($avatarsrc) {
 		$session->{-avatar} = $avatarsrc;
@@ -157,7 +161,7 @@ sub create {
 	my $expire = time()+$config{-sessiontime};
 	require Digest::MD5;
 	my
-	$sessioninfo=join(":",$user,$avatarsrc,$email,$avatarwidth,$avatarheight,
+	$sessioninfo=join(":",$name,$identity,$avatarsrc,$email,$avatarwidth,$avatarheight,
 		($params{-bind_to_ip}?$session->{-cgi}->remote_addr():""),$expire);
 	$session->{-id} = Digest::MD5::md5_base64($sessioninfo);
 	$sessions{$session->{-id}} = $sessioninfo;
@@ -183,6 +187,30 @@ sub set_cookie {
 	push @{$self->{-cookie}},@_;
 }
 
+=head2 identity
+
+	$s->identity()
+
+Returns OpenID identity URL	for current user
+
+=cut
+
+sub identity {
+	return shift->{-identity};
+}
+
+=head2 name
+
+	$s->name()
+
+Returns display name for current user
+
+=cut
+
+sub name {
+	return shift->{-name};
+}
+
 =head2 avatar
 
   print $s->avatar() 
@@ -251,9 +279,56 @@ returns true, if current user is owner of the blog
 
 sub isowner {
 	my $self=shift;
-	return $self->{-name} eq $config->{-owner};
+	return $self->{-identity} eq $config->{-owner};
 }
 
+=head2 banned
+	
+	$s->banned()
+
+Return true if current user is banned from leaving comments in the blog.	
+	
+=cut
+
+sub banned {
+	return exists shift->{-ban}
+}
+
+=head2 ban
+
+	$s->ban($identity_url);	
+
+Marks user as banned in the current blog
+
+=cut
+
+sub ban {
+	my ($self,$foe) = @_;
+	if (!$self->isowner()) return undef;
+	my %bans;
+	dbmopen %bans,$config{-topdir}."/bans",0644;
+	$bans{$foe}=time();
+}
+
+=head2 _readban
+
+	$session=>{-identity=>$identity,...,_readban($identity)}
+
+Returns aray (-ban => 1) if $identity is recorded in tbe bans dbm file
+in the blog top url
+
+=cut
+
+sub _readban {
+	my $identity = shift;
+	dbmopen %bans,$config{-topdir}."/bans",0644;
+	if (exists $bans{-identity}) {
+		return (-ban=>1);
+	} else {
+		return ();
+	}	
+}	
+
 =head2 _update_user
 
 	$s->_update_user