view release on metacpan or  search on metacpan

lib/Software/Packager/Darwin.pm  view on Meta::CPAN

# Function:	process_links()
# Description:	This function process all of the links.
# Arguments:	none.
# Return:	true if ok else undef.
#
sub process_links
{
	my $self = shift;
	my $tmp_dir = $self->tmp_dir();

	foreach my $object ($self->get_link_objects())
	{
	    my $source = $object->source();
	    my $destination = $object->destination();
	    my $type = $object->type();

	    if ($type eq 'softlink')
	    {
		unless (symlink $source, "$tmp_dir/$destination")
		{
		    warn "Error: Could not create soft link from $source to $tmp_dir/$destination:\n$!\n";
		    return undef;
		}
	    }
	    elsif ($type eq 'hardlink')
	    {
		unless (link $source, "$tmp_dir/$destination")
		{
		    warn "Error: Could not create hard link from $source to $tmp_dir/$destination:\n$!\n";
		    return undef;
		}
	    }
	    else
	    {
	    }
	}

	return 1;
}

################################################################################
# Function:	set_permissions()
# Description:	This function sets the permissions for all objects.
# Arguments:	none.
# Return:	true if ok else undef.
#
sub set_permissions
{
	my $self = shift;
	my $tmp_dir = $self->tmp_dir();

	foreach my $object ($self->get_directory_objects(), $self->get_file_objects())
	{
	    my $destination = $object->destination();
	    my $mode = oct($object->mode());
	    my $user = $object->user();
	    my $group = $object->group();
	    my $user_num = $user =~ /\d+/ ? $user : getpwnam($user);
	    my $group_num = $group =~ /\d+/ ? $group : getgrnam($group);

	    unless (chown($user_num, $group_num, "$tmp_dir/$destination"))
	    {
		warn "Error: Could not change owner or group:\n$!\n";
		return undef;
	    }

	    unless (chmod $mode, "$tmp_dir/$destination")
	    {
		warn "Error: Could not change owner or group:\n$!\n";
		return undef;
	    }
	}

	return 1;
}

1;
__END__

=head1 SEE ALSO

 Software::Packager

=head1 AUTHOR

 R Bernard Davison <rbdavison@cpan.org>

=head1 COPYRIGHT

 Copyright (c) 2001 Gondwanatech. All rights reserved.
 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.

=cut