view release on metacpan or  search on metacpan

Project.pm  view on Meta::CPAN

		$proj->[4] = join(',', @{$proj->[4]});
		print($fh join(':', @$proj), "\n");
	}
}

#
# Validate a project entry in the same format as returned by getprojent et al.
# The first arg is a reference to a project record as returned by getprojent.
# The second argument is a reference to a flags hash, where the currently
# understood flags are:
#     'dup' - Allow duplicate projid
#     'res' - Allow projid in the reserved (0-99) range
# If project names are to be checked for uniqueness, a reference to a project
# file array as returned by projf_read should be passed as the third argument.
# In a scalar context the number of errors found will be returned, in a list
# context a list of error messages for the entry will be returned.  Each entry
# in the list is in turn a list containing an exit code followed by a printf
# format string and any required arguments.
#
sub proj_validate($;$$)
{
	my ($proj_rec, $flag, $projf) = @_;
	my ($pname, $id, $comment, $user, $group, $attr) = @$proj_rec;
	$flag ||= {};
	my ($low_projid, $linelen, @err);
	$low_projid = exists($flag->{res}) ? 0 : 100;
	$linelen = 0;

	# Validate project name.
	push(@err, [3, gettext("Invalid project name \"%s\""), $pname])
	    if ($pname !~ /^[A-Za-z][\w.-]*$/);
	push(@err, [9, gettext("Duplicate project name \"%s\""), $pname])
	    if (grep {$_->[0] eq $pname} @$projf);
	$linelen += length($pname) + 1;

	# Validate project id.
	if ($id !~ /^[+-]?\d+$/) {
		push(@err,
		    [3, gettext("Invalid projid \"%s\": must be numeric"), $id])
	} else {
		push(@err, [3, gettext("Invalid projid \"%d\": must be >= %d"),
		    $id, $low_projid])
		    if ($id < $low_projid);
		push(@err, [3, gettext("Invalid projid \"%.f\": must be <= %d"),
		    $id, &MAXPROJID])
		    if ($id > &MAXPROJID);
		push(@err, [4, gettext("Duplicate projid \"%d\""), $id])
		    if (! exists($flag->{dup}) && defined($projf) &&
		    grep { $_->[1] == $id } @$projf);
	}
	$linelen += length($id) + 1;

	# Validate comment.
	push(@err, [3, gettext("Invalid character \"%s\" in comment"), $1])
	    if ($comment =~ /([\n:])/);
	$linelen += length($comment) + 1;

	# Validate users.
	foreach my $u (@$user) {
		push(@err, [6, gettext("User \"%s\" does not exist"), $u])
		    if (! (($u =~ /^\d+$/ && defined(getpwuid($u))) ||
			   ($u =~ /^\*$/) || ($u =~ /^\!\*$/) ||
			   ($u =~ /^\!(\S+)$/ && defined(getpwnam($1))) ||
		    	   defined(getpwnam($u))));
		$linelen += length($u) + 1;
	}
	$linelen += 1 if (! @$user);

	# Validate groups.
	foreach my $g (@$group) {
		push(@err, [6, gettext("Group \"%s\" does not exist"), $g])
		    if (! (($g =~ /^\d+$/ && defined(getgrgid($g))) ||
			   ($g =~ /^\*$/) || ($g =~ /^\!\*$/) ||
			   ($g =~ /^\!(\S+)$/ && defined(getgrnam($1))) ||
			   defined(getgrnam($g))));
		$linelen += length($g) + 1;
	}
	$linelen += 1 if (! @$group);

	# Validate attribute string.
	push(@err, [3, gettext("Invalid attribute string \"%s\""), $attr])
	    if ($attr !~
	    /^$|^(?:[A-Za-z][\w.-]*=[^\s;]+)(?:;[A-Za-z][\w.-]*=[^\s;]+)*$/);
	$linelen += length($attr);

	# Validate line length.
	push(@err, [10, gettext("Project entry > %d bytes"), &PROJECT_BUFSZ])
	    if ($linelen > &PROJECT_BUFSZ);

	return (wantarray() ? @err : scalar(@err));
}

#
# Validate an entire project file as returned from projf_read.  Applies
# proj_validate to each entry, and returns a list of all the errors found
# in the same format as proj_validate, with a line number appended to each
# error message.
#
sub projf_validate($;$)
{
	my @projf = @{shift(@_)};	# Make a copy of the array.
	my $flag = shift(@_);
	my @err;
	my $line = 1;
	my $where = gettext(" at line %d");
	while (my $rec = shift(@projf)) {
		foreach my $e (proj_validate($rec, $flag, \@projf)) {
			$e->[1] .= $where;
			push(@$e, $line);
			push(@err, $e);
		}
		$line++;
	}
	return(wantarray() ? @err : scalar(@err));
}

1;