# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 1999-2006 Peter Thoeny, peter@thoeny.org
# and TWiki Contributors. All Rights Reserved. TWiki Contributors
# are listed in the AUTHORS file in the root of this distribution.
# NOTE: Please extend that file, not this notice.
#
# Additional copyrights apply to some or all of the code in this
# file as follows:
# Copyright (c) 1999-2004 Peter Thoeny, peter@thoeny.com
#           (c) 2001 Kevin Atkinson, kevin twiki at atkinson dhs org
#           (c) 2003 SvenDowideit
#           (c) 2003 Graeme Pyle graeme@raspberry dot co dot za
#           (c) 2004 Martin Cleaver, Martin.Cleaver@BCS.org.uk
#           (c) 2004 Gilles-Eric Descamps twiki at descamps.org
#           (c) 2004 Crawford Currie c-dot.co.uk
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version. For
# more details read LICENSE in the root of this distribution.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# As per the GPL, removal of this notice is prohibited.

=pod

---+ package TWiki::UI::Register

User registration handling.

=cut

package TWiki::UI::Register;

use strict;
use TWiki;
use TWiki::Net;
use TWiki::Plugins;
use TWiki::User;
use TWiki::Data::DelimitedFile;
use Data::Dumper;
use Error qw( :try );
use TWiki::UI;
use TWiki::OopsException;
use Assert;

my $twikiRegistrationAgent = 'TWikiRegistrationAgent';

=pod

---++ StaticMethod register_cgi( $session )
=register= command handler.
This method is designed to be
invoked via the =TWiki::UI::run= method.

=cut

sub register_cgi {
    my $session = shift;

    # absolute URL context for email generation
    $session->enterContext('absolute_urls');

    my $tempUserDir = $TWiki::cfg{RegistrationApprovals};
    # SMELL hacked name, and stores in binary format!
    my $needVerification = $TWiki::cfg{Register}{NeedVerification};    
	# NB. No test harness for needVerification = 0.
    my $needApproval = 0;

    # Register -> Verify -> Approve -> Finish

    # NB. bulkRegister invoked from ManageCgiScript.

    my $action = $session->{cgiQuery}->param('action') || '';

    if ($action eq 'register') {
      registerAndNext($session, $tempUserDir);
    }
    elsif ($action eq 'verify') {
        verifyEmailAddress( $session, $tempUserDir );
        if ($needApproval) {
            throw Error::Simple('Approval code has not been written!');
        }
        finish( $session, $tempUserDir);
    }
    elsif ($action eq 'resetPassword') {
        #SMELL - is this still called here, or only by passwd? 
        resetPassword( $session );
    }
    elsif ($action eq 'approve') {
        finish($session, $tempUserDir );
    }
    else {
      registerAndNext($session, $tempUserDir);
    }

    $session->leaveContext('absolute_urls');

    # Output of register:
    #    UnsavedUser, accessible by username.$verificationCode

    # Output of reset password:
    #    unaffected user, accessible by username.$verificationCode

    # Output of verify:
    #    UnsavedUser, accessible by username.$approvalCode (only sent to administrator)

    # Output of approve:
    #    RegisteredUser, all related UnsavedUsers deleted
}

=pod

---++ StaticMethod passwd_cgi( $session )
=passwd= command handler.
This method is designed to be
invoked via the =TWiki::UI::run= method.

=cut

sub passwd_cgi {
    my $session = shift;

    my $action = $session->{cgiQuery}->param('action');

    # absolute URL context for email generation
    $session->enterContext('absolute_urls');

    if( $action eq 'changePassword' ) {
        changePassword( $session );
    }
    elsif ( $action eq 'resetPassword' ) {
        resetPassword( $session );
    }
    else {
        throw TWiki::OopsException( 'attention',
                                    web => $session->{webName},
                                    topic => $session->{topicName},
                                    def => 'missing_action' );
    }
    $session->leaveContext('absolute_urls');
}

# TODO: S&R {form} with {ordered}
# TODO: S&R row, data => user
# TODO: Replace LoginName with UserName (NB. templates/topics)
# TODO: During normal registration, a Plugin callback to set cookies,
#       TWiki::Plugins::registrationHandler( $data{webName}, $data{WikiName},
#       $data{remoteUser} );
#       Is called. But this has little to do with registration - it is an authentication rememberer.
#       In fact, isn't my bulkregistration handler just a reg handler?
# TODO: registernotifybulk.tmpl 
# TODO: make it copy the fields it wants before handing off to the RegsitrationPlugin - that way it won't matter if
#       that deletes such keys.
# ISSUE: TWiki::User::addUserToTWikiUsersTopic does not replace the line if you now supply a login name when one 
#       was not needed before.
# TODO: write a plugin that intercepts the change of metadata on a topic and invokes functionality as described on 
#       RegistrationAsPlugin.

# SMELL legacy format - bulletpoint. I'd hardcode it except there is a proposal to change it.
my $b = "\t*";
my $b2 ="\t\t*";
my $indent = "\t"; # SMELL indent legacy

=pod

