# @(#)$Id: Users.pm 1139 2012-03-28 23:49:18Z pjf $

package CatalystX::Usul::Model::Users;

use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.5.%d', q$Rev: 1139 $ =~ /\d+/gmx );
use parent qw(CatalystX::Usul::Model
              CatalystX::Usul::Email CatalystX::Usul::Captcha);

use CatalystX::Usul::Constants;
use CatalystX::Usul::Functions qw(create_token is_member throw);
use CatalystX::Usul::Shells;
use CatalystX::Usul::Time;
use MRO::Compat;
use TryCatch;

__PACKAGE__->config( activate_path       => q(entrance/activate_account),
                     app_name            => NUL,
                     email_content_type  => q(text/html),
                     email_template      => q(new_account.tt),
                     rprtdir             => q(root/reports),
                     sessdir             => q(hist),
                     shells_attributes   => {},
                     shells_class        => q(CatalystX::Usul::Shells),
                     template_attributes => {}, );

__PACKAGE__->mk_accessors( qw(activate_path app_name auth_realms
                              domain_cache email_content_type
                              email_template fs_model
                              register_queue_path roles rprtdir
                              sessdir shells shells_attributes
                              shells_class template_attributes) );

sub COMPONENT {
   my ($class, $app, $config) = @_; my $ac = $app->config || {};

   my $rprtdir = $class->catdir( $ac->{vardir}, $class->config->{rprtdir} );
   my $sessdir = $class->catdir( $ac->{vardir}, $class->config->{sessdir} );

   $config->{app_name} ||= $ac->{name   };
   $config->{rprtdir } ||= $ac->{rprtdir} || $rprtdir;
   $config->{sessdir } ||= $ac->{sessdir} || $sessdir;

   my $new = $class->next::method( $app, $config );

   $new->ensure_class_loaded( $new->domain_class );
   $new->domain_cache( { dirty => TRUE } );
   return $new;
}

sub build_per_context_instance {
   my ($self, $c, @rest) = @_; my $class;

   my $clone = $self->next::method( $c, @rest );
   my $attrs = { %{ $clone->domain_attributes || {} },
                 sessdir => $clone->sessdir,
                 cache   => $clone->domain_cache, };
   my $dm    = $clone->domain_model( $clone->domain_class->new( $c, $attrs ) );

   $clone->fs_model( $c->model( q(FileSystem) ) );
   $attrs = { %{ $clone->shells_attributes || {} }, };
   $clone->shells( $clone->shells_class->new( $c, $attrs ) );
   return $clone;
}

sub activate_account {
   my ($self, $key) = @_;

   my $path = $self->io( $self->catfile( $self->sessdir, $key ) );

   $path->is_file
      or return $self->add_error_msg( 'Path [_1] not found', $path );

   my $user = $path->chomp->lock->getline
      or return $self->add_error_msg( 'Path [_1] contained no data', $path );

   $path->unlink;

   try        { $self->domain_model->activate_account( $user ) }
   catch ($e) { return $self->add_error( $e ) }

   $self->add_result_msg( 'Account [_1] activated', $user );
   return;
}

sub authenticate {
   # Try to authenticate the supplied user info with each defined realm
   my $self = shift; my $c = $self->context; my $s = $c->stash;

   my ($msg, $user_ref, $wanted); $self->scrubbing( TRUE );

   my $realm = $self->query_value( q(realm)  );
   my $user  = $self->query_value( q(user)   );
   my $pass  = $self->query_value( q(passwd) );

   unless ($user and $pass) {
      $s->{user} = q(unknown); throw 'Id and/or password not set';
   }

   my $userinfo = { username => $user, password => $pass };
   my @realms   = $realm ? ( $realm ) : sort keys %{ $c->auth_realms };

   for $realm (@realms) {
      $realm eq q(default) and next;
      ($user_ref = $c->find_user( $userinfo, $realm )
       and $user_ref->username eq $user) or next;
      $c->authenticate( $userinfo, $realm ) or next;

      $msg = 'User [_1] logged in to realm [_2]';
      $self->log_info( $self->loc( $msg, $user, $realm ) );

      if ($c->can( q(session) )) {
         $c->session->{last_visit} = time;
         $s->{wanted} = $c->session->{wanted};
         $c->session->{wanted} = NUL;
      }

      $s->{wanted} ||= $c->controller( q(Root) )->default_namespace;
      $s->{realm }   = $realm;
      return;
   }

   $c->logout;
   $s->{override} = TRUE;
   $s->{user    } = q(unknown);
   $c->can( q(session) ) and $c->session_expire_key( __user => FALSE );
   $msg = 'Login id ([_1]) and password not recognised';
   throw error => $msg, args => [ $user ];
   return; # Never reached
}

