package VJournal::Session;

use strict;
use Carp;
use CGI;
use Cwd;
use File::Spec;

use vars qw($AUTOLOAD);
use constant COOKIE_NAME=>'VJ_SESSION';
use constant CONFIG_NAME=>'.vjournalrc';


our %config;

=head1 NAME 

VJournal::Session - handle authorized use session

=head1 SYNOPSIS

	use VJournal::Session
	my $s = VJournal::Session->new;
	
=head1 DESCRIPTION

B<VJournal::Session> manages session. Sesssion objects incoroprates
B<CGI.pm> context, and any methods of CGI.pm can be called as session
object methods.

=head1 METHODS

=head2 new

   $session = new VJournal::Session();
   $session = new VJournal::Session($cgi);

Creates new B<session> object based on the CGI request. If no  CGI
object is expilcitely provided, creates one using default constructor.

If there is no session cookie in the CGI context, or cookie is expired,
or cookie is bound to IP address, other than current B<remote_addr()>,
returns B<undef>.

=cut

sub new {
	my $pkg = shift;
	my %attrs;
	if (!@_) {
		%attrs=(-cgi=>new CGI);
	} elsif (scalar(@_)%2==0) {
		%attrs=@_;
	} elsif (scalar(@_) == 1) {
		%attrs=(-cgi=>$_[0]);
	} else {
	    croak "Invalid call to VJournal::Session::new"
	}	
	if (exists $attrs{-cgi} && $attrs{-cgi}->can("cookie")) {
		my $cgi=$attrs{-cgi};
		my $sess_id = $cgi->cookie(COOKIE_NAME);
		return undef unless $sess_id;
		load_config();
		if (!exists($config{-sessionbase})) {
			croak "No VJournal config read";
		}
		my %userbase;
		dbmopen %userbase,$config{-sessionbase},0644;

		return undef if (!exists($userbase{$sess_id}));
		my ($name,$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};
		if ($avatar) {
			$me->{-avatar}=$avatar;
			$me->{-avwidth}=$avwidth;
			$me->{-avheight}=$avheight;
		}
		if ($email) {
			$me->{-email}=$email;
		}
			
		my $now = time();
		if ($expire < $now) {
			delete $userbase{$sess_id};
			return undef;
		} elsif ($expire < $now - $config{-gracetime}) {
			$expire+=$config{-sessiontime};
			$userbase{$sess_id}=join(":",$name,$avatar,$email,$avwidth,$avheight,$ip,$expire);
			$me->{-cookie}=
			[$cgi->cookie(-name=>COOKIE_NAME,-value=>$sess_id,-expires=>
				$expire)];
		}	
		return bless $me,$pkg;
	}
}	

=head2 create

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,
	-avatar=>$uri,
	-bind_to_ip=>1
   );

If B<-bind_to_ip> is specified, session would be bound to IP address.
Avatar uri and email address might be provided by the authentication
mechanism.

If they are not obtained for free, caller shouldn't attempt to provide
them to create. Better to check if avatar and email are defined after
session creation. May be they are already cached.

=cut

sub create {
	my $pkg=shift;
	if (scalar(@_)%2!=0) {
		croak("Invalid call to ".$pkg."->create");
	}	
	my %params = @_;
	croack("User name is required by ".$pkg."->create") unless $params{-user};
	$params{-cgi}=CGI->new() if(!$params{-cgi});
	load_config($params{-cgi});
	my $user=$params{-user};
	my %users;
	my %sessions;
	dbmopen %users,$config{-userbase},0644;
	my $session={-cgi=>$params{-cgi},-name=>$params{-user}};
	if (!exists($users{$user})) {
		# New user come.
		require VJournal::Avatar;
		my @avatar;
		if (exists $params{-avatar}) {
			@avatar = VJournal::Avatar::cache($params{-avatar});
		} else {	
			@avatar = VJournal::Avatar::by_openid($user);
		}
		if (!@avatar && exists $params{-email}) {
			@avatar = VJournal::Avatar::by_email($params{-email});
		}
		my %a = @avatar;
		$users{$user}=join(":",$params{-email},$a{-src},$a{-width},$a{-height});
	}
	my ($email,$avatarsrc,$avatarwidth,$avatarheight)=split(":",$users{$user});
	$session->{-email} = $email if $email;
	if ($avatarsrc) {
		$session->{-avatar} = $avatarsrc;
		$session->{-avwidth} = $avatarwidth;
		$session->{-avheight} = $avatarheight;
	}
	my $expire = time()+$config{-sessiontime};
	require Digest::MD5;
	my
	$sessioninfo=join(":",$user,$avatarsrc,$email,$avatarwidth,$avatarheight,
		($params{-bind_to_ip}?$session->{-cgi}->remote_addr():""),$expire);
	$session->{-id} = Digest::MD5::md5_base64($sessioninfo);
	$sessions{$session->{-id}} = $sessioninfo;
	bless $session,$pkg;			
	$session->{-cookie}=
			[$session->cookie(-name=>COOKIE_NAME,-value=>$session->{-id},-expires=>
				$expire)];
	return $session			
}