---++ StaticMethod bulkRegister($session)

  Called by ManageCgiScript::bulkRegister (requires authentication) with topic = the page with the entries on it.
   1 Makes sure you are an admin user ;)
   2 Calls TWiki::Data::DelimitedFile (delimiter => '|', content =>textReadFromTopic)
   3 ensures requiredFieldsPresent()
   4 starts a log file
   5 calls registerSingleBulkUser() for each row 
   6 writes output to log file, sets [[TWiki.TOPICPARENT]] back to page with entries on it.
   7 redirects to log file

=cut

sub bulkRegister {
    my $session = shift;

    my $user = $session->{user};
    my $topic = $session->{topicName};
    my $web = $session->{webName};
    my $userweb = $TWiki::cfg{UsersWebName};
    my $query = $session->{cgiQuery};

    # absolute URL context for email generation
    $session->enterContext('absolute_urls');

    my $settings = {};
    $settings->{doOverwriteTopics} =
      $query->param('OverwriteHomeTopics') || 0;
    $settings->{doEmailUserDetails} =
      $query->param('EmailUsersWithDetails') || 0;

    unless( $session->{user}->isAdmin() ) {
        throw TWiki::OopsException( 'accessdenied', def => 'only_group',
                                    web => $web, topic => $topic,
                                    params => $TWiki::cfg{UsersWebName}.'.'.
                                      $TWiki::cfg{SuperAdminGroup} );
    }

    #-- Read the topic containing a table of people to be registered

    my ($meta, $text) = $session->{store}->readTopic( undef,
                                                      $web, $topic, undef );
    my %data;
    ( $settings->{fieldNames}, %data ) =
      TWiki::Data::DelimitedFile::read(content => $text, delimiter => '|' );

    my $registrationsMade = 0;
    my $log = '---+ Report for Bulk Register'."\n\n%TOC%\n";

    #-- Process each row, generate a log as we go
    ROW: foreach my $row ( values %data ) {
        $row->{webName} = $userweb;

        #-- Following two lines untaint WikiName as required and verify it is
        #-- not zero length
        $row->{WikiName} = TWiki::Sandbox::untaintUnchecked($row->{WikiName});
        next ROW if (length($row->{WikiName}) == 0);

        my ($userTopic, $uLog) =
          _registerSingleBulkUser($session, $row, $settings );
        $log .= "\n---++ ". $row->{WikiName}."\n";
        $log .= $b.' Added to users topic '.$userTopic.":\n".
          join("\n".$indent,split /\r?\n/, $uLog)."\n";	
        $registrationsMade++; # SMELL - no detection for failure
    }

    $log .= "----\n";
    $log .= 'registrationsMade: '.$registrationsMade;

    my $logWeb;
    my $logTopic =  $query->param('LogTopic') || $topic.'Result';
    ( $logWeb, $logTopic ) = $session->normalizeWebTopicName( '', $logTopic );

    #-- Save the LogFile as designated, link back to the source topic 

    $meta->put( 'TOPICPARENT', { name => $web.'.'.$topic } );

    my $err = $session->{store}->saveTopic($user, $logWeb, $logTopic, $log, $meta );

    $session->leaveContext('absolute_urls');

    $session->redirect($session->getScriptUrl( 1, 'view', $web, $logTopic ));
}

#    Process a single user, parameters passed as a hash
#
#    * receives row and a fieldNamesOrderedList
#    * sets LoginName to be WikiName if not present
#    * rearranges the row to comply with the ordered list
#    * if using htpasswd, calls _addUserToPasswordSystem()
#    * makes newUserFromTemplate
#    * calls addUserToTWikiUsersTopic()
# SMELL could be made much more efficient if needed, as calls to addUserToTWikiUsersTopic()
# are quite expensive when doing 300 in succession!
sub _registerSingleBulkUser {
    my ($session, $row, $settings) = @_;
    ASSERT( $row ) if DEBUG;
    ASSERT( $settings->{fieldNames} ) if DEBUG;
    my $fieldNames = $settings->{fieldNames};
    my $doOverwriteTopics = defined $settings->{doOverwriteTopics} ||
      throw Error::Simple( 'No doOverwriteTopics' );
    my $log;
    #-- call to the registrationHandler (to amend fields) should
    # really happen in here.

    #-- TWiki:Codev.LoginNamesShouldNotBeWikiNames - but use it if not supplied
    unless( $row->{LoginName} ) {
        $row->{LoginName} = $row->{WikiName};
        $log = $b.' No TWiki.LoginName specified - setting to '.
          $row->{LoginName}."\n";
    }

    #-- Ensure every required field exists
    # NB. LoginName is OPTIONAL
    my @requiredFields = qw(WikiName FirstName LastName);
    if (_missingElements( $fieldNames, \@requiredFields )) {
        throw Error::Simple( join(' ', @{$settings->{fieldNames}}).
                             ' does not contain the full set of '.
                             join(' ', @requiredFields) );
    }

    #-- Generation of the page is done from the {form} subhash, so align the two
    $row->{form} = [
                    _makeFormFieldOrderMatch( $fieldNames, $row)
                   ];

    my $passResult = _addUserToPasswordSystem( $session, $row );
    $log .= $b.' Password set: '.$passResult.' (1 = success)'."\n";
    #TODO: need a path for if it doesn't succeed.

    $session->writeLog('bulkregister', $row->{webName}.'.'.$row->{WikiName},
                       $row->{Email}, $row->{WikiName} );

    if( $doOverwriteTopics or !$session->{store}->topicExists( $row->{webName}, $row->{WikiName} ) ) {
        $log .= _newUserFromTemplate($session, 'NewUserTemplate', $row);
    } else {
        $log .= $b.' Not writing topic '.$row->{WikiName}."\n";
	}

    my $user = $session->{users}->findUser( $row->{LoginName},
                                            $row->{WikiName} );

    my $userTopic =
      $session->{users}->addUserToTWikiUsersTopic( $user,
                                                   $session->{user} );

    $user->setEmails( $row->{Email} );

    #if ($TWiki::cfg{EmailUserDetails}) {
        # If you want it, write it.
        # _sendEmail($session, 'registernotifybulk', $data );
    #    $log .= $b.' Password email disabled\n';
    #}
    return ($userTopic, $log);
}

