view release on metacpan or  search on metacpan

lib/Sys/Export/Unix/UserDB.pm  view on Meta::CPAN

   my $g= Sys::Export::Unix::UserDB::Group->new(%attrs);
   $self->_add_group_object($g);

   # Can't store member list in group, so store these for later when a user gets added
   if (defined $members) {
      $self->_lazy_add_user_to_group($_, $attrs{name})
         for (isa_array $members? @$members
            : isa_hash $members? keys %$members
            : split / /, $members);
   }
   return $g;
}


sub add_user($self, $name_or_obj, %attrs) {
   if (isa_hash($name_or_obj) || isa_user($name_or_obj)) {
      %attrs= ( %$name_or_obj, %attrs );
   } else {
      my $name= "$name_or_obj";
      if (keys %attrs) {
         $attrs{name}= $name;
      }
      # trigger an import if just a name, and auto_import enabled
      elsif ($self->auto_import && !$self->{users}{$name}) {
         $self->user($name)
            or croak "Failed to import user $name";
         return $self;
      }
   }
   $self->_add_user_object(Sys::Export::Unix::UserDB::User->new(%attrs));
}


sub add_group($self, $name_or_obj, %attrs) {
   if (isa_hash($name_or_obj) || isa_group($name_or_obj)) {
      %attrs= ( %$name_or_obj, %attrs );
   } else {
      my $name= "$name_or_obj";
      if (keys %attrs) {
         $attrs{name}= $name;
      }
      # trigger an import if just a name, and auto_import enabled
      elsif ($self->auto_import && !$self->{groups}{$name}) {
         $self->group($name)
            or croak "Failed to import group $name";
         return $self;
      }
   }
   $self->_add_group_object(Sys::Export::Unix::UserDB::Group->new(%attrs));
}


sub user($self, $spec) {
   length $spec or return undef;
   my $u= isa_int $spec? $self->{uids}{$spec} : $self->{users}{$spec};
   if (!$u && $self->auto_import) {
      if (isa_userdb $self->auto_import) {
         my $peer_u= $self->auto_import->user($spec) // return undef;
         $u= eval { $self->import_user($peer_u) } or warn $@;
      } else {
         my $name= isa_int $spec? (getpwuid($spec) // return undef) : $spec;
         $u= eval { $self->import_user($name) } or warn $@;
      }
   }
   $u;
}

sub has_user($self, $spec) {
   defined(isa_int $spec? $self->{uids}{$spec} : $self->{users}{$spec});
}

sub group($self, $spec) {
   length $spec or return undef;
   my $g= isa_int $spec? $self->{gids}{$spec} : $self->{groups}{$spec};
   if (!$g && $self->auto_import) {
      if (isa_userdb $self->auto_import) {
         my $peer_g= $self->auto_import->group($spec) // return undef;
         $g= eval { $self->import_group($peer_g) } or warn $@;
      } else {
         my $name= isa_int $spec? (getgrgid($spec) // return undef) : $spec;
         $g= eval { $self->import_group($name) } or warn $@;
      }
   }
   $g;
}

sub has_group($self, $spec) {
   defined(isa_int $spec? $self->{gids}{$spec} : $self->{groups}{$spec});
}

# Private methods

# Allows adding user to group before user is defined
sub _lazy_add_user_to_group($self, $unam, $grnam) {
   if (my $u= $self->{users}{$unam}) {
      $u->add_group($grnam);
   } else {
      push $self->{_lazy_add_user_to_group}{$unam}->@*, $grnam;
   }
}

sub _add_user_object($self, $user) {
   my $name = $user->name;
   my $uid = $user->uid;
   $self->is_valid_name($name) or croak "Invalid user name '$name'";
   
   # Check for name conflicts
   croak "Username '$name' already exists"
      if defined $self->{users}{$name};
   
   # Warn about UID conflicts
   carp "UID $uid already exists for user '".$self->{uids}{$uid}->name."', now also used by '$name'"
      if defined $self->{uids}{$uid};

   # Check for references to non-existent groups
   # If auto_import is enabled, accessing ->group will trigger their creation.
   for ((isa_int $user->group? () : ($user->group)), keys $user->groups->%*) {
      $self->is_valid_name($_)
         or croak "Invalid group name '$_' for user '$name'";
      # add the user temporarily so auto_import feature can see it
      local $self->{users}{$name} = $user