sub authentication_form {
   my ($self, $user) = @_; my $s = $self->context->stash;

   my $form = $s->{form}->{name}; $s->{pwidth} += 3;

   ($user ||= $s->{user}) =~ s{ \A unknown \z }{}msx;

   $self->clear_form ( { firstfld => $form.q(.user),
                         heading  => $self->loc( $form.q(.header) ) } );
   $self->add_field  ( { default  => $user, id => $form.q(.user) } );
   $self->add_field  ( { id       => $form.q(.passwd) } );
   $self->add_field  ( { id       => $form.q(.login_text) } );
   $self->add_buttons( qw(Login) );
   return;
}

sub change_password {
   my $self = shift; $self->scrubbing( TRUE );
   my @flds = ( qw(user oldPass newPass1 newPass2) );
   my $flds = $self->check_form( $self->query_value_by_fields( @flds ) );

   $self->domain_model->change_password
      ( $flds->{user}, $flds->{oldPass}, $flds->{newPass1} );
   $self->add_result_msg( 'User [_1] password changed', $flds->{user} );
   return TRUE;
}

sub change_password_form {
   my ($self, $user) = @_;

   my $s      = $self->context->stash; $s->{pwidth} -= 10;
   my $form   = $s->{form}->{name};
   my $realm  = $s->{user_realm};
   my $values = [ q(), sort keys %{ $self->auth_realms } ];

   ($user ||= $s->{user}) =~ s{ unknown }{}mx;

   $self->clear_form( { firstfld => $form.q(.user) } );
   $self->add_field ( { default  => $realm,
                        id       => $form.q(.realm),
                        values   => $values } );

   if ($realm) {
      $self->add_field  ( { ajaxid  => $form.q(.user), default => $user } );
      $self->add_field  ( { id      => $form.q(.oldPass)  } );
      $self->add_field  ( { ajaxid  => $form.q(.newPass1) } );
      $self->add_buttons( qw(Set) );
   }

   my $id = $form.($realm && $user ? q(.select) : q(.selectUnknown));

   $self->group_fields( { id => $id } );
   return;
}

sub create_or_update {
   my $self   = shift;
   my @fields = ( qw(username profile first_name last_name
                     location work_phone email_address home_phone
                     project homedir shell populate) );
   my $fields = $self->query_value_by_fields( @fields );
   my $user   = $fields->{username} or throw 'User not specified';
   my $method = $self->is_user( $user ) ? q(update) : q(create);
   my $model  = $self->domain_model;

   $fields->{active       }   = TRUE;
   $fields->{alias_name   }   = $fields->{username};
   $fields->{first_name   }   = ucfirst $fields->{first_name};
   $fields->{last_name    }   = ucfirst $fields->{last_name };
   $fields->{email_address} ||= $model->make_email_address( $user );
   $fields->{owner        }   = $self->context->stash->{user};
   $fields->{comment      }   = [ 'Local user' ];
   $fields->{recipients   }   = [ $fields->{email_address} ];
   $fields                    = $self->check_form( $fields );

   $self->add_result_msg( $model->$method( $fields ), $user );
   return $user;
}

sub delete {
   my $self = shift;
   my $user = $self->query_value( q(user) ) or throw 'User not specified';

   $self->add_result_msg( $self->domain_model->delete( $user ), $user );
   return TRUE;
}

sub find_user {
   my ($self, @rest) = @_; return $self->domain_model->find_user( @rest );
}

sub get_features {
   my ($self, @rest) = @_; return $self->domain_model->get_features( @rest );
}

sub get_primary_rid {
   my ($self, $user) = @_; return $self->domain_model->get_primary_rid( $user);
}

sub get_users_by_rid {
   my ($self, $rid) = @_; return $self->domain_model->get_users_by_rid( $rid );
}

sub is_user {
   my ($self, $user) = @_; return $self->domain_model->is_user( $user );
}

sub profiles {
   return shift->domain_model->profiles;
}

sub purge {
   my $self  = shift;
   my $nrows = $self->query_value( q(__nrows) )
      or throw 'Account not specified';

   for my $rno (0 .. $nrows - 1) {
      my $user = $self->query_value( q(select).$rno ) or next;
      my $msg  = $self->domain_model->delete( $user );

      $self->add_result_msg( $msg, $user );
   }

   return TRUE;
}

sub register {
   my ($self, $path) = @_; my $c = $self->context; my $s = $c->stash;

   my $code = $self->query_value( q(security) ); my $fields;

   $self->validate_captcha( $code )
      or throw error => 'Security code [_1] incorrect', args => [ $code ];

   unless ($path) {
      my @fields = ( qw(email_address first_name last_name newPass1 newPass2
                        work_phone home_phone location project) );

      $fields             = $self->query_value_by_fields( @fields );
      $fields->{active  } = FALSE;
      $fields->{password} = $fields->{newPass1};
      $fields->{profile } = $s->{register}->{profile};
   }

   if (not $path and $self->register_queue_path) {
      $self->_register_write_queue( $fields );
      # TODO:  Add email message to authorising authority
      $self->add_result_msg( 'Awaiting authorisation', $fields->{email} );
      return TRUE;
   }

   try {
      $self->lock->set( k => q(register_user) );
      $path and $fields = $self->_register_read_queue( $path );
      $fields = $self->_register_validation( $fields );
      $self->domain_model->create( $fields );
      $self->_register_verification_email( $fields );
      $self->add_result_msg( 'User [_1] account created', $fields->{username} );
      $self->lock->reset( k => q(register_user) );
   }
   catch ($e) { $self->lock->reset( k => q(register_user) ); throw $e }

   return TRUE;
}

sub register_form {
   my ($self, $captcha_action) = @_;

   my $c    = $self->context;
   my $form = $c->stash->{form}->{name};
   my $uri  = $c->uri_for_action( $captcha_action );

   $self->clear_form  ( { firstfld => $form.q(.first_name)    } );
   $self->add_field   ( { ajaxid   => $form.q(.first_name)    } );
   $self->add_field   ( { ajaxid   => $form.q(.last_name)     } );
   $self->add_field   ( { ajaxid   => $form.q(.email_address) } );
   $self->add_field   ( { ajaxid   => $form.q(.newPass1)      } );
   $self->add_field   ( { id       => $form.q(.work_phone)    } );
   $self->add_field   ( { id       => $form.q(.location)      } );
   $self->add_field   ( { id       => $form.q(.project)       } );
   $self->add_field   ( { id       => $form.q(.home_phone)    } );
   $self->add_field   ( { name     => $form.q(.captcha), text => $uri } );
   $self->add_field   ( { ajaxid   => $form.q(.security)      } );
   $self->group_fields( { id       => $form.q(.legend)        } );
   $self->add_buttons ( qw(Insert) );
   return;
}

sub retrieve {
   my ($self, @rest) = @_; return $self->domain_model->retrieve( @rest );
}