#ensures all named fields exist in hash
#returns array containing any that are missing
sub _missingElements {
    my ($presentArrRef, $requiredArrRef) = @_;
    my %present;
    my @missing;

    $present{$_} = 1 for @$presentArrRef;
    foreach my $required (@$requiredArrRef) {
        if (! $present{$required}) {
            push @missing, $required;
        }
    }
    return @missing;
}

# rearranges the fields in $data so that they match settings
# returns a new ordered form
sub _makeFormFieldOrderMatch {
    my( $fieldNames, $data ) =@_;
    my @form = ();
    foreach my $field ( @$fieldNames ) {
        push @form, {name => $field, value => $data->{$field}};
    }
    return @form;
}

=pod

---++ StaticMethod registerAndNext($session, $tempUserDir) 

This is called when action = register or action = ""

It calls register and either Verify or Finish.

Hopefully we will get workflow integrated and rewrite this to be table driven

=cut

sub registerAndNext {
  my ($session, $tempUserDir) = @_;
  register( $session );
  if ($TWiki::cfg{Register}{NeedVerification}) {
     _requireVerification($session, $tempUserDir);
  } else {
     finish($session);
  }
}

=pod

---++ StaticMethod register($session)

This is called through: TWikiRegistration -> RegisterCgiScript -> here

   1 gets rows and fields from the query
   2 calls _validateRegistration() to ensure required fields correct, else OopsException 

=cut

sub register {
    my( $session ) = @_;

    my $query = $session->{cgiQuery};
    my $topic = $session->{topicName};
    my $web = $session->{webName};

    my $data = _getDataFromQuery( $query, $query->param() );

    $data->{webName} = $web;
    $data->{debug} = 1;

    _validateRegistration( $session, $data, $query, $topic );
}

#   1 generates a activation password
#   2 calls _putRegDetailsByCode(activation password)
#   3 sends them a 'registerconfirm' email.
#   4 redirects browser to 'regconfirm'
sub _requireVerification {
    my ($session, $tmpDir) = @_;

    my $query = $session->{cgiQuery};
    my $topic = $session->{topicName};
    my $web = $session->{webName};

    my $data = _getDataFromQuery( $query, $query->param() );
    $data->{webName} = $web;

    $data->{VerificationCode} =
      $data->{WikiName}.'.'.TWiki::User::randomPassword();
    _putRegDetailsByCode( $data, $tmpDir );

    $session->writeLog( 'regstart', $data->{webName}.'.'.$data->{WikiName},
                        $data->{Email}, $data->{WikiName} );

    my $err = _sendEmail( $session, 'registerconfirm', $data );

    if ( $err ) {
        throw TWiki::OopsException( 'attention',
                                    def => 'send_mail_error',
                                    web => $data->{webName},
                                    topic => $topic,
                                    params => [ $data->{Email}, $err ]);
    }
    throw TWiki::OopsException( 'attention',
                                def => 'confirm',
                                web => $data->{webName},
                                topic => $topic,
                                params => $data->{Email} );
}

=pod

---++ StaticMethod resetPassword($session)

Generates a password. Mails it to them and asks them to change it. Entry
point intended to be called from TWiki::UI::run

=cut

sub resetPassword {
    my $session = shift;
    my $query = $session->{cgiQuery};
    my $topic = $session->{topicName};
    my $web = $session->{webName};
    my $user = $session->{user};

    my @userNames = $query->param( 'LoginName' ) ;
    unless( @userNames ) {
        throw TWiki::OopsException( 'attention',
                                    def => 'no_users_to_reset' );
    }
    my $introduction = $query->param( 'Introduction' ) || '';
    # need admin priv if resetting bulk, or resetting another user
    my $isBulk = ( scalar( @userNames ) > 1 );

    if ( $isBulk ) {
        # Only admin is able to reset more than one password or
        # another user's password.
        unless( $session->{user}->isAdmin()) {
            throw TWiki::OopsException
              ( 'accessdenied', def => 'only_group',
                web => $web, topic => $topic,
                params => $TWiki::cfg{UsersWebName}.'.'.
                $TWiki::cfg{SuperAdminGroup} );
        }
    } else {
        # Anyone can reset a single password - important because by definition
        # the user cannot authenticate
        # Note that the passwd script must NOT authenticate!
    }

    # Collect all messages into one string
    my $message = '';
    my $good = 1;
    foreach my $userName (@userNames) {
        $good = $good &&
          _resetUsersPassword( $session, $userName, $introduction, \$message );
    }

    my $action = '';
    # Redirect to a page that tells what happened
    if( $good ) {
        unless( $isBulk ) {
            # one user; refine the change password link to include their
            # username (can't use logged in user - by definition this won't
            # be them!)
            $action = '?username='. $userNames[0];
        }
        throw TWiki::OopsException( 'attention',
                                    topic => $TWiki::cfg{UsersTopicName},
                                    def => 'reset_ok',
                                    params => $message );
    } else {
        throw TWiki::OopsException( 'attention',
                                    topic => $TWiki::cfg{UsersTopicName},
                                    def => 'reset_bad',
                                    params => $message );
    }
}

