A lot like &check_path (which it calls), but also checks that the path is
absolute (ie is starts with a /).
=cut
subcheck_absolute_path {
my$option= shift;
my$path= shift;
my$permissions= shift;
die"Path for '$option' must be absolute"unless$path=~ m!^/!;
check_path($option,$path,$permissions);
}
=head2 type_check(selfhash,name,value,record)
Returns errors on typechecking value against record. Name is provided for error messages. Selfhash might be useful one day. Note that selfhash is not yet blessed.
=cut
subtype_check {
my$self= shift;
my$name= shift;
my$value= shift;
my$record= shift;
my@errors= ();
my$list_name= '';
$list_name= "Item $_[0] of"ifdefined$_[0];
my$datatype= $record->[2];
if($datatypeeq 'integer') {
push@errors,sprintf("$list_name Entry called %s should be an integer",$name) unless$value=~/^\d+$/;
push@errors,sprintf("$list_name Entry called %s is less than minimum permitted value of $record->[3]",$name) if((defined$record->[3]) and ($record->[3] > $value));
push@errors,sprintf("$list_name Entry called %s exceeds permitted value of $record->[4]",$name) if((defined$record->[4]) and ($record->[4] < $value));
} elsif($datatypeeq 'float') {
push@errors,sprintf("$list_name Entry called %s should be a number",$name) unless$value=~/^-?\d+(\.\d+)$/;
push@errors,sprintf("$list_name Entry called %s is less than minimum permitted value of $record->[3]",$name) if((defined$record->[3]) and ($record->[3] > $value));
push@errors,sprintf("$list_name Entry called %s exceeds permitted value of $record->[4]",$name) if((defined$record->[4]) and ($record->[4] < $value));
} elsif($datatypeeq 'ip') {
push@errors,sprintf("$list_name Entry called %s should be an ip address",$name) unless$value=~/^\d\d?\d?\.\d\d?\d?\.\d\d?\d?\.\d\d?\d?$/;
} elsif($datatypeeq 'cidr') {
push@errors,sprintf("$list_name Entry called %s should be a CIDR ip range",$name) unless$value=~m!^\d\d?\d?\.\d\d?\d?\.\d\d?\d?\.\d\d?\d?/\d\d?$!;
} elsif($datatypeeq 'xml_leaf') {
push@errors,sprintf("$list_name Entry called %s should be an xml filename",$name) unless$value=~/^[A-Za-z0-9_-]+\.xml$/;
} elsif($datatypeeq 'xsl_leaf') {
push@errors,sprintf("$list_name Entry called %s should be an xsl filename",$name) unless$value=~/^[A-Za-z0-9_-]+\.xsl$/;
} elsif($datatypeeq 'yes_no') {
push@errors,sprintf("$list_name Entry called %s should be 'yes' or 'no'",$name) unless$value=~/^(yes)|(no)$/;
} elsif($datatypeeq 'word') {
push@errors,sprintf("$list_name Entry called %s should be a word (ie no whitespace)",$name) unless$value=~/^\S+$/;
} elsif($datatypeeq 'function_name') {
push@errors,sprintf("$list_name Entry called %s should be an xpath function name",$name) unless$value=~/^[^\s:]+(:\S+)?$/;
} elsif($datatypeeq 'path') {
push@errors,sprintf("$list_name Entry called %s should be a path",$name) unless$value=~/^\S+$/;
} elsif($datatypeeq 'email') {
push@errors,sprintf("$list_name Entry called %s should be an email address",$name) unless$value=~/^[^\s@]+\@[^\s@]+$/;
} elsif(($datatypeeq 'abs_file') or ($datatypeeq 'abs_dir')) {
push@errors,sprintf("$list_name Entry called %s should be absolute (ie it should start with /)",$name) unless$value=~/^\//;
push@errors,sprintf("No file or directory corresponds to $list_name entry called %s",$name) unless-e $value;
if(-e $value) {
push@errors,sprintf("$list_name Entry called %s should be a file, not a directory",$name) if((-d $value) and ($datatypeeq 'abs_file'));
push@errors,sprintf("$list_name Entry called %s should be a directory, not a file",$name) if((-f $value) and ($datatypeeq 'abs_dir'));
push@errors,sprintf("$list_name Entry called %s must be readable",$name) if($record->[3]=~/r/ and not -r $value);
push@errors,sprintf("$list_name Entry called %s must be writable",$name) if($record->[3]=~/w/ and not -w $value);
push@errors,sprintf("$list_name Entry called %s must be executable",$name) if($record->[3]=~/x/ and not -x $value);
}
} elsif($datatypeeq 'abs_create'){
$value=~m!^(.*/)?([^/]+$)!;
my$dir= $1;
push@errors,sprintf("$list_name Entry called %s should be absolute (ie it should start with /)",$name) unless$value=~/^\//;
push@errors,sprintf("$list_name No file or directory corresponds to entry called %s, and insufficient rights to create one",$name) if((not -e $value) and ((not $dir) or (-d $dir) and ((not -r $dir) or (not -w $dir) or (not -x $dir))));
push@errors,sprintf("$list_name Entry called %s must be readable",$name) if($record->[3]=~/r/ and -e $valueand not -r $value);
push@errors,sprintf("$list_name Entry called %s must be writable",$name) if($record->[3]=~/w/ and -e $valueand not -w $value);
push@errors,sprintf("$list_name Entry called %s must be executable",$name) if($record->[3]=~/x/ and -e $valueand not -x $value);
} else{
diesprintf("Unknown unit config datatype %s",$datatype);
}
return@errors;
}
=head2 apache_time(epoch_time)
Produces an apache-style timestamp from an epoch time.
=cut
subapache_time {
my$epoch_time= shift;
my$time= gmtime($epoch_time);
my@days= qw(Sun Mon Tue Wed Thu Fri Sat);
my@months= qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);