sub set_password {
   my $self      = shift;
   my $user      = $self->query_value( q(user) ) or throw 'User not specified';
   my $ptype     = $self->query_value( q(p_type) ) || 1;
   my $password  = $self->query_value( q(p_default) );
   my $encrypted = FALSE;

   if ($ptype == 4) {
      $password = $self->query_value( q(p_generated) );
   }
   elsif ($ptype == 3) {
      my $p_word1 = $self->query_value( q(p_word1) );
      my $p_word2 = $self->query_value( q(p_word2) );

      ($p_word1 and $p_word2) or throw 'Passwords not specified';

      $p_word1 eq $p_word2 or throw 'Passwords are not the same';

      $password = $p_word1;
   }
   elsif ($ptype == 2) {
      $password = q(*).$self->query_value( q(p_value) ).q(*); $encrypted = TRUE;
   }

   $self->domain_model->set_password( $user, $password, $encrypted );
   $self->add_result_msg( 'User [_1] password set', $user );
   return TRUE;
}

sub user_fill {
   my $self  = shift;
   my $s     = $self->context->stash;
   my $fill  = $s->{fill} = {};
   my $first = $fill->{first_name} = $self->query_value( q(first_name) );
   my $last  = $fill->{last_name } = $self->query_value( q(last_name) );
   my $model = $self->domain_model;

   $fill->{email} = $model->make_email_address( $first.q(.).$last );
   $s->{override} = TRUE;
   return TRUE;
}

sub user_manager_form {
   my ($self, $user) = @_; my $s = $self->context->stash; my $data = {};

   # Retrieve data from models
   try        { $data = $self->_get_user_data( $user ) }
   catch ($e) { return $self->add_error( $e ) }

   # Add elements to form
   my $form   = $s->{form}->{name};
   my $realm  = $s->{user_realm};
   my $realms = [ NUL, sort keys %{ $self->auth_realms } ];

   $self->clear_form( { firstfld => $form.($realm ? '.user' : '.realm') } );
   $self->add_field ( { default  => $realm,
                        id       => $form.'.realm',
                        values   => $realms } );

   if ($realm) {
      $self->add_field( { default => $user,
                          id      => $form.'.user',
                          values  => $data->{users} } );

      if ($user and $user eq $s->{newtag}) {
         $self->add_field( { default => $data->{profile_name},
                             id      => $form.'.profile',
                             labels  => $data->{labels},
                             values  => $data->{profiles} } );
      }
      else {
         $self->add_hidden( q(profile), $data->{profile_name} );

         if ($data->{role}) {
            my $text  = $self->loc( $form.'.pgroup' );
               $text .= ($data->{labels}->{ $data->{role} } || NUL);
               $text .= ' ('.$data->{role}.') ';

            $self->add_field( { id => $form.'.pgroup', text => $text } );
         }
      }
   }

   $self->group_fields( { id => $form.'.select' } );

   (not $user or lc $user eq q(all)) and return;
   $user eq $s->{newtag} and not $data->{profile_name} and return;

   $self->add_field( { default => $data->{first_name},
                       id      => $form.'.first_name' } );
   $self->add_field( { default => $data->{last_name},
                       id      => $form.'.last_name'  } );

   if ($user eq $s->{newtag}) { # Create new account
      if ($data->{name}) {
         $self->add_field( { default => $data->{name},
                             id      => $form.'.username' } );
         $self->add_buttons( qw(Insert) );
      }
      else {
         $self->add_field( { id => $form.'.afill' } );
         $self->add_buttons( qw(Fill) );
      }
   }
   else { # Edit existing account
      $self->add_hidden ( q(username), $user );
      $self->add_buttons( qw(Save Delete) );
   }

   unless ($data->{name}) {
      $self->group_fields( { id => $form.'.edit' } ); return;
   }

   $self->add_field( { default => $data->{email},
                       id      => $form.'.email_address' } );
   $self->add_field( { default => $data->{location},
                       id      => $form.'.location'      } );
   $self->add_field( { default => $data->{work_tel},
                       id      => $form.'.work_phone'    } );
   $self->add_field( { default => $data->{home_tel},
                       id      => $form.'.home_phone'    } );
   $self->add_field( { default => $data->{project},
                       id      => $form.'.project'       } );

   if ($self->supports( qw(fields homedir) )
       and $data->{homedir} ne $data->{common_home}) {
      $user eq $s->{newtag}
         and $self->add_field( { label => SPC, id => $form.'.populate' } );

      $self->add_field( { default  => $data->{homedir},
                          id       => $form.'.homedir',
                          readonly => $user eq $s->{newtag} ? 0 : 1 } );
   }

   defined $data->{shells}
      and $self->add_field( { default => $data->{shell},
                              id      => $form.'.shell',
                              values  => $data->{shells} } );

   $self->group_fields( { id => $form.'.edit' } );
   return;
}

