package ACIS::Web::NewUser;

use strict;
use warnings;

use Data::Dumper;
use Carp::Assert;

use CGI::Untaint;

use ACIS::Common;

use ACIS::Data::DumpXML qw( &dump_xml );

use RePEc::ShortIDs::Client;



######  new-user screen (initial)  ###


sub initial_prepare {
  my $app = shift;

  my ($year, $month, $day) = (localtime)[5, 4, 3];
    
  $app -> set_form_value ( 'year',  $year + 1900 );
  $app -> set_form_value ( 'month', $month + 1 );
  $app -> set_form_value ( 'day',   $day );
  
}



# все экраны будут иметь внешнее перенаправление. то есть, экран сгенерировал
# страницу, сделал так, чтобы данные пришли ему. принял данные, записал в
# session, userdata, сделал redirect, пока очередность будет hardcoded.

sub initial_process {
  debug "running new-user initial screen";
  
  my $app = shift;

  debug 'found some parameters, processing received user data';

  if ( $app -> get_form_value ('pass') ne $app -> get_form_value ('pass-confirm') ) {

    $app -> form_invalid_value( 'pass' );
    $app -> form_invalid_value( 'pass-confirm' );
    
#    $app -> error( 'password-confirmation-mismatch' );
    $app -> clear_process_queue;
    return;
  }

  debug "creating a session";
    
  my $owner = {};

  $owner -> {login} = $app -> get_form_value( 'email' );

  assert( $owner->{login} );

  $owner -> {IP} = $ENV{'REMOTE_ADDR'};

  ### XXX shouldn't it contain a session-class name?
  my $session = $app -> start_new_session ( $owner, 'new-user' );
  
  my $sid = $session -> id;
  
  debug "new session created: $sid";


  $session -> {'user-data'} = ACIS::Web::UserData -> new();
  
 
  $app -> process_form_data();

  $app -> userlog ( "initial registration" ); 

  prepare_user( $app );

  $app -> redirect_to_screen ('new-user/additional');



}




sub prepare_user {

  my $app = shift;
  
  my $session = $app -> session;
  my $record  = $session -> current_record;
  
  debug ( Dumper $record );

  assert( $record->{name} );
  assert( $record->{name} -> {last} );


  $record ->{type} = 'person';

  my $name         = $record -> {name}; 

  my $first_name   = $name -> {first};
  my $second_name  = $name -> {middle};
  my $last_name    = $name -> {last};
  my $first_small  = substr $first_name, 0, 1;
    
  my $full_name = "$first_name $second_name $last_name";

  debug( "Full name: $full_name" );

  $full_name =~ s/\s+/ /g;

  $app -> userlog ( "initial: full name: $full_name" );
    
  $record  ->{'full-name'} = $full_name; ### XXX
  $record  ->{name} {full} = $full_name;
  $session ->{'user-data'} {owner} {name} = $full_name;

  $session ->owner ->{name}  = $full_name;
  $session ->owner ->{login} = $record ->{email};

  my $handle_name = "$last_name $second_name $first_name";

  $handle_name =~ s/[^a-z]//gi;

  ###  name characters check

  if( $handle_name =~ /[A-Z]{2}/i ) {
    ### no special need for the latin name
    $session -> {'ask-latin-name'} = 0;

  } else {
    ### Less than two latin letters in the handle-name.  The user
    ### should enter her name in latin letters.

    $session -> {'ask-latin-name'} = 1;
  }

    

  ### generate initial name variations
  $record -> {'name-variations'} =  [
    "$first_name $last_name",
    "$first_small. $last_name",
    "$last_name, $first_name",
    "$last_name, $first_small."
  ];
  
  if ($second_name) {
    my $second_small = substr $second_name, 0, 1;

    push @{ $record -> {'name-variations'} },  (
      "$first_name $second_name $last_name",
      "$first_name $second_small. $last_name",
      "$first_small. $second_small. $last_name",
      "$last_name, $first_name $second_name",
      "$last_name, $first_name $second_small.",
      "$last_name, $first_small. $second_small."
    );
  }

}





######  new-user/additional screen  ###


sub additional_prepare {
  my $app = shift;
  
  my $session = $app -> session;

  debug "preparing personal data service screen";
  
  if ( $session -> type ne 'new-user' ) {
    $app -> error( 'session-wrong-type' );
    $app -> clear_process_queue;
    $app -> set_presenter( 'sorry' );
    return;
  }
  
  my $variations = join "\n", @{ $session -> current_record -> {'name-variations'} };
  debug "Name variations: $variations";

  $app -> set_form_value ( 'name-variations', $variations );

  
  ### ask latin name

  if ( $session -> {'ask-latin-name'} ) {
    $app -> variables -> {'ask-latin-name'} = 1;
  }

}


sub additional_process {
  my $app = shift;
  
  my $session = $app -> session;

  debug "running personal data service screen";
  
  if ( $session-> type ne 'new-user' )  {
    $app -> error( 'session-wrong-type' );
    $app -> clear_process_queue;
    $app -> set_presenter( 'sorry' );
    return;
  }

  $app -> variables -> {'ask-latin-name'} = $session -> {'ask-latin-name'};

  my $input = $app -> request -> {params};

  if ( $session -> {'ask-latin-name'} ) {
    if( not $input -> {'name-latin'} ) {
      $app -> form_required_absent ( 'name-latin' );
      return;
    }
  }
  
  my $record = $session -> current_record;

  $record -> {'name-variations'} = 
    [ split ( /\s*[\n\r]+/, $app -> get_form_value ('name-variations') ) ];
  $app -> redirect_to_screen ('new-user/affiliation');


  $app -> userlog ( "initial: additional processed, moving towards affilations" );
    
}





