Skip Menu |

This queue is for tickets about the Catalyst-Model-KiokuDB CPAN distribution.

Report information
The Basics
Id: 77221
Status: new
Priority: 0/
Queue: Catalyst-Model-KiokuDB

People
Owner: Nobody in particular
Requestors: j.robinson [...] shadowcat.co.uk
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: Patch: Support auto_create_user
Patch to support auto_create_user .. works for me, tho not sure where to add in tests...
Subject: 0001-Support-Auth-s-auto_create_user-in-C-A-S-Model-Kioku.patch
From b097a2ebd8e404a2baa5fcf4968794e19f24b5a2 Mon Sep 17 00:00:00 2001 From: Jess Robinson <j.robinson@shadowcat.co.uk> Date: Tue, 15 May 2012 16:07:32 +0000 Subject: [PATCH] Support Auth's "auto_create_user" in C::A::S::Model::KiokuDB --- lib/Catalyst/Authentication/Store/Model/KiokuDB.pm | 32 ++++++++++++++++++++ 1 files changed, 32 insertions(+), 0 deletions(-) diff --git a/lib/Catalyst/Authentication/Store/Model/KiokuDB.pm b/lib/Catalyst/Authentication/Store/Model/KiokuDB.pm index 1bf570f..07c5c2a 100644 --- a/lib/Catalyst/Authentication/Store/Model/KiokuDB.pm +++ b/lib/Catalyst/Authentication/Store/Model/KiokuDB.pm @@ -4,6 +4,8 @@ use Moose; use Carp; use Catalyst::Authentication::Store::Model::KiokuDB::UserWrapper; +use KiokuX::User; +use KiokuX::User::Util qw(crypt_password); use namespace::clean -except => 'meta'; @@ -58,6 +60,36 @@ sub from_session { $self->wrap($c, $user); } +sub auto_create_user { + my ($self, $authinfo, $c) = @_; + + $c->log->debug("Calling auto_create_user"); + + my $model = $self->get_model($c); + my $user = $model->can('create_user') + ? $model->create_user($authinfo) + : $self->create_user($authinfo, $model); + + if ( $user ) { + return $self->wrap($c, $user); + } else { + return; + } +} + +sub create_user { + my ($self, $authinfo, $model) = @_; + + my $user = KiokuX::User->new( + id => $authinfo->{username}, + password => crypt_password($authinfo->{password}), + ); + my $id = $user->kiokudb_object_id; + $model->store($id, $user); + + return $user; +} + sub find_user { my ( $self, $userinfo, $c ) = @_; -- 1.7.3.5