#!/usr/bin/perl -w
use strict;
use warnings FATAL => qw(all);

use fields qw(dbic
	      cf_datadir cf_dbname);

use YATT::Lite::Entities qw(*CON);

sub DBIC () { __PACKAGE__ . '::DBIC' }

use YATT::Lite::WebMVC0::DBSchema::DBIC
  (DBIC, verbose => $ENV{DEBUG_DBSCHEMA}
   , [user => undef
      , uid => [integer => -primary_key
		, [-has_many
		   , [address => undef
		      , addrid => [integer => -primary_key]
		      , owner => [int => [-belongs_to => 'user']]
		      , country => 'text'
		      , zip => 'text'
		      , prefecture => 'text'
		      , city => 'text'
		      , address => 'text'], 'owner']
		, [-has_many
		   , [entry => undef
		      , eid => [integer => -primary_key]
		      , owner => [int => [-belongs_to => 'user']]
		      , title => 'text'
		      , text  => 'text'], 'owner']]
      , login => ['text', -unique]
      , encpass => 'text'
      , tmppass => 'text'
      , tmppass_expire => 'datetime'
      , email => 'text'
      , confirm_token => ['text', -unique]
     ]
   );

#========================================
Entity resultset => sub {
  shift->YATT->dbic->resultset(@_);
};

#========================================
Entity LOGIN => sub { 'login' };

Entity is_logged_in => sub {
  my ($this) = @_;
  $this->entity_sess($this->entity_LOGIN);
};

Entity set_logged_in => sub {
  my ($this, $login) = @_;
  if (defined $login and $login ne '') {
    $CON->start_session([$this->entity_LOGIN => $login]);
  } else {
    $CON->delete_session;
  }
};

#========================================
use Digest::MD5 qw(md5_hex);

sub is_user {
  my ($self, $loginname) = @_;
  $self->dbic->resultset('user')->single({login => $loginname})
}

sub find_user_by_login {
  my ($self, $login) = @_;
  $self->dbic->resultset('user')->single({login => $login});
}

sub find_user_by_email {
  my ($self, $email) = @_;
  $self->dbic->resultset('user')
    ->search({email => $email})
      ->single;
}

sub find_user {
  my ($self, $login_or_email) = @_;
  if ($login_or_email =~ /\@/) {
    $self->find_user_by_email($login_or_email)
  } else {
    $self->find_user_by_login($login_or_email)
  }
}

sub has_auth_failure {
  my ($self, $loginname, $plain_pass) = @_;
  my $user = $self->dbic->resultset('user')->single({login => $loginname})
    or return "No such user: $loginname";
  return 'Password mismatch' unless $user->encpass eq md5_hex($plain_pass);
  return undef;
}

sub add_user {
  my ($self, $login, $pass, $email) = @_;

  # XXX: Is this good token?
  my $token = $self->encrypt_password
    ($self->make_password, $login, $pass);

  my $newuser = $self->dbic->resultset('user')
    ->new({login => $login
	   , email => $email
	   , encpass => md5_hex($pass)
	   , confirm_token => $token
	   # XXX: tmppass_expire
	  });

  $newuser->insert;

  ($newuser, $token);
}