# return status
sub _resetUsersPassword {
    my( $session, $userName, $introduction, $pMess ) = @_;

    my $user = $session->{users}->findUser( $userName, undef);
    unless( $user ) {
        # couldn't work out who they are, its neither loginName nor
        # wikiName.
        $$pMess .= $session->inlineAlert( 'alerts', 'notwikiuser', $userName );
        return 0;
    }
    my @em = $user->emails();
    my $email = $em[0];
    unless ($email) {
        $$pMess .= $session->inlineAlert( 'alerts', 'no_email_for',
                                          $user->stringify());
        return 0;
    }

    my $message = '';
    unless( $user->passwordExists() ) {
        # Not an error.
        $$pMess .= $session->inlineAlert( 'alerts', 'missing_user',
                                          $user->stringify());
    }

    my $password = $user->resetPassword();

    my $err = _sendEmail( $session,
                          'mailresetpassword',
                          {
                           webName => $TWiki::cfg{UsersWebName},
                           LoginName => $user->login(),
                           Name => TWiki::spaceOutWikiWord($user->wikiName()),
                           WikiName => $user->wikiName(),
                           Email => $email,
                           PasswordA => $password,
                           Introduction => $introduction,
                          } );

    if( $err ) {
        $$pMess .= $session->inlineAlert( 'alerts', 'generic', $err );
        return 0;
    }
    $$pMess .= $session->inlineAlert( 'alerts',
                                      'new_sys_pass',
                                      $user->login(),
                                      $user->wikiName() );

    return 1;
}

=pod

---++ StaticMethod changePassword( $session )

Change the user's password and/or email. Details of the user and password
are passed in CGI parameters.

   1 Checks required fields have values
   2 get wikiName and userName from getUserByEitherLoginOrWikiName(username)
   3 check passwords match each other, and that the password is correct, otherwise 'wrongpassword'
   4 TWiki::User::updateUserPassword
   5 'oopschangepasswd'

The NoPasswdUser case is not handled

=cut

sub changePassword {
    my $session = shift;

    my $topic = $session->{topicName};
    my $webName = $session->{webName};
    my $query = $session->{cgiQuery};

    my $oldpassword = $query->param( 'oldpassword' );
    my $username = $query->param( 'username' );
    my $passwordA = $query->param( 'password' );
    my $passwordB = $query->param( 'passwordA' );
    my $email = $query->param( 'email' );

    my $topicName = $query->param( 'TopicName' );

    # check if required fields are filled in
    unless( $username ) {
        throw TWiki::OopsException( 'attention',
                                    web => $webName,
                                    topic => $topic,
                                    def => 'missing_fields',
                                    params => [ 'username' ] );
    }

    my $user = $session->{users}->findUser( $username );

    unless ($user) {
        throw TWiki::OopsException( 'attention',
                                    web => $webName,
                                    topic => $topic,
                                    def => 'notwikiuser',
                                    $username );
    }

    my $changePass = 0;
    if( defined $passwordA || defined $passwordB ) {
        unless( defined $passwordA ) {
            throw TWiki::OopsException( 'attention',
                                        web => $webName,
                                        topic => $topic,
                                        def => 'missing_fields',
                                        params => [ 'password' ] );
        }

        # check if passwords are identical
        if( $passwordA ne $passwordB ) {
            throw TWiki::OopsException( 'attention',
                                        web => $webName,
                                        topic => $topic,
                                        def => 'password_mismatch' );
        }
        $changePass = 1;
    }

    # check if required fields are filled in
    if( ! defined $oldpassword ) {
        throw TWiki::OopsException( 'attention',
                                    web => $webName,
                                    topic => $topic,
                                    def => 'missing_fields',
                                    params => [ 'oldpassword' ] );
    }

    unless( $user->checkPassword( $oldpassword)) {
        throw TWiki::OopsException( 'attention',
                                    web => $webName,
                                    topic => $topic,
                                    def => 'wrong_password');
    }

    if( defined $email ) {
        $user->setEmails( split(/\s+/, $email) );
    }

    # OK - password may be changed
    if( $changePass ) {
        if ($user->changePassword( $oldpassword, $passwordA )) {

            $session->writeLog('changepasswd', $user->stringify());
            #recording the email would be nice

        } else {
            $session->writeLog('changepasswd', $user->stringify(), 'FAILED');
            die 'Problem resetting password';
        }
        # OK - password changed
        throw TWiki::OopsException( 'attention',
                                    web => $webName, topic => $topic,
                                    def => 'password_changed' );
    }

    # must be just email
    throw TWiki::OopsException( 'attention',
                                 web => $webName, topic => $topic,
                                 def => 'email_changed',
                                 params => $email );

}