sub user_report {
   my ($self, $type) = @_;
   my $s     = $self->context->stash;
   my $stamp = time2str( '%Y%m%d%H%M' );
   my $path  = $self->catfile( $self->rprtdir, 'userReport_'.$stamp.'.csv' );

   $self->add_result( $self->domain_model->user_report( { debug => $s->{debug},
                                                          path  => $path,
                                                          type  => $type } ) );
   return TRUE;
}

sub user_report_form {
   my ($self, $id) = @_; my ($data, $dir, $key, $pat, $ref);

   my $s     = $self->context->stash; $s->{pwidth} -= 10;
   my $form  = $s->{form}->{name};
   my $realm = $s->{user_realm};

   unless ($dir = $self->query_value( q(dir) )) {
      $dir = $self->{rprtdir}; $pat = q(userReport*);
      $key = sub { return (split m{ \. }mx, (split m{ _ }mx, $_[0])[1])[0] };
   }
   else { $pat = q(.*); $key = undef }

   $self->clear_form;

   if ($id) {
      my $path = $self->catfile( $dir, 'userReport_'.$id.'.csv' );

      $self->add_field( { path    => $path, id => $form.'.file' } );
      $self->add_field( { id      => $form.'.keynote' } );
      $self->add_buttons( qw(List Purge) );
   }
   else {
      my $values = [ q(), sort keys %{ $self->auth_realms } ];

      $self->add_field( { default => $realm,
                          id      => $form.'.realm',
                          values  => $values } );
      $self->add_buttons( qw(Execute) );
      $ref  = { action   => $s->{form}->{action},
                assets   => $s->{assets},
                dir      => $dir,
                make_key => $key,
                pattern  => qr{ $pat }mx };

      try {
         $data = $self->fs_model->list_subdirectory( $ref );
         $self->add_field( { data => $data, type => q(table) } );
      }
      catch ($e) { return $self->add_error( $e ) }
   }

   my $grp_id = $form.($id ? q(.select_purge) : q(.select_view));

   $self->group_fields( { id => $grp_id } );
   return;
}

sub user_security_form {
   my ($self, $user) = @_; my $s = $self->context->stash; my $data = {};

   try        { $data = $self->_get_security_data( $user ) }
   catch ($e) { return $self->add_error( $e ) }

   my $form   = $s->{form}->{name};
   my $realm  = $s->{user_realm};
   my $realms = [ NUL, sort keys %{ $self->auth_realms } ];

   $s->{messages}->{p_default  }->{text} = $data->{passwd};
   $s->{messages}->{p_generated}->{text} = $data->{generated};
   $s->{fullname} = $data->{fullname};

   $self->clear_form  ( { firstfld => $form.($realm ? q(.user) : q(.realm)) } );
   $self->add_hidden  ( q(p_default),   $data->{passwd   } );
   $self->add_hidden  ( q(p_generated), $data->{generated} );
   $self->add_field   ( { default  => $realm,
                          id       => $form.'.realm',
                          values   => $realms } );
   $realm and
      $self->add_field( { default  => $user,
                          id       => $form.'.user',
                          values   => $data->{users} } );
   $self->group_fields( { id       => $form.'.select' } );

   ($user and $user ne $s->{newtag} and lc $user ne q(all)) or return;

   $data->{passwd} and
      $self->add_field( { id       => $form.'.p_default',
                          prompt   => $data->{labels   }->[ 0 ],
                          stepno   => $data->{prompts  }->[ 0 ],
                          text     => $data->{passwd   }, } );
   $self->add_field   ( { id       => $form.'.p_generated',
                          prompt   => $data->{labels   }->[ 3 ],
                          stepno   => $data->{prompts  }->[ 3 ],
                          text     => $data->{generated}, } );
   $self->add_field   ( { default  => $self->query_value( q(p_value) ) || NUL,
                          id       => $form.'.p_value',
                          prompt   => $data->{labels   }->[ 1 ],
                          stepno   => $data->{prompts  }->[ 1 ],
                          values   => [ qw(disabled left nologin unused) ] } );
   $self->add_field   ( { id       => $form.'.p_word1',
                          prompt   => $data->{labels   }->[ 2 ],
                          stepno   => $data->{prompts  }->[ 2 ], } );
   $self->group_fields( { id       => $form.'.set_password' } );
   $self->add_field   ( { all      => $data->{all_roles},
                          current  => $data->{roles    },
                          id       => $form.'.groups' } );
   $self->group_fields( { id       => $form.'.secondary' } );
   $self->add_buttons ( qw(Set Update) );
   return;
}

