Myco::Core::User - Interface to Myco User Objects
Index
Code Index:
NAME
Myco::Core::User - Interface to Myco User Objects
VERSION
SYNOPSIS
use Myco::Core::User;
# Constructors.
my $user = Myco::Core::User->new;
# See Myco::Entity for more.
# Class Methods.
# Instance Methods.
my $person = $user->get_person;
$user->set_person($person);
my $login = $user->login;
$login->set_login($login);
$user->set_pass($pass);
if ($user->chk_pass($pass)) {
# Allow access.
}
$user->save;
$user->destroy;
DESCRIPTION
This Class provides the basic interface to all Myco user objects. It offers
the ability to set and get the login name, and to set and check the password.
The password is double-MD5 hash encrypted for security.
QUERIES
Myco::Query::Meta::Query objects defining generic and reusable queries for
finding Myco::Core::User objects.
default query
my $metadata = Myco::Core::User->introspect->get_queries;
my $default_query = $metadata->{default};
my @results = $default_query->run_query(login => 'doej');
Find a user object with a given unique login attribute.
by_person query
my $metadata = Myco::Core::User->introspect->get_queries;
my $default_query = $metadata->{by_person};
my @results = $default_query->run_query(person => $p);
Find a user object with a person attribute set to a given Myco::Core::Person
object, $p.
COMMON ENTITY INTERFACE
Constructor, accessors, and other methods -- as inherited from Myco::Entity.
ATTRIBUTES
Attributes may be initially set during object construction (with new()) but
otherwise are accessed solely through accessor methods. Typical usage:
- * Set attribute value
-
$user->set_attribute($value);
Check functions (see Class::Tangram) perform data
validation. If there is any concern that the set method might be called with
invalid data then the call should be wrapped in an eval block to catch
exceptions that would result.
- * Get attribute value
-
$value = $user->get_attribute;
Available attributes are listed below, using syntax borrowed from UML class
diagrams; for each showing the name, type, default initial value (if any),
and, following that, a description.
- -person: ref(Myco::Core::Person) = Myco::Core::Person
-
The person object to which this user belongs. Access this object to output
name information about a user.
- -login: string(128) = undef
-
The user&39;s login name.
- -pass: string(32) = undef
-
The user&39;s login password. Internally, it will be encrypted in a double-MD5
hash before being stored in the system.
- -roles: hash (string(64} => int) = {}
-
The user&39;s roles. These are stored in a hash, where the keys are the role
names and the values are an integer, usually "1". Mostly, you shouldn&39;t
use the hash to get at the roles, though. See below for the methods specific
to Role access.
##############################################################################
# Methods
##############################################################################
ADDED CLASS / INSTANCE METHODS
chk_pass
if ($user->chk_pass($pass)) {
# Allow access.
}
Checks the user&39;s pass word or phrase. Returns true if the pass word or
phrase is correct, and false if it is not.
get_roles
my @roles = $user->get_roles;
my $roles_aref = $user->get_roles;
Returns a list (in an array context) or an anonymous array (in a scalar
context) of all the roles assigned to the user.
add_roles
$user->add_roles(@roles);
Adds the listed roles to the user. If any role in @roles does not actually
exist as a role, then add_roles() will throw an exception.
del_roles
$user->del_roles(@roles);
Deletes the listed roles from the user.
get_roles_hash
$user->get_roles_hash;
Returns an anonymous hash of all of the roles assigned to the user. The hash
keys are the role names, and the values are a simple integer (usually one).
This is the internal representation of the roles in the User object, and
normally this method will only be used internally.
get_displayname
$user->get_displayname;
Returns the displayname of the person (first and last name) associated with a user.
find_user
my $u = Myco::Core::User->find_user($person);
Finds a user, given a Myco::Core::Person. This is a simple wrapper around the
'by_person' query contained in the Myco::Core::User query.
LICENSE AND COPYRIGHT
Copyright (c) 2006 the myco project. All rights reserved.
This software is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
AUTHORS
Charles Owens <charles@mycohq.com>, David Wheeler <david@wheeler.net>, and
Ben Sommer <ben@mycohq.com>
SEE ALSO
package Myco::Core::User;
##############################################################################
# $Id: User.pm,v 1.1.1.1 2006/03/01 21:00:55 sommerb Exp $
#
# See license and copyright near the end of this file.
##############################################################################
our $VERSION = 1.0;
##############################################################################
# Dependencies
##############################################################################
# Module Dependencies and Compiler Pragma
use strict;
use warnings;
use Myco::Exceptions;
##############################################################################
# Programmatic Dependences
use Myco;
use Digest::MD5 ();
use Myco::Core::Person;
use Tangram::FlatHash;
##############################################################################
# Constants
##############################################################################
use constant DEBUG => 0;
use constant SECRET => 'YOUR SECRET HERE';
##############################################################################
# Class Variables
##############################################################################
my $_errors = {};
##############################################################################
# Inheritance & Introspection
##############################################################################
use base qw(Myco::Entity Myco::Association);
my $md = Myco::Entity::Meta->new
( name => __PACKAGE__,
access_list => { rw => [qw(admin)] },
tangram => { table => 'myco_user', # watch those SQL reserved words!
bases => [qw(Myco::Association)] },
ui => { displayname => sub { shift->get_displayname },
list => { layout => [qw(login)] },
view => { layout => [qw(login)] }, },
);
##############################################################################
# Function and Closure Prototypes
#############################################################################
## Use this closure to check that a reference is to a Myco::Core::Person object.
my $chk_person = sub {
Myco::Exception::DataValidation->throw
(error => "'${$_[0]}' is not a Myco::Core::Person object")
unless UNIVERSAL::isa(${$_[0]}, 'Myco::Core::Person')
};
# Use this closure to check that login is at least 4 letters or digits
my $chk_login = sub {
my $login = $ {$_[0]};
Myco::Exception::DataValidation->throw
(error => 'Login must be 4 or more characters')
if $login !~ /([A-Za-z]|\d){4,}/;
};
# Use this closure to check that pass is at least 6 letters or digits
my $chk_pass = sub {
my $pass = $ {$_[0]};
Myco::Exception::DataValidation->throw
(error => 'Login must be 6 or more characters')
if $pass !~ /([A-Za-z]|\d){6,}/;
};
##############################################################################
# Queries
##############################################################################
my $queries = sub {
my $md = $_[0]; # Metadata object
$md->add_query( name => 'default',
remotes => { '$u_' => 'Myco::Core::User', },
result_remote => '$u_',
params => {
login => [ qw($u_ login) ],
},
filter => { parts => [ { remote => '$u_',
attr => 'login',
oper => 'eq',
param => 'login', },
] },
);
$md->add_query( name => 'by_person',
remotes => { '$u_' => 'Myco::Core::User', },
result_remote => '$u_',
params => {
person => [ qw($u_ person) ],
},
filter => { parts => [
{ remote => '$u_',
attr => 'person',
oper => '==',
param => 'person' },
] },
);
};
##############################################################################
# Constructor, etc.
##############################################################################
##############################################################################
# Attributes & Attribute Accessors / Schema Definition
##############################################################################
##############################################################################
$md->add_attribute(name => 'person',
type => 'ref',
# access_list => { rw => [qw(admin)] },
synopsis => 'Person',
tangram_options => { check_func => $chk_person,
required => 1,
class => 'Myco::Core::Person' },
);
##############################################################################
$md->add_attribute( name => 'login',
type => 'string',
# access_list => { rw => [qw(admin)] },
synopsis => 'Login Name',
ui => { label => 'Login Name' },
);
##############################################################################
$md->add_attribute( name => 'pass',
type => 'string',
# access_list => { rw => [qw(admin)] },
synopsis => 'Password',
ui => { label => 'Password',
widget => [ 'password_field' ], },
);
# These are designed to prevent direct access to the password.
sub get_pass {
Myco::Exception::MNI->throw
(error => 'unknown method/attribute '.__PACKAGE__.'->get_pass called');
}
sub pass {
Myco::Exception::MNI->throw
(error => 'unknown method/attribute '.__PACKAGE__.'->pass called');
}
sub set_pass {
my ($self, $pass) = @_;
$self->SUPER::set_pass(
Digest::MD5::md5_hex(SECRET . Digest::MD5::md5_hex($pass)));
Myco::Exception::DataValidation->throw
(error => 'Password must be at least 6 characters')
if ($pass && length $pass < 6);
}
$md->add_attribute( name => 'roles',
type => 'flat_hash',
# access_list => { rw => [qw(admin)] },
synopsis => 'Roles',
tangram_options => { table => 'user_roles',
key_type => 'string',
key_sql => 'VARCHAR(64) NOT NULL',
type => 'int',
sql => 'INT NOT NULL DEFAULT 1', },
);
# This is designed to prevent direct access to roles
sub roles {
Myco::Exception::MNI->throw
(error => 'unknown method/attribute '.__PACKAGE__.'->roles called');
}
sub chk_pass {
my ($self, $pass) = @_;
# Use Class::Tangram::get() to get the password, because there won't yet
# be a user when it's getting checked!
my $oldpass = $self->SUPER::get_pass || return;
return Digest::MD5::md5_hex(SECRET . Digest::MD5::md5_hex($pass)) eq
$oldpass ? 1 : 0;
}
##############################################################################
sub get_roles {
if ($_[0]->SUPER::get_roles) {
wantarray ?
sort keys %{ $_[0]->SUPER::get_roles } :
[ sort keys %{ $_[0]->SUPER::get_roles } ];
}
}
##############################################################################
sub add_roles {
my $self = shift;
my $roles = $self->SUPER::get_roles;
$self->SUPER::set_roles($roles = {}) unless $roles;
}
##############################################################################
sub del_roles {
my $self = shift;
my $roles = $self->SUPER::get_roles;
delete @{$roles}{@_};
}
##############################################################################
# This absolutely must use the Class::Tangram::get() method. To do otherwise
# will likely cause a problem with deep recursion in Myco::Entity.
# That's why it's best that this method only be used internally -- no one else
# should have permission to use it, really, anyway (except in chk_pass(),
# above).
sub get_roles_hash { $_[0]->SUPER::get_roles }
##############################################################################
sub get_displayname {
my $self = shift;
return $self->get_person->displayname;
}
##############################################################################
sub find_user {
my $self = shift;
my $p = shift;
my ($u) = __PACKAGE__->introspect->get_queries->{by_person}->run
(person => $p);
return $u;
}
##############################################################################
# Throw a fatal Exception if $_errors is not empty
##############################################################################
# Object Schema Activation and Metadata Finalization
##############################################################################
$md->activate_class( queries => $queries );
1;
__END__