=pod

---++ StaticMethod verifyEmailAddress($session, $tempUserDir)

This is called: on receipt of the activation password -> RegisterCgiScript -> here
   1 calls _reloadUserContext(activation password)
   2 throws oops if appropriate
   3 calls emailRegistrationConfirmations
   4 still calls 'oopssendmailerr' if a problem, but this is not done uniformly

=cut

sub verifyEmailAddress {
    my( $session, $tempUserDir ) = @_;

    my $code = $session->{cgiQuery}->param('code');
    unless( $code ) {
        throw Error::Simple( 'verifyEmailAddress: no verification code!');
    }
    my $data = _reloadUserContext( $code, $tempUserDir );

    if (! exists $data->{Email}) {
        throw Error::Simple( 'verifyEmailAddress: no email address!');
    }

    my $topic = $session->{topicName};
    my $web = $session->{webName};

    #    $this->{session}->writeLog('verifyuser', $loginName, $userName);

}

=pod

---++ StaticMethod finish

Presently this is called in RegisterCgiScript directly after a call to verify. The separation is intended for the RegistrationApprovals functionality
   1 calls _reloadUserContext (throws oops if appropriate)
   3 calls newUserFromTemplate()
   4 if using the htpasswdFormatFamily, calls _addUserToPasswordSystem
   5 calls the misnamed RegistrationHandler to set cookies
   6 calls addUserToTWikiUsersTopic
   7 writes the logEntry (if wanted :/)
   8 redirects browser to 'oopsregthanks'

reloads the context by code
these two are separate in here to ease the implementation of administrator approval 

=cut

sub finish {
    my( $session, $tempUserDir) = @_;

    my $topic = $session->{topicName};
    my $web = $session->{webName};
    my $query = $session->{cgiQuery};
	my $code = $query->param('code');

	my $data;
	if ($TWiki::cfg{Register}{NeedVerification}) {
		$data = _reloadUserContext( $code, $tempUserDir );
		_deleteUserContext( $code, $tempUserDir );
	} else {
	    $data = _getDataFromQuery( $query, $query->param() );
	    $data->{webName} = $web;
	}

    if (! exists $data->{WikiName}) {
        throw Error::Simple( 'no WikiName after reload');
    }

    # inform user and admin about the registration. Note: do it now before 
    # purgeKeys deletes the password.
    _emailRegistrationConfirmations( $session, $data );

    my $log = _newUserFromTemplate($session, 'NewUserTemplate', $data);

    my $success = _addUserToPasswordSystem( $session, $data );
    # SMELL - error condition? surely need a way to flag an error?
    unless ( $success ) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $topic,
                                    def => 'problem_adding',
                                    params => $data->{WikiName} );
    }

    # Plugin callback to set cookies.
    $session->{plugins}->registrationHandler( $data->{WebName},
                                              $data->{WikiName},
                                              $data->{LoginName} );

    # let the client session know that we're logged in. (This probably
    # eliminates the need for the registrationHandler call above,
    # but we'll leave them both in here for now.)
    $session->{client}->userLoggedIn( $data->{LoginName}, $data->{WikiName} );

    # add user to TWikiUsers topic
    my $user = $session->{users}->createUser( $data->{LoginName},
                                              $data->{WikiName} );

    my $agent = $session->{users}->findUser( $twikiRegistrationAgent,
                                             $twikiRegistrationAgent);

    my $userTopic = $session->{users}->addUserToTWikiUsersTopic( $user, $agent);

    $user->setEmails( $data->{Email} );

    # write log entry
    if ($TWiki::cfg{Log}{register}) {
        $session->writeLog( 'register', $data->{webName}.'.'.$data->{WikiName},
                            $data->{Email}, $data->{WikiName} );
    }

    # and finally display thank you page
    throw TWiki::OopsException( 'attention',
                                web => $data->{webName},
                                topic => $data->{WikiName},
                                def => 'thanks',
                                params => $data->{Email} );
}

#Given a template and a hash, creates a new topic for a user
#   1 reads the template topic
#   2 calls RegistrationHandler::register with the row details, so that a plugin can augment/delete/change the entries
#
#I use RegistrationHandler::register to prevent certain fields (like password) 
#appearing in the homepage and to fetch photos into the topic
sub _newUserFromTemplate {
    my ($session, $template, $row) = @_;
    my ( $meta, $text ) = TWiki::UI::readTemplateTopic($session, $template);
    my $log = $b.' Writing topic '.$row->{webName}.'.'.$row->{WikiName}."\n".
      $b2.' RegistrationHandler: ';
    my $regLog = $text;
    _purgeKeys( $row );
    $log .= join($b2.' ', split /\r?\n/, $regLog)."\n";
    $log .= $b2.' '.
      join( $b2.' ',
            split( /\r?\n/,
                   _writeRegistrationDetailsToTopic( $session, $row,
                                                     $meta, $text )))."\n";
    return $log;
}

#Writes the registration details passed as a hash to either BulletFields or FormFields
#on the user's topic.
#
#Returns 'BulletFields' or 'FormFields' depending on what it chose.
sub _writeRegistrationDetailsToTopic {
    my ($session, $data, $meta, $text) = @_;

    ASSERT($data->{WikiName}) if DEBUG;

    # TODO - there should be some way of overwriting meta without
    # blatting the content.

    $text ||= "%SPLIT%\n\t* %KEY%: %VALUE%%SPLIT%\n\t* Set ALLOWTOPICCHANGE = %WIKIUSERNAME%\n";
    my ( $before, $repeat, $after ) = split( /%SPLIT%/, $text );

    my $log;
    my $addText;
    if ($meta->get('FORM')) {
        ( $meta, $addText ) = _getRegFormAsTopicForm( $meta, $data );
        $log = 'Using Form Fields';
    } else {
        $addText = _getRegFormAsTopicContent( $data );
        $log = 'Using Bullet Fields';
    }
    $text = $before . $addText . $after;

    my $userName = $data->{remoteUser} || $data->{WikiName};
    my $user = $session->{users}->findUser( $userName );
    $text = $session->expandVariablesOnTopicCreation( $text, $user );

    $meta->put( 'TOPICPARENT', { 'name' => $TWiki::cfg{UsersTopicName}} );

    my $agent = $session->{users}->findUser( $twikiRegistrationAgent,
                                             $twikiRegistrationAgent);

    $session->{store}->saveTopic($agent, $data->{webName},
                                 $data->{WikiName}, $text, $meta );
    return $log;
}

# Caveats
# Ideally we'd put any fields mentioned on the registration form
# but not in the UserForm into the text. However there is no API to 
# through which to determine what is legal. So I can't

sub _getRegFormAsTopicForm {
    my ( $meta, $data ) = @_;
    return _getKeyValuePairsAsTopicForm($meta, @{$data->{form}});
}

# SMELL
# problem now is that the fields are ordered by the HTML form
# not by the order of the template form definition. Hence they are arguably in the wrong order.
sub _getKeyValuePairsAsTopicForm {
    my ($meta, @fieldArray)     = @_;   # SMELL - why is this an array? surely a hash is better?
    my $leftoverText = '';
    foreach my $fd (@fieldArray) {
        my $name  = $fd->{name};
        my $value = $fd->{value};
        my $title = $name;
        $title =~ s/([a-z0-9])([A-Z0-9])/$1 $2/go;    # Spaced

        #### SMELL I want to write:
        #     if (field is on form) {
        #	$meta->putKeyed('FIELD',
        # { 'name' => $name, 'value' => $value, 'title' =>$title});
        #     } else {
        # accumulate it in $leftoverText
        #     }
        #### but SMELL instead we write this ugliness
        # not least because although I can see a key with a value, I can't distinguish those one without one.
        # from no key at all.
        if ( $name eq 'Email' ) {
            # Don't paste the e-mail address in the user topic (prevent e-mail harvesting)
            # $leftoverText .= "\t* E-mail: $value\n";
        } else {
            $meta->putKeyed( 'FIELD',
                        { name => $name, value => $value, title => $title } );
        }
        #### end workaround SMELL
    }
    return ( $meta, $leftoverText );
}

#Registers a user using the old bullet field code
sub _getRegFormAsTopicContent {
    my $data = shift;
    my $text;
    foreach my $fd ( @{ $data->{form} } ) {
        my $name  = $fd->{name};
        my $title = $name;
        $title =~ s/([a-z0-9])([A-Z0-9])/$1 $2/go;    # Spaced
        my $value = $fd->{value};
        $value =~ s/[\n\r]//go;
        $text .= "\t* $title\: $value\n";    # SMELL - tabs but stored as tabs.
    }
    return $text;
}

#Sends to both the WIKIWEBMASTER and the USER notice of the registration
#emails both the admin 'registernotifyadmin' and the user 'registernotify', 
#in separate emails so they both get targeted information (and no password to the admin).
sub _emailRegistrationConfirmations {
    my ( $session, $data ) = @_;

    my $skin = $session->getSkin();
    my $template =
      $session->{templates}->readTemplate( 'registernotify', $skin );
    my $email =
      _buildConfirmationEmail( $session,
                               $data,
                               $template,
                               $TWiki::cfg{Register}{HidePasswd}
                             );

    my $err = 
      $session->{net}->sendEmail( $email);

    # SMELL: This needs to log to tell the admin.
    if ( $err ) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $data->{WikiName},
                                    def => 'send_mail_error',
                                    params => $err );
    }

    # Furthermore it would be better if it returned
    # A template to give to the user.
    $template =
      $session->{templates}->readTemplate( 'registernotifyadmin', $skin );
    $email =
      _buildConfirmationEmail( $session,
                               $data,
                               $template,
                               1 );

    $err = $session->{net}->sendEmail( $email );
    if ( $err ) {
        throw TWiki::OopsException( 'attention',
                                    def => 'send_mail_error',
                                    web => $data->{webName},
                                    topic => $data->{WikiName},
                                    params => $err );
    }
}