# Private methods

sub _get_security_data {
   my ($self, $user) = @_; my $s = $self->context->stash; my $data = {};

   my $user_obj = $self->domain_model->retrieve( NUL, $user );
   my @roles    = $user ? @{ $user_obj->roles } : ();

   $data->{users    } = [ NUL, @{ $user_obj->user_list } ];
   $data->{all_roles} = [ grep { not is_member $_, @roles }
                               $self->roles->get_roles( q(all) ) ];

   my $profile = $roles[ 0 ] ? $self->profiles->find( $roles[ 0 ] ) : FALSE;

   $user_obj->pgid and shift @roles;

   $data->{roles   } = \@roles;
   $data->{passwd  } = $profile ? $profile->passwd : NUL;
   $data->{fullname} = $user_obj->first_name.SPC.$user_obj->last_name;

   try {
      $self->ensure_class_loaded( q(Crypt::PassGen) );
      $data->{generated} = (Crypt::PassGen::passgen( NLETT  => 6,
                                                     NWORDS => 1 ))[ 0 ]
         or throw $Crypt::PassGen::ERRSTR;
   }
   catch ($e) { $data->{generated} = $e }

   my $form = $s->{form}->{name}; my $labels = {};

   $data->{labels  } = [ SPC.$self->loc( $form.'.set_password_option1' ),
                         SPC.$self->loc( $form.'.set_password_option2' ),
                         SPC.$self->loc( $form.'.set_password_option3' ),
                         SPC.$self->loc( $form.'.set_password_option4' ) ];

   my $p_type = $self->query_value( q(p_type) ) || 1;

   for my $i (1 .. 4) {
      $data->{prompts}->[ $i - 1 ] = { container_class => q(step_number),
                                       labels          => { $i => undef },
                                       name            => q(p_type),
                                       type            => q(radioGroup),
                                       values          => [ $i ] };
      $p_type == $i and $data->{prompts}->[ $i - 1 ]->{default} = $i;
   }

   return $data;
}