=head2 set_cookie

	$s->set_cookie($s->cookie(-name=>name,-value=>value));

Stores new cookie to be send to client inside the session object.
They would be output when $s->header would be printed.

=cut

sub set_cookie {
	my $self=shift;
	$self->{-cookie}=[] if !exists $self->{-cookie};
	push @{$self->{-cookie}},@_;
}

=head2 avatar

  print $s->avatar() 
  %props=$s->avatar
  $s->avatar("http://www.some.site/userpic/user.gif");

In the scalar context returns img tag for user avatar. 
In the vector context returns list which looks like

  -src=>http://some.site/some.pic, -width=>nnn,-height=>nnn,-alt=>username

If URL is supplied, attempts to cache image in the local userpic area
so subsequent calls to the avatar would return local copy.

=cut

sub avatar {
	my $self = shift;
	if (@_) {
		#setup new avatar
		require VJournal::Avatar;
		my %a = VJournal::Avatar::cache($_[0]);
		while (my($key,$val)=each %a) {
			$self->{$key}=$val;
		}	
		$self->_update_user();
	} elsif (exists($self->{-avatar})) {
		my @a=(-src=>$self->{-avatar},-width=>$self->{-avwidth},-height=>$self->{-avheight},-alt=>$self->{-name});
		if (wantarray) {
			return @a;
		} else {
			return $self->{-cgi}->img(@a);
		}
	}
}

=head2 email 

	my $addr=$s->email();
	$s->email($address);

=cut


sub email {
	my $self = shift;
	if (@_) {
		$self->{-email} = shift;
		if (!exists $self->{-avatar}) {
			require VJournal::Avatar;
			VJournal::Avatar::by_email($self->{-email});
		}	
		$self->_update_user();
	}
	return $self->{-email};
}

=head2 isowner 

  if ($s->isowner()) {
  ....

returns true, if current user is owner of the blog

=cut

sub isowner {
	my $self=shift;
	return $self->{-name} eq $config->{-owner};
}

=head2 _update_user

	$s->_update_user

Updates intformation about user in the user and session database.
Internal function, called from B<create>, B<avatar> and B<email>.

=cut	

=head2 header

Overrideds CGI.pm header routine and adds to the header Set-Cookie
headers for cookies created by B<new>, B<create> or added by B<set_cookie>

=cut

sub header {
	my $self = shift;
	push @_,-cookie=>$self->{-cookie} if exists($self->{-cookie}) ;
	return $self->{-cgi}->header(@_);
}	

=head2 load_config

	load_config($cgi)

walks up the path_translated() and searches for the B<.vjournalrc> config.
dies if config not found.

=cut

sub load_config {
	my $cgi = $_[0];
	my $path=$cgi->path_translated();
	my @dirs = File::Spec->splitdir($path);
	my @uri = File::Spec->splitdir($cgi->path_info);
	my $found =0;
	while (@dirs) {
		my $d=File::Spec->catdir(@dirs,CONFIG_NAME);
		if (-r $d) {
			open F,"<",$d;
			local $/=undef;
			my $config = <F>;
			close F;
			eval "%config = {$d}";
			$config{-topdir}=File::Spec->catdir(@dirs);
			$config{-topurl}=$cgi->url(-base=>1).File::Spec->catdir(@uri);
			die $@ if ($@);
			$found = 1;
		}	
		pop @dirs;
		pop @uri;
	}	
	die ("Cannot find config file inside $path") unless $found;
	my @reqkeys=qw(-statedir);
	foreach my $key (@reqkeys) {
		die "Required key $key missing from config" 
			unless exists $config{$key};
	}
	# sensible defaults
	$config{-sessionbase}||=$config{-statedir}."/sessions.db";
	$config{-userbase}||=$config{-statedir}."/user.db";
	$config{-sessiontime}||=86400*30;
	$config{-gracetime}||=86400;
	$config{-templatedir}||=$config{-topdir}."/templates"
	$config{-avatardir}||=$config{-topdir}."/avatars";
	if (!$config{-owner}) {
		my $uri=substr($config{-topurl},index($config{-topurl},"://")+2;
		$uri =~ s/:\d+(\/.*)?$//;
		$config{-owner} = $uri;
	}
}

=head2 AUTOLOAD

Delegates all called methods which are not implemented to the CGI.pm
object

=cut


sub AUTOLOAD {
	my $self=shift;
	my $func = $AUTOLOAD;;
	croak("Invalid method $AUTOLOAD") unless CGI->can($func);
	return $self->{-cgi}->$func(@_);
}

1;