#The template dictates the to: field
sub _buildConfirmationEmail {
    my ( $session, $data, $templateText, $hidePassword ) = @_;

    $data->{Name} ||= $data->{WikiName};
    $templateText =~ s/%FIRSTLASTNAME%/$data->{Name}/go;
    $templateText =~ s/%WIKINAME%/$data->{WikiName}/go;
    $templateText =~ s/%EMAILADDRESS%/$data->{Email}/go;

    my ( $before, $after ) = split( /%FORMDATA%/, $templateText );
    foreach my $fd ( @{ $data->{form} } ) {
        my $name  = $fd->{name};
        my $value = $fd->{value};
        if ( ( $name eq 'Password' ) && ($hidePassword) ) {
            $value = '*******';
        }
        if ( $name ne 'Confirm' ) {
            $before .= $b.' '.$name.': '.$value."\n";
        }
    }
    $templateText = $before.$after;
    $templateText = $session->handleCommonTags
      ( $templateText, $data->{webName}, $data->{WikiName} );
    $templateText =~ s/( ?) *<\/?(nop|noautolink)\/?>\n?/$1/gois;
    # remove <nop> and <noautolink> tags

    return $templateText;
}

# Returns a url if there is a problem.
sub _validateRegistration {
    my ( $session, $data, $query, $topic ) = @_;

    # DELETED CHECK: check for wikiName field.

    unless ( $data->{form} && ( $#{ $data->{form} } > 1 ) ) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $topic,
                                    def => 'missing_fields',
                                    params => '' );
    }

    if($session->{store}->topicExists( $data->{webName}, $data->{WikiName} )) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $topic,
                                    def => 'already_exists',
                                    params => $data->{WikiName} );
    }

    if ($session->{users}->lookupLoginName($data->{LoginName})) {
      throw TWiki::OopsException( 'attention',
				  web => $data->{webName},
				  topic => $topic,
				  def => 'already_exists',
				  params => $data->{LoginName} );
    }

    my $user = $session->{users}->findUser( $data->{LoginName}, undef, 1 );
    if ( $user && $user->passwordExists() ) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $topic,
                                    def => 'already_exists',
                                    params => $data->{LoginName} );
    }

    # check if required fields are filled in
    my @missing = ();
    foreach my $fd ( @{ $data->{form} } ) {
        if ( ( $fd->{required} ) && ( !$fd->{value} ) ) {
            push( @missing, $fd->{name} );
        }
    }

    if( scalar( @missing )) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $topic,
                                    def => 'missing_fields',
                                    params => join(', ', @missing) );
    }

    # check if WikiName is a WikiName
    if ( !TWiki::isValidWikiWord( $data->{WikiName} ) ) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $topic,
                                    def => 'bad_wikiname' );
    }

    if (exists $data->{PasswordA}) {
        # check if passwords are identical
        if ( $data->{passwordA} ne $data->{passwordB} ) {
            throw TWiki::OopsException( 'attention',
                                        web => $data->{webName},
                                        topic => $topic,
                                        def => 'password_mismatch' );
        }
    }

    # check valid email address
    if ( $data->{Email} !~ $TWiki::regex{emailAddrRegex} ) {
        throw TWiki::OopsException( 'attention',
                                    web => $data->{webName},
                                    topic => $topic,
                                    def => 'bad_email',
                                    params => $data->{Email} );
    }
}