sub _get_user_data {
   my ($self, $user) = @_; my $s = $self->context->stash; my $data = {};

   $data->{profile_name} = $s->{user_params}->{profile};

   my $profile_obj   = $self->profiles->list( $data->{profile_name} );
   my $user_obj      = $self->retrieve( NUL, $user );
   my $profile       = $profile_obj->result;

   $data->{homedir } = $profile->homedir;
   $data->{project } = $profile->project;
   $data->{labels  } = $profile_obj->labels;
   $data->{profiles} = [ NUL, @{ $profile_obj->list } ];
   $data->{users   } = [ NUL, $s->{newtag}, @{ $user_obj->user_list } ];

   if ($self->supports( qw(fields shells) )) {
      my $shells_obj = $self->shells->retrieve;

      $data->{shells} = $shells_obj->shells;
      $data->{shell } = $profile->shell || $shells_obj->default || q(/bin/ksh);
   }

   $user or return $data; my $auto_fill;

   if ($user eq $s->{newtag} and $auto_fill = $s->{fill}) {
      $data->{email     } = $auto_fill->{email};
      $data->{first_name} = $auto_fill->{first_name};
      $data->{last_name } = $auto_fill->{last_name};

      try {
         $data->{name   } = $self->domain_model->get_new_user_id
            ( $data->{first_name}, $data->{last_name}, $profile->prefix );
      }
      catch ($e) { $self->add_error( $e ) }

      if ($data->{name} and $self->supports( qw(fields homedir) )) {
         $data->{common_home} = $user_obj->common_home;
         $data->{homedir} ne $data->{common_home}
            and $data->{homedir} = $self->catdir( $data->{homedir},
                                                  $data->{name} );
      }
   }
   elsif ($user ne $s->{newtag} and lc $user ne q(all)) {
      $data->{email     } = $user_obj->email_address;
      $data->{first_name} = $user_obj->first_name;
      $data->{last_name } = $user_obj->last_name;
      $data->{name      } = $user;

      $data->{home_tel  } = $user_obj->home_phone;
      $data->{location  } = $user_obj->location;
      $data->{project   } = $user_obj->project;
      $data->{role      } = shift @{ $user_obj->roles };
      $data->{shell     } = $user_obj->shell;
      $data->{work_tel  } = $user_obj->work_phone;

      if ($self->supports( qw(fields homedir) )) {
         $data->{common_home} = $user_obj->common_home;
         $data->{homedir    } = $user_obj->homedir;
      }
   }

   return $data;
}

sub _register_read_queue {
   my ($self, $path) = @_;

   -f $path or throw error => 'File [_1] not found', args  => [ $path ];

   my $fields = $self->file_dataclass_schema( { lock => TRUE } )->load( $path );
   my $io     = $self->io( $self->register_queue_path )->chomp->lock;

   $io->println( grep { not m{ \A $path \z }mx } $io->getlines ); unlink $path;

   return $fields;
}

sub _register_validation {
   my ($self, $fields) = @_; $fields = $self->check_form( $fields || {} );

   $fields->{newPass1} eq $fields->{newPass2}
      or throw 'Passwords are not the same';

   delete $fields->{newPass1}; delete $fields->{newPass2}; my $profile;

   $fields->{profile} and $profile = $self->profiles->find( $fields->{profile});

   my $prefix = $profile ? $profile->prefix : NUL;

   $fields->{username} = $self->domain_model->get_new_user_id
      ( $fields->{first_name}, $fields->{last_name}, $prefix );

   return $fields;
}

sub _register_verification_email {
   # Registration verification email
   my ($self, $fields) = @_;

   my $c       = $self->context;
   my $s       = $c->stash;
   my $key     = substr create_token, 0, 32;
   my $path    = $self->io( $self->catfile( $self->sessdir, $key ) );

   $path->println( $fields->{username} );

   my $link    = $c->uri_for_action( $self->activate_path, $key );
   my $subject = $self->loc( q(accountVerification), $self->app_name );
   my $post    = {
      attributes      => {
         charset      => $s->{encoding},
         content_type => $self->email_content_type },
      from            => q(UserRegistration@).$s->{domain},
      mailer          => $s->{mailer},
      mailer_host     => $s->{mailer_host},
      stash           => {
         %{ $fields },
         app_name     => $self->app_name,
         link         => $link,
         title        => $subject, },
      subject         => $subject,
      template        => $self->email_template,
      template_attrs  => $self->template_attributes,
      to              => $fields->{email_address}, };

   $self->add_result( $self->send_email( $post ).SPC.$fields->{email_address} );
   return;
}

sub _register_write_queue {
   my ($self, $fields) = @_;

   my $path = $self->tempname( $self->dirname( $self->register_queue_path ) );
   my $fdss = $self->file_dataclass_schema( { lock => TRUE } );

   $fdss->dump( { data => $fields, path => $path } );
   $self->io( $self->register_queue_path )->lock->appendln( $path );
   return;
}

1;

__END__

=pod

=head1 Name

CatalystX::Usul::Model::Users - Catalyst user model

=head1 Version

0.5.$Revision: 1139 $