sub reset_password {
  my ($self, $email, $expire_mins) = @_;
  my $dbic = $self->dbic;
  my ($auth, $token, $error);
  txn_do $dbic sub {
    unless ($auth = $self->find_user_by_email($email)) {
      $error = "Unknown email: $email";
      return;
    }

    $auth->tmppass($token = $self->make_password(20));
    $auth->tmppass_expire(time + 60*($expire_mins // 60));
    $auth->update;
  };

  die $error if $error;

  $token;
}

sub can_change_password {
  my ($self, $email, $token) = @_;
  my $auth = $self->dbic->resultset('user')
    ->search({email => $email})
      ->single
	or return;

  return unless ($auth->tmppass // '') eq $token;
  return unless time < ($auth->tmppass_expire // 0);
  $auth;
}

sub do_change_password {
  my ($self, $email, $token, $password) = @_;
  my $dbic = $self->dbic;
  my ($user, $error);
  txn_do $dbic sub {
    unless ($user = $self->can_change_password($email, $token)) {
      $error = "Invalid email or expired token!";
      return
    }
    my $auth = $user;
    $auth->update({encpass => md5_hex($password)
		   , tmppass => undef
		   , tmppass_expire => undef});
  };
  die $error if $error;
  $user;
}

sub fetch_pass_pair {
  (my MY $self, my $con) = @_;
  my $pass1 = $con->param_type('password', qr{^\w{8,}$ }x
			       , q|Password should be alphabets and digits|
			      . q|, at least 8 chars.|);
  my $pass2 = $con->param_type('password2', nonempty =>
			       , q|Please retype same password.|);

  unless ($pass1 eq $pass2) {
    die "Password mismatch!";
  }

  $pass1;
}

sub fetch_email {
  (my MY $self, my $con) = @_;
  my $email = $con->param_type
    ('email', qr{^[\w\.\-]+\@[\w\.\-]+$ }x
     , q|Email syntax error!|);
}

# Stolen from Slash/Utility/Data/Data.pm:changePassword
{
  my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
  sub make_password {
    my ($self, $len) = @_;
    return join '', map { $chars[rand @chars] } 1 .. ($len // 8);
  }

  sub encrypt_password {
    my ($self, @rest) = @_;
    md5_hex(join ":", reverse @rest);
  }
}

#========================================
use YATT::Lite::XHF qw(parse_xhf);
use YATT::Lite::Util qw(terse_dump);
use YATT::Lite::Util qw(ostream);

sub output_file {
  my ($fn) = @_;
  open my $fh, '>', $fn or die "Can't open file '$fn': $!";
  $fh;
}

sub sendmail {
  my ($self, $con, $page, $widget_name, $to, @rest) = @_;
  if (grep {not defined $_} $widget_name, $to) {
    die "Not enough parameter!";
  }
  my $sub = $page->can("render_$widget_name")
    or die "Unknown widget $widget_name";

  my $transport = $ENV{EMAIL_SENDER_TRANSPORT};
  my $is_debug = defined $transport && $transport eq 'YATT_TEST';

  my $fh = $is_debug ? output_file("$self->{cf_datadir}/.htdebug.eml")
    : ostream(my $buffer);

  $sub->($page, $fh, $to, @rest);

  if ($is_debug) {
    return 'ok';
  } else {
    require Email::Simple;
    require Email::Sender::Simple;
    my $msg = Email::Simple->new($buffer);

    Email::Sender::Simple->send($msg);
  }
}

Entity mail_sender => sub {
  my ($this) = @_;
  $this->entity_dir_config('mail_sender') || 'webmaster@localhost';
};


#========================================

sub dbic {
  my MY $self = shift;
  $self->{dbic} //= $self->DBIC->connect($self->dbi_dsn);
}

sub dbic_disconnect {
  (my MY $self) = @_;
  if (my $dbic = $self->{dbic}) {
    $dbic->storage->disconnect;
  }
  $self;
}

sub dbi_dsn {
  my MY $self = shift;
  "dbi:SQLite:dbname=$self->{cf_dbname}";
}

sub cmd_setup {
  my MY $self = shift;
  unless (-d $self->{cf_datadir}) {
    require File::Path;
    File::Path::make_path($self->{cf_datadir}, {mode => 02775, verbose => 1});
  }
  # XXX: more verbosity.
  # XXX: Should be idempotent.
  # $self->dbic->YATT_DBSchema->deploy;
  $self->DBIC->YATT_DBSchema->cf_let
    ([verbose => 1]
     , connect_to => sqlite => $self->{cf_dbname});
}

#========================================
sub after_new {
  my MY $self = shift;
  $self->{cf_datadir} //= "$self->{cf_dir}/../data";
  $self->{cf_dbname} //= "$self->{cf_datadir}/.htdata.db";
}