### XXX is this ok?  Do we allow new users to submit institutions?
### yes, but the email will be sent out only after the confirmation.

sub new_institution {
  my $app = shift;
  
  my $session = $app -> session;
  if ( $session-> type ne 'new-user' ) {
    $app -> error( 'session-wrong-type' );
    $app -> clear_process_queue;
    $app -> set_presenter( 'sorry' );
    return;
  }

  ACIS::Web::Affiliations::submit_institution( $app );
  
  $app -> redirect_to_screen ('new-user/affiliation');
}
 



#################  initial registration complete, but not yet confirmed  ###

sub complete {

  debug "running new user registration complete service screen";
  
  my $app = shift;

  my $session = $app -> session;
  
  if ( $session-> type ne 'new-user' ) {
    $app -> error( 'session-wrong-type' );
    $app -> clear_process_queue;
    $app -> set_presenter( 'sorry' );
    return;
  }


  my $path = $app -> {home} . '/unconfirmed/';

  my $filename;
  my $confirmation_id = $session -> {'confirmation-id'};
  
  while ( not defined $confirmation_id ) {
    $confirmation_id = generate_id();
    
    if ( -f "$path$confirmation_id" ) { next; }
  }

  $filename = "$path$confirmation_id";

  debug "confirmation-id: '$confirmation_id'";

  $session -> {'confirmation-id'} = $confirmation_id;

  $session -> save( $filename );


  my $confirmation_url = $app -> config( 'base-url' )
        . '/confirm!' . $confirmation_id;

  $app -> userlog ( "initial: next step is confirming through $confirmation_url" );

  $app -> variables -> {'confirmation-url'} = $confirmation_url;
  
  debug "the <a href='$confirmation_url'>confirmation url</a>";
  
  $app -> send_mail ('email/confirmation.xsl');

}


###  handler of the "confirm" screen 

sub confirm {
  my $app = shift;
  
  debug "running new user confirmation screen";
  my $confirmation_id = $app -> request -> {'session-id'};

  my $path = $app -> {home} . '/unconfirmed/';

  my $filename = "$path$confirmation_id";

  debug "received '$confirmation_id', try load unconfirmed session $filename";

  my $session = ACIS::Web::Session::load( $filename );

  if ( not $session ) {
    $app -> errlog ( "bad confirmation attempt: $confirmation_id" );
    $app -> error ('confirmation-bad');
    $app -> clear_process_queue;
    return;
  }

  assert( $session -> type() eq 'new-user' );

  $app -> session( $session );

  my $udata = $session -> {'user-data'};
  
  my $login = $session -> owner ->{login};


  my $records = $udata  ->{records};

  ### XXX the following will assume, that initially in the userdata
  ### there is only one record, and that record is of type 'person'

  my $record  = $udata  ->{records} ->[0];


  # make handle for the person record

  {
    my $handle;

    my $name  = $record -> {name}; 

    my $handle_name;

    if( $name -> {latin} ) {
      $handle_name = $name->{latin};
    } else {
      $handle_name = $record ->{'full-name'}; ### XXX $name -> {full}
    }

    $handle_name = uc $handle_name;
    $handle_name =~ s/[^A-Z]/_/g;
    $handle_name =~ s/_+/_/g;

    ###  name characters check
    
    if( $handle_name !~ /[A-Z]/ ) {
      $app -> error( "cant-make-person-id" );
      return;
    }
    
    my $date = $session -> {'registration-date'};

    my $year  = $date -> {year};
    my $month = $date -> {month} + 0;
    my $day   = $date -> {day} + 0;
    
    assert( $year  );
    assert( $month );
    assert( $day   );

    $month = "0$month" if $month < 10;
    $day   = "0$day"   if $day   < 10;
    
    my $prefix = $app -> config ( 'person-id-prefix' );
    
    $handle = "$prefix$year-$month-$day:$handle_name";

    ### XXX METADATA Here we need a check for handle uniqueness
    ### and we can do it with Short-IDs client
    my $sid = RePEc::ShortIDs::resolve_handle( $handle );
    if( $sid ) {
      $app -> errlog ( "a non-unique handle generated: $handle, user: $login" );
#      die "Non-unique person-record id";
    }

    
    $app -> userlog ( "initial confirm: id: $handle" );

    $record->{id} = $handle;
  }
  
  # get short-id for the person record
  my $id   = $record ->{id};
  my $name = $record ->{name} ->{last};

  my $id_name = $name;
  $id_name =~ s/[^a-zA-Z]//g;

  if( not $id_name ) {
    $id_name = $record ->{name} ->{latin};
    $id_name =~ s/[^a-zA-Z]//g;
  }

  if( not $id_name ) {
    $app ->errlog ( "[$login] confirm: no latin-spelled name" );
    $app ->error( "latin-name-necessary" );

  } else {

    my $sid = RePEc::ShortIDs::make_up_short_id_for_a_person
	  ( $id, $id_name );

    if ( not defined $sid ) {
      $app ->errlog ( "[$login] confirm: can't get the short-id, id: $id, name: '$id_name'" );
      critical "we tried to make a short-id, but no luck";
    }
    
    $app -> userlog ( "confirm: for id $id and name '$id_name', short-id: $sid" );
    $record -> {'short-id'} = $sid;

  }


  $record -> {'about-owner'} = 'yes';



  $app -> session( $session );


  use ACIS::Web::LogOff;

  ACIS::Web::LogOff::new_user_logoff ( $app );

}



sub new_user_test {
  my $app = shift;

#  $app->check_input_parameters;

  my $fname = $app ->get_form_value( 'first-name' );
  my $lname = $app ->get_form_value( 'last-name' );

  my $name = "$fname $lname";

  debug "Person name: $name";
  
}


1;