=head1 Synopsis

   use CatalystX::Usul::Model::Users;

   my $user_obj = CatalystX::Usul::Model::Users->new( $app, $config );

=head1 Description

Forms and actions for user maintainence

=head1 Subroutines/Methods

=head2 COMPONENT

Constructor initialises these attributes

=over 3

=item app_name

Name of the application using this identity model. Prefixes the subject line
of the account activation email sent to users who create an account via the
registration method

=item rprtdir

Location in the filesystem of the user reports

=item sessdir

Location in the filesystem of used user passwords and account activation
keys

=back

=head2 build_per_context_instance

=over 3

=item fs_domain

An clone of the I<FileSystem> model used by the L</user_report_form>
method to list the available user reports

=back

=head2 activate_account

Checks for the existence of the file created by the L</register> method. If
it exists it contains the username of a recently created account. The
accounts I<active> attribute is set to true, enabling the account

=head2 authenticate

Calls L<authenticate|CatalystX::Usul::Users/authenticate> in the domain model

=head2 authentication_form

Adds fields to the stash for the login screen

=head2 authenticate_user

Authenticate the user. If another controller was wanted and the user
was forced to authenticate first, redirect the session to the
originally requested controller. This was stored in the session by the
auto method prior to redirecting to the authentication controller
which forwarded to here

=head2 change_password

Method to change the users password. Throws exceptions for field
constraint failures and if the passwords entered are not the same

=head2 change_password_form

Adds field data to the stash for the change password screen. Allows users
to change their own password

=head2 create_or_update

Method to create a new account or update an existing one. Throws exceptions
for field constraint failures. Calls methods in the subclass to do the
actual work

=head2 delete

Deletes the selected account

=head2 find_user

Calls L<find_user|CatalystX::Usul::Users/find_user> in the domain model

=head2 get_features

Delegates the call to the domain model

=head2 get_primary_rid

Returns the primary role id for the given user. Note not all storage models
support primary_role ids

=head2 get_users_by_rid

Returns the list of users that share the given primary role id

=head2 is_user

Calls L<is_user|CatalystX::Usul::Users/is_user> in the domain model

=head2 profiles

Returns the domain model's profiles object

=head2 purge

Delete the list of selected accounts

=head2 register

Create the self registered account. The account is created in an inactive
state and a confirmation email is sent

=head2 register_form

Added the fields to the stash for the self registration screen. Users can
use this screen to create their own accounts

=head2 retrieve

Calls L<retrieve|CatalystX::Usul::Users/retrieve> in the domain model

=head2 set_password

Sets the users password to a given value

=head2 user_fill

Sets the I<fill> attribute of the stash in response to clicking the
auto fill button

=head2 user_manager_form

Adds fields to the stash for the user management screen. Adminstrators can
create new accounts or modify the details of existing ones

=head2 user_report

Creates a report of the user accounts in this realm

=head2 user_report_form

View either the list of available account reports or the contents of a
specific report

=head2 user_security_form

Add fields to the stash for the security administration screen. From here
administrators can reset passwords and change the list of roles to which
the selected user belongs

=head1 Diagnostics

None

=head1 Configuration and Environment

None

=head1 Dependencies

=over 3

=item L<CatalystX::Usul::Captcha>

=item L<CatalystX::Usul::Email>

=item L<CatalystX::Usul::Model>

=item L<CatalystX::Usul::Shells>

=item L<CatalystX::Usul::Time>

=back

=head1 Incompatibilities

There are no known incompatibilities in this module

=head1 Bugs and Limitations

There are no known bugs in this module.
Please report problems to the address below.
Patches are welcome

=head1 Author

Peter Flanigan, C<< <Support at RoxSoft.co.uk> >>

=head1 Acknowledgements

Larry Wall - For the Perl programming language

=head1 License and Copyright

Copyright (c) 2011 Peter Flanigan. All rights reserved

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See L<perlartistic>

This program is distributed in the hope that it will be useful,
but WITHOUT WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE

=cut

# Local Variables:
# mode: perl
# tab-width: 3
# End: