File Coverage

blib/lib/Net/LDAP/Class/User.pm

Criterion	Covered	Total	%
statement	63	72	87.5
branch	11	20	55.0
condition	18	26	69.2
subroutine	11	12	91.6
pod	7	7	100.0
total	110	137	80.2

package Net::LDAP::Class::User;
use strict;
use warnings;
use Carp;
use base qw( Net::LDAP::Class );
use Net::LDAP::Class::MethodMaker (
    'scalar --get_set_init' => [qw( group_class )],
    'related_objects'       => [qw( group groups )],
);

our $VERSION = '0.27';

=head1 NAME

Net::LDAP::Class::User - base class for LDAP user objects

=head1 SYNOPSIS

 package MyUser;
 use strict;
 use base qw( Net::LDAP::Class::User );

 # define action_for_* methods for your LDAP schema

 1;

=head1 DESCRIPTION

Net::LDAP::Class::User is a simple base class intended to be
subclassed by schema-specific Net::LDAP::Class::User::* classes.

=head1 METHODS

=head2 init

Overrides base method to check that group_class() is defined.

=cut

sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    unless ( defined $self->group_class ) {
        croak "must define group_class()";
    }
    return $self;
}

=head2 add_to_group( I )

Adds I via the groups() method. A convenience method.

Must call update() to actually write the changes to the LDAP database.

=cut

sub add_to_group {
    my $self = shift;
    my $group = shift or croak "Group required";
    if ( !ref($group) or !$group->isa('Net::LDAP::Class::Group') ) {
        croak "Group should be a Net::LDAP::Class::Group-derived object";
    }
    if ( !$group->ldap_entry ) {
        croak "Group should be read() prior to adding User $self as a member";
    }
    my @groups = @{ $self->groups };
    my $uniq_method;
    for my $g (@groups) {
        $uniq_method ||= $g->unique_attributes->[0];
        if ( $g->$uniq_method eq $group->$uniq_method ) {
            croak "User $self is already a member of Group $group";
        }
    }
    push( @groups, $group );
    $self->groups( \@groups );
    return $self;
}

=head2 remove_from_group( I )

Removes I using the groups() method. A convenience method.

Must call update() to actually write the changes to the LDAP database.

=cut

sub remove_from_group {
    my $self = shift;
    my $group = shift or croak "Group required";
    if ( !ref($group) or !$group->isa('Net::LDAP::Class::Group') ) {
        croak "Group should be a Net::LDAP::Class::Group-derived object";
    }
    if ( !$group->ldap_entry ) {
        croak
            "Group should be read() prior to removing User $self as a member";
    }
    my @groups = @{ $self->groups };
    my @new;
    my $uniq_method;
    for my $g (@groups) {
        $uniq_method ||= $g->unique_attributes->[0];
        if ( $g->$uniq_method eq $group->$uniq_method ) {
            next;
        }
        push( @new, $g );
    }
    if ( scalar(@new) == scalar(@groups) ) {
        croak "User $self is not a member of $group and cannot be removed.\n"
            . "$self is in these groups: "
            . join( ", ", map {"$_"} @groups );
    }
    $self->groups( \@new );
    return $self;
}

=head2 init_group_class

Default is to croak indicating you must override this method in your subclass.

=cut

sub init_group_class {
    croak "Must override init_group_class() or set group_class in metadata. "
        . "Have you created a group subclass yet?";
}

=head2 stringify

Aliased to username().

=cut

sub stringify { shift->username }

=head2 username

Get/set the value of the first unique attribute.

=cut

sub username {
    my $self = shift;
    my $attr = $self->unique_attributes->[0];
    return $self->$attr(@_);
}

=head2 random_string([I])

Returns a random alphanumeric string of length I (default: 10).

=cut

# possible characters (omits common mistaken letters Oh and el)
my @charset = (
    'a' .. 'k', 'm' .. 'z', 'A' .. 'N', 'P' .. 'Z', '2' .. '9', '.',
    ',',        '$',        '?',        '@',        '!'
);

# sanity check for collisions in tight loops
my %rand_string_cache;

sub random_string {
    my $self = shift;
    my $len = shift || 10;

    # set random seed
    my ( $usert, $system, $cuser, $csystem ) = times;
    srand( ( $$ ^ $usert ^ $system ^ time ) );

    # select characters
    # retry until we get at least:
    #  * one UPPER
    #  * one lower
    #  * one \d
    #  * one \W

    my @chars;
    my $str = '';
    until (    $str =~ /\d/
            && $str =~ /[A-Z]/
            && $str =~ /[a-z]/
            && $str =~ /\W/
            && !$rand_string_cache{$str}++ )
    {
        @chars = ();
        for ( my $i = 0; $i <= ( $len - 1 ); $i++ ) {
            $chars[$i] = $charset[ int( rand($#charset) + 1 ) ];
        }
        $str = join( '', @chars );
    }

    return $str;
}

1;

__END__