view release on metacpan or  search on metacpan

lib/DBIx/UserDB.pm  view on Meta::CPAN

profile that should be used to access the users' information (defaults
to "userdb"). The third parameter is the name of the profile to use 
for group access (defaults to "groupdb").

=cut

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;

    my $self = bless {}, $class;

    my $DB	= shift
      or die "Missing Database argument\n";

    my $user_profile	= shift || "userdb";
    my $group_profile	= shift || "groupdb";

    die "No user profile named $user_profile\n"
      unless $DB->has_profile( $user_profile );
    die "No group profile named $group_profile\n"
      unless $DB->has_profile( $group_profile );

    $self->{DB}		    = $DB;
    $self->{user_profile}   = $user_profile;
    $self->{group_profile}  = $group_profile;
    $self->{scramble}	    = 1;

    $self;
}

=pod

=head2 scramble_password ( [new_setting] )

Return the scramble password setting. You may also change the setting
by giving the method a new value. If scramble password is true, user's
password will be uuencoded before being stored in the database.

=cut

sub scramble_password($;$) {
    $_[0]->{scramble} = $_[1] if @_ == 2;

    $_[0]->{scramble};
}

=pod

=head1 USER METHODS

Here are the methods for managing users in the database.

=head2 user_create ( \%user )

This method creates a user with the information specified in the hash
reference in the database. In the user's hash, at least the fields
I<username> and I<password> should be set.

The methods return true on success and false if there is already a
username with that name in the database. Exception are thrown on
database errors. Additionally, on return, the method will add the UID
of the newly created user.

=cut

sub user_create {
    my ( $self, $user ) = @_;

    # Check for a user with the same username
    my $old_user = $self->{DB}->record_search( $self->{user_profile},
					       {username => $user->{username}}
					     );
    return undef if @$old_user;

    # Scramble the password for persistence
    $user->{password} = pack "u*", $user->{password} 
      if ( $self->{scramble} );
    $self->{DB}->record_insert( $self->{user_profile}, $user );

    # Load the user back
    my $new_user = $self->{DB}->record_search( $self->{user_profile},
					       {username => $user->{username}}
					     );
    die "Can't find new user\n" unless @$new_user == 1;

    # Copy the fields of the new user back in this one
    while ( my ($name,$value) = each %{$new_user->[0]} ) {
	$user->{$name} = $value;
    }

    # Unscramble the password
    $user->{password} = unpack "u*", $user->{password}
      if $self->{scramble};

    return $user;
}

sub user_load {
    my ($self,$user) = @_;

    # Unscramble the password
    $user->{password} = unpack "u*", $user->{password}
      if $self->{scramble};
    $user->{groups} =
      $self->{DB}->template_search( $self->{group_profile},
				    { uid => $user->{uid} } );
    return $user;
}

=pod

=head2 user_search ( \%params )

This method will return users matching the DBIx::SearchProfiles query
specification in a reference to an array.

=cut

sub user_search {
    my $self   = shift;