Permalink
Browse files

Checkpoint. UGLY

  • Loading branch information...
1 parent 38dd912 commit 9ff002330e5b6e46f2d05c8fa9280e9d38377e81 @jhannah committed Mar 25, 2011
Showing with 17 additions and 363 deletions.
  1. +5 −4 Makefile.PL
  2. +0 −119 lib/KiokuX/User.pm
  3. +0 −88 lib/KiokuX/User/ID.pm
  4. +0 −73 lib/KiokuX/User/Password.pm
  5. +0 −79 lib/KiokuX/User/Util.pm
  6. +12 −0 lib/KiokuX/UserAccounts.pm
View
@@ -11,11 +11,12 @@ WriteMakefile(
SIGN => 1,
PL_FILES => { },
PREREQ_PM => {
- 'Test::use::ok' => 0,
+ 'Test::use::ok' => 0,
'namespace::clean' => 0,
- 'Moose' => 0.63,
- 'KiokuDB' => 0.09,
- 'Sub::Exporter' => 0,
+ 'Moose' => 0.63,
+ 'KiokuDB' => 0.09,
+ 'Sub::Exporter' => 0,
+ 'KiokuX::User' => 0,
},
);
View
@@ -1,119 +0,0 @@
-#!/usr/bin/perl
-
-package KiokuX::User;
-use Moose::Role;
-
-use namespace::clean -except => 'meta';
-
-our $VERSION = "0.01";
-
-with qw(
- KiokuX::User::ID
- KiokuX::User::Password
-);
-
-__PACKAGE__
-
-__END__
-
-=pod
-
-=head1 NAME
-
-KiokuX::User - A generic role for user objects stored in L<KiokuDB>
-
-=head1 SYNOPSIS
-
- package MyFoo::Schema::User;
- use Moose;
-
- use KiokuX::User::Util qw(crypt_password);
-
- with qw(KiokuX::User);
-
- my $user = MyFoo::Schema::User->new(
- id => $user_id,
- password => crypt_password($password),
- );
-
- $user->kiokudb_object_id; # "user:$user_id"
-
- if ( $user->check_password($read_password) ) {
- warn "Login successful";
- } else {
- warn "Login failed";
- }
-
-=head1 DESCRIPTION
-
-This role provides a fairly trivial set of attributes and methods designed to
-ease the storage of objects representing users in a KiokuDB database.
-
-It consumes L<KiokuX::User::ID> which provides the C<id> attribute and related
-methods as well as L<KiokuDB::Role::ID> integration, and
-L<KiokuX::User::Password> which provides an L<Authen::Passphrase> based
-C<password> attribute and a C<check_password> method.
-
-=head1 USE AS A DELEGATE
-
-This role strictly implements a notion of an authenticatable identity, not of a
-user.
-
-If you want to support renaming, multiple authentication methods (e.g. a
-password and/or an openid), it's best to create identity delegates that consume
-this role, and have them point at the actual user object:
-
- package MyFoo::Schema::Identity;
- use Moose::Role;
-
- has user => (
- isa => "MyFoo::Schema::User",
- is => "ro",
- required => 1,
- );
-
-And here's an example username identity:
-
- package MyFoo::Schema::Identity::Username;
- use Moose;
-
- with qw(
- MyFoo::Schema::Identity
- KiokuX::User
- );
-
-and then point back to these identities from the user:
-
- has identities => (
- isa => "ArrayRef[MyFoo::Schema::Identity]",
- is => "rw",
- required => 1,
- );
-
-Since the identity is part of the objects' ID uniqueness is enforced in a
-portable way (you don't need to use the DBI backend and a custom unique
-constraint).
-
-This also allows you to easily add additional authentication schemes, change
-them, provide namespacing support and so on without affecting the high level
-user object, which represents the actual account holder regardless of the
-authentication scheme they used.
-
-=head1 VERSION CONTROL
-
-L<http://github.com/nothingmuch/kiokux-user/>
-
-=head1 AUTHOR
-
-Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
-
-=head1 COPYRIGHT
-
- Copyright (c) 2008, 2009 Yuval Kogman, Infinity Interactive. All
- rights reserved This program is free software; you can redistribute
- it and/or modify it under the same terms as Perl itself.
-
-=cut
-
-# ex: set sw=4 et:
-
View
@@ -1,88 +0,0 @@
-#!/usr/bin/perl
-
-package KiokuX::User::ID;
-use Moose::Role;
-
-use namespace::clean -except => 'meta';
-
-with qw(KiokuDB::Role::ID);
-
-sub id_for_user {
- my ( $self, $id ) = @_;
- return "user:$id"
-}
-
-sub kiokudb_object_id {
- my $self = shift;
- $self->id_for_user($self->id);
-}
-
-has id => (
- isa => "Str",
- is => "ro",
- required => 1,
-);
-
-__PACKAGE__
-
-__END__
-
-=pod
-
-=head1 NAME
-
-KiokuX::User::ID - L<KiokuDB::Role::ID> integration for user objects
-
-=head1 SYNOPSIS
-
- with qw(KiokuX::User::ID);
-
-=head1 DESCRIPTION
-
-This role provides an C<id> attribute for user objects, and self registers in
-the L<KiokuDB> directory with the object ID C<user:$user_id>.
-
-Using this role implies that user IDs are immutable.
-
-=head1 METHODS
-
-=over 4
-
-=item kiokudb_object_id
-
-Implements the required method from L<KiokuX::User::ID> by prefixing the C<id>
-attribute with C<user:>.
-
-=item id_for_user $username
-
-Mangles the username into an ID by prefixing the string C<user:>.
-
-Can be overriden to provide custom namespacing.
-
-Can also be used as a class method from the model:
-
- sub get_identity_by_username {
- my ( $self, $username ) = @_;
-
- my $object_id = MyFoo::Schema::Identity::Username->id_for_user($username);
-
- return $self->lookup($object_id);
- }
-
-=back
-
-=head1 ATTRIBUTES
-
-=over 4
-
-=item id
-
-This is the user's ID in the system. It is not the object ID, but the object ID
-is derived from it.
-
-=back
-
-=cut
-
-# ex: set sw=4 et:
-
@@ -1,73 +0,0 @@
-#!/usr/bin/perl
-
-package KiokuX::User::Password;
-use Moose::Role;
-
-use MooseX::Types::Authen::Passphrase qw(Passphrase);
-
-use KiokuX::User::Util qw(crypt_password);
-
-use namespace::clean -except => 'meta';
-
-has password => (
- isa => Passphrase,
- is => 'rw',
- coerce => 1,
- required => 1,
- #handles => { check_password => "match" },
-);
-
-sub check_password {
- my $self = shift;
- $self->password->match(@_);
-}
-
-sub set_password {
- my ( $self, @args ) = @_;
- $self->password( crypt_password(@args) );
-}
-
-__PACKAGE__
-
-__END__
-
-=pod
-
-=head1 NAME
-
-KiokuX::User::Password - A role for users with a password attribute
-
-=head1 SYNOPSIS
-
- with qw(KiokuX::User::Password);
-
-=head1 DESCRIPTION
-
-This is a simple role for user objects that can check their own password.
-
-=head1 METHODS
-
-=over 4
-
-=item check_password
-
-Delegates to the L<Authen::Passphrase/match>.
-
-=back
-
-=head1 ATTRIBUTES
-
-=over 4
-
-=item password
-
-Uses L<MooseX::Types::Authen::Passphrase> to provide coercions.
-
-This is a required, read-write attribute.
-
-=back
-
-=cut
-
-# ex: set sw=4 et:
-
View
@@ -1,79 +0,0 @@
-#!/usr/bin/perl
-
-package KiokuX::User::Util;
-
-use strict;
-use warnings;
-
-use Sub::Exporter -setup => {
- exports => [qw(
- crypt_password
- )],
-};
-
-
-use Class::MOP;
-
-sub crypt_password {
- my @args = @_;
-
- unshift @args, "passphrase" if @args % 2 == 1;
-
- my %args = @args;
-
- unless ( exists $args{class} ) {
- %args = (
- class => "Authen::Passphrase::SaltedDigest",
- salt_random => 20,
- algorithm => "SHA-1",
- %args,
- );
- }
-
- my $class = delete $args{class};
-
- Class::MOP::load_class($class);
-
- $class->new(%args);
-}
-
-__PACKAGE__
-
-__END__
-
-=pod
-
-=head1 NAME
-
-KiokuX::User::Util - Utility functions for L<KiokuX::User>
-
-=head1 SYNOPSIS
-
- use KiokuX::User::Util;
-
- MyFoo::User->new(
- id => "cutegirl17",
- password => crypt_password("justin timberlake!!!"),
- );
-
-=head1 DESCRIPTION
-
-This module provides utility functions.
-
-=head1 EXPORTS
-
-=over 4
-
-=item crypt_password @args
-
-If an even sized list is passed the first argument is assumed to be 'passphrase'.
-
-Defaults to creating a L<Authen::Passphrase::SaltedDigest> with a 20 byte
-random salt.
-
-=back
-
-=cut
-
-# ex: set sw=4 et:
-
View
@@ -0,0 +1,12 @@
+package KiokuX::UserAccounts;
+
+use namespace::clean -except => 'meta';
+
+our $VERSION = "0.01";
+
+use Moose::Role;
+with qw(
+ KiokuX::User
+);
+
+

0 comments on commit 9ff0023

Please sign in to comment.