=pod

 generate user entry
 If a password exists (either in Data{PasswordA} or data{CryptPassword}, use it.
 Otherwise generate a random one, and store it back in the user record.

=cut

#SMELL - when should they get notified of the password?
sub _addUserToPasswordSystem {
    my( $session, $p ) = @_;

    my $user = $session->{users}->findUser($p->{LoginName}, $p->{WikiName});
    if ($user && $user->passwordExists()) {
        $user->removePassword();
    }

    my $success;
    if ($p->{CryptPassword})  {
        throw Error::Simple( 'No API to install crypted password' );
        #	$success = $session->{users}->installCryptedPassword($p->{LoginName},
        #						   $p->{CryptPassword});
    }
    my $password = $p->{Password};
    unless ($password) {
        $password = TWiki::User::randomPassword();
        $session->writeWarning('No password specified for '.$p->{LoginName}.' - using random='.$password);
    }
    if( $user->addPassword( $password )) {
        return 1;
    }
    return 0;
}

# sends $p->{template} to $p->{Email} with a bunch of substitutions.
sub _sendEmail {
    my( $session, $template, $p ) = @_;

    my $text = $session->{templates}->readTemplate( $template );
    $p->{Introduction} ||= '';
    $p->{Name} ||= $p->{WikiName};
    $text =~ s/%LOGINNAME%/$p->{LoginName}/geo;
    $text =~ s/%FIRSTLASTNAME%/$p->{WikiName}/go;
    $text =~ s/%WIKINAME%/$p->{Name}/geo;
    $text =~ s/%EMAILADDRESS%/$p->{Email}/go;
    $text =~ s/%INTRODUCTION%/$p->{Introduction}/go;
    $text =~ s/%VERIFICATIONCODE%/$p->{VerificationCode}/go;
    $text =~ s/%PASSWORD%/$p->{PasswordA}/go;
    $text = $session->handleCommonTags( $text, $p->{webName}, $p->{WikiName} );
    return $session->{net}->sendEmail($text);
}

# | In | reference to the users data structure |
# | Out | none |
# dies if fails to store
sub _putRegDetailsByCode {
    my ($data, $tmpDir) = @_;

    my $file = _verificationCodeFilename( $data->{VerificationCode}, $tmpDir );
    unless( -d $tmpDir ) {
        require File::Path;
        File::Path::mkpath( $tmpDir ) || throw Error::Simple( $! );
    }
    open( F, ">$file" ) or throw Error::Simple( 'Failed to open file: '.$! );
    print F '# Verification code',"\n";
    # SMELL: wierd jiggery-pokery required, otherwise Data::Dumper screws
    # up the form fields when it saves. Perl bug? Probably to do with
    # chucking around arrays, instead of references to them.
    my $form = $data->{form};
    $data->{form} = undef;
    print F Dumper( $data, $form );
    $data->{form} = $form;
    close( F );
}

sub _verificationCodeFilename {
    my ( $code, $tmpDir ) = @_;
    ASSERT( $code ) if DEBUG;
    my $file = $tmpDir . '/'.$code;
    $file = TWiki::Sandbox::normalizeFileName( $file );
    return $file;
}

#| In | activation code |
#| Out | reference to user the user's data structure
#Dies if fails to get
sub _getRegDetailsByCode {
    my ( $code, $tmpDir ) = @_;
    my $file = _verificationCodeFilename( $code, $tmpDir );
    use vars qw( $VAR1 $VAR2 );
    do $file;
    $VAR1->{form} = $VAR2 if $VAR2;
    throw Error::Simple( 'Bad activation code '.$code ) if $!;
    return $VAR1;
}

# Redirects user and dies if cannot load.
# Dies if loads and does not match.
# Returns the users data hash if succeeded.
# Returns () if not found.
sub _reloadUserContext {
    my( $code, $tmpDir ) = @_;

    ASSERT($code) if DEBUG;

    my $verificationFilename = _verificationCodeFilename( $code, $tmpDir );
    unless (-f $verificationFilename){
        throw TWiki::OopsException( 'attention',
                                    def => 'bad_ver_code',
                                    params => [ $code, '.' ] );
    }

    my $data = _getRegDetailsByCode($code, $tmpDir);
    my $error = _validateUserContext($code, $tmpDir);

    if( $error ) {
        throw TWiki::OopsException( 'attention',
                                    def => 'bad_ver_code',
                                    params => [ $code, $error ] );
    }

    return $data;
}

# Returns undef if no problem, else returns what's wrong
sub _validateUserContext {
    my ($code, $tmpDir ) = @_;
    my ($name) = $code =~ /^([^.]+)\./;
    my %data   = %{ _getRegDetailsByCode( $code, $tmpDir ) };    #SMELL - expensive?
    return 'Invalid activation code' unless $code eq $data{VerificationCode};
    return 'Name in activation code does not match'
      unless $name eq $data{WikiName};
    return;
}

#SMELL: 'Context'?
sub _deleteUserContext {
    my $code = shift;
    my $tmpDir = TWiki::Sandbox::untaintUnchecked( shift );
    $code =~ s/^([^.]+)\.//;
    my $name = TWiki::Sandbox::untaintUnchecked( $1 );

    foreach (<$tmpDir/$name.*>) {
        unlink( TWiki::Sandbox::untaintUnchecked( $_ ));
    }
    # ^^ In case a user registered twice, etc...
}

sub _getDataFromQuery {
    my $query = shift;
    # get all parameters from the form
    my $data = {};
    foreach( $query->param() ) {
        if (/^(Twk)([0-9])(.*)/) {
            my $form = {};
            $form->{required} = $2;
            my $name = $3;
            my $value = $query->param($1.$2.$3);
            $form->{name} = $name;
            $form->{value} = $value;
            if ( $name eq 'Password' ) {
                #TODO: get rid of this; move to removals and generalise.
                $data->{passwordA} = $value;
            } elsif ( $name eq 'Confirm' ) {
                $data->{passwordB} = $value;
            } elsif( $name eq 'LoginName' ) {
                # Sanitise login name
                $value =~ s/$TWiki::cfg{NameFilter}//go;
            }

            # 'WikiName' omitted because they can't
            # change it, and 'Confirm' is a duplicate
            push( @{$data->{form}}, $form )
              unless ($name eq 'WikiName' || $name eq 'Confirm');

            $data->{$name} = $value;
        }
    }
    $data->{WikiName} = TWiki::Sandbox::untaintUnchecked($data->{WikiName});
    $data->{LoginName} ||= $data->{WikiName}
      unless $TWiki::cfg{Register}{AllowLoginName};
    if( !$data->{Name} &&
          defined $data->{FirstName} && defined $data->{LastName}) {
        $data->{Name} = $data->{FirstName}.' '.$data->{LastName};
    }
    return $data;
}

# We delete only the field in the {form} array - this leaves
# the original value still there should  we want it i.e. it must
# still be available via $row->{$key} even though $row-{form}[]
# does not contain it
sub _deleteKey {
    my ($row, $key) = @_;
    my @formArray = @{$row->{form}};

    foreach my $index (0..$#formArray) {
        my $a = $formArray[$index];
        my $name = $a->{name};
        my $value = $a->{value};
        if ($name eq $key) {
            splice (@{$row->{form}}, $index, 1);
            last;
        }
    }
};

sub _purgeKeys {
    my $data = shift;

    ASSERT($data) if DEBUG;

    _deleteKey($data, 'Photo');
    _deleteKey($data, 'WikiName');
    _deleteKey($data, 'LoginName');
    _deleteKey($data, 'Password');
}

1;
