# @(#)$Id: Credentials.pm 1165 2012-04-03 10:40:39Z pjf $

package CatalystX::Usul::Model::Config::Credentials;

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

use CatalystX::Usul::Functions;
use CatalystX::Usul::Schema;
use MRO::Compat;
use TryCatch;

__PACKAGE__->config
   ( create_msg_key         => 'Credentials [_1]/[_2] created',
     delete_msg_key         => 'Credentials [_1]/[_2] deleted',
     keys_attr              => q(credentials),
     typelist               => {},
     schema_class           => q(CatalystX::Usul::Schema),
     update_msg_key         => 'Credentials [_1]/[_2] updated' );

__PACKAGE__->mk_accessors( qw(schema_class) );

sub create_or_update {
   my ($self, $ns, $args) = @_; my $req = $self->context->req; my $v;

   if (defined ($v = $self->query_value( q(password) ))) {
      $v = $self->schema_class->encrypt( $self->_seed, $v );
      $req->params->{password} = q(encrypt=).$v;
   }

   $self->next::method( $ns, $args );
   return;
}

sub credentials_form {
   my ($self, $ns, $acct) = @_; my ($config_obj, $def, $id);

   try        { $config_obj = $self->list( $ns, $acct ) }
   catch ($e) { return $self->add_error( $e ) }

   my $creds  = $config_obj->list;
   my $fields = $config_obj->result;
   my $s      = $self->context->stash;
   my $form   = $s->{form}->{name};
   my $spaces = [ sort keys %{ $s->{ $self->ns_key } } ];

   unshift @{ $creds  }, q(), $s->{newtag};
   unshift @{ $spaces }, q(), q(default);

   if ($fields->password and $fields->password =~ m{ \A encrypt= (.+) \z }mx) {
      $fields->password( $self->schema_class->decrypt( $self->_seed, $1 ) );
   }

   $self->clear_form(   { firstfld => $form.q(.credentials) } );
   $self->add_field(    { default  => $ns,
                          id       => q(config.).$self->ns_key,
                          stepno   => 0,
                          values   => $spaces } );

   if ($ns) {
      $self->add_field( { default  => $acct,
                          id       => $form.q(.credentials),
                          values   => $creds } );
   }

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

   ($ns and $acct and is_member $acct, $creds) or return;

   if ($acct eq $s->{newtag}) {
      $self->add_buttons( qw(Insert) ); $def = q(); $id = $form.'.nameNew';
   }
   else {
      $self->add_buttons( qw(Save Delete) ); $def = $acct; $id = $form.'.name';
   }

   $self->add_field(    { ajaxid  => $form.'.name',
                          default => $def,
                          id      => $id,
                          name    => q(name) } );
   $self->add_field(    { ajaxid  => $form.'.driver',
                          default => $fields->driver } );
   $self->add_field(    { ajaxid  => $form.'.host',
                          default => $fields->host } );
   $self->add_field(    { ajaxid  => $form.'.port',
                          default => $fields->port } );
   $self->add_field(    { ajaxid  => $form.'.user',
                          default => $fields->user } );
   $self->add_field(    { default => $fields->password,
                          id      => $form.'.password' } );
   $self->group_fields( { id      => $form.'.edit' } );
   return;
}

# Private methods

sub _seed {
   my $self = shift; my ($args, $path);

   $path = $self->catfile( $self->ctrldir, $self->prefix.q(.txt) );
   $args = { seed => $self->secret };
   $args->{data} = $self->io( $path )->all if (-f $path);
   return $args;
}

1;

__END__

=pod

=head1 Name

CatalystX::Usul::Model::Config::Credentials - Database connection definitions

=head1 Version

0.6.$Revision: 1165 $

=head1 Synopsis

   # The constructor is called by Catalyst at startup

=head1 Description

Maintains database connection strings

Defines the language independent attributes; I<driver>, I<host>,
I<password>, I<port> and I<user> for the I<credentials> element.
Returns a L<CatalystX::Usul::Model::Config> object

=head1 Subroutines/Methods

=head2 new

Defined the I<ctrldir> attribute

=head2 create_or_update

   $c->model( q(Config::Credentials) )->create_or_update( $stash, $args );

Encrypts the C<< $args->{req}->params->{password} >> attribute by calling
C<encrypt> in L<CatalystX::Usul::Schema>. Then calls method of same
name in L<CatalystX::Usul::Model::Config>

=head2 credentials_form

   $c->model( q(Config::Credentials) )->credentials_form( $stash );

Stuffs the stash with the data to build the credentials maintenance form

=head1 Diagnostics

None

=head1 Configuration and Environment

None

=head1 Dependencies

=over 3

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

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

=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 License and Copyright

Copyright (c) 2008 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: