view release on metacpan or  search on metacpan

lib/Class/User/DBI.pm  view on Meta::CPAN

sub load_profile {
    my $self = shift;
    my $sth  = $self->_db_run( $USER_QUERY{SQL_load_profile}, $self->userid );
    my $hr   = $sth->fetchrow_hashref;
    if ( $self->get_role ) {
        my $rp = $self->role_privileges;
        $hr->{privileges} = [ $rp->fetch_privileges ];
    }
    my $ud = $self->user_domains;
    $hr->{domains} = [ $ud->fetch_domains ];
    return $hr;
}

sub add_ips {
    my ( $self, @ips ) = @_;
    return if !$self->exists_user;

    # We don't want to insert IP's already in the DB.
    my @ips_in_db = $self->get_valid_ips;
    my %uniques;
    @uniques{@ips_in_db} = ();
    my @ips_to_insert = grep { !exists $uniques{$_} } @ips;
    return 0 if !@ips_to_insert;

    # Prepare the userid,ip bundles for our insert query.
    my @execution_param_bundles =
      map { [ $self->userid, unpack( 'N', inet_aton($_) ) ] } @ips_to_insert;
    my $sth =
      $self->_db_run( $USER_QUERY{SQL_add_ips}, @execution_param_bundles );

    return scalar @ips_to_insert;    # Return a count of IP's inserted.
}

sub delete_ips {
    my ( $self, @ips ) = @_;
    return if !$self->exists_user;
    my @ips_in_db = $self->get_valid_ips;
    my %found;
    @found{@ips_in_db} = ();
    my @ips_for_deletion = grep { exists $found{$_} } @ips;
    my @execution_param_bundles =
      map { [ $self->userid, unpack( 'N', inet_aton($_) ) ] } @ips_for_deletion;
    my $sth =
      $self->_db_run( $USER_QUERY{SQL_delete_ips}, @execution_param_bundles );
    return scalar @ips_for_deletion;    # Return a count of IP's deleted.
}

# Fetches all IP's that are whitelisted for the user.
sub get_valid_ips {
    my $self = shift;
    my $sth = $self->_db_run( $USER_QUERY{SQL_get_valid_ips}, $self->userid );
    my @rv;
    while ( defined( my $row = $sth->fetchrow_arrayref ) ) {
        if ( defined $row->[0] ) {
            push @rv, inet_ntoa( pack 'N', $row->[0] );
        }
    }
    return @rv;
}

sub update_password {
    my ( $self, $newpass, $oldpass ) = @_;

    return if !$self->exists_user;

    # If an old passphrase is supplied, only update if it validates.
    if ( defined $oldpass ) {
        my $credentials = $self->get_credentials;
        my $auth        = Authen::Passphrase::SaltedSHA512->new(
            salt_hex => $credentials->{salt_hex},
            hash_hex => $credentials->{pass_hex}
        );

        # Return undef if password doesn't authenticate for the user.
        return unless $auth->match($oldpass);    ## no critic (postfix)
    }

    my $passgen =
      Authen::Passphrase::SaltedSHA512->new( passphrase => $newpass );
    my $salt_hex = $passgen->salt_hex;
    my $hash_hex = $passgen->hash_hex;
    $self->_db_conn->txn(
        fixup => sub {
            my $sth = $_->prepare( $USER_QUERY{SQL_update_password} );
            $sth->execute( $salt_hex, $hash_hex, $self->userid );
        }
    );
    return $self->userid;
}

sub set_email {
    my ( $self, $new_email ) = @_;
    croak 'Can\'t set a user email for a user ID that doesn\'t exist.'
      if !$self->exists_user;
    my $sth =
      $self->_db_run( $USER_QUERY{SQL_set_email}, $new_email, $self->userid );
    return $new_email;
}

sub set_username {
    my ( $self, $new_username ) = @_;
    croak 'Can\'t set a user name for a user ID that doesn\'t exist.'
      if !$self->exists_user;
    my $sth = $self->_db_run( $USER_QUERY{SQL_set_username},
        $new_username, $self->userid );
    return 1;
}

sub set_ip_required {
    my ( $self, $required ) = @_;
    croak 'Can\'t set an IP requirement for a user ID that doesn\'t exist.'
      if ! $self->exists_user;
    $required = defined $required ? $required : 0;
    $required = $required ? 1 : 0;
    my $sth = $self->_db_run( $USER_QUERY{SQL_set_ip_required},
        $required, $self->userid );
    return 1;
}

sub get_ip_required {
    my $self = shift;