delete.cgi

来自「学生信息系统,这个程序设置非常简单」· CGI 代码 · 共 32 行

sub delete {
my $dpath=shift;
return if ($dpath =~ /\.$/ || !-d "$dpath");
my $dpathbak=$dpath;
my $dpathtop=substr($dpathbak,0,rindex($dpathbak,"/")); 
  $dlist=0;
while(1) {
  $dlist++;
  my @fileinfo=&opendir($dpath);
  last if (($#fileinfo<0 && $dpath eq $dpathbak) || $dpath eq $dpathtop || $dlist>100);
  $newdpath=$dpath;
    foreach (@fileinfo) {
	if (-d "$dpath/$_") {$newdpath="$dpath/$_" if ($newdpath eq $dpath);}
	elsif (-e "$dpath/$_") {unlink "$dpath/$_";}
    }
    if ($newdpath eq $dpath) {
	rmdir "$dpath";
	$dpath=substr($dpath,0,rindex($dpath,"/")); 
    } else {$dpath=$newdpath;}
}
rmdir  "$dpathbak";
if (-d "$dpathbak") {return 0;} else {return 1;}

sub opendir {
	my $delpath=shift;
	opendir(DIR, "$delpath");
	my @fileinfo = readdir(DIR);
	closedir(DIR);
	@fileinfo = grep(/\w+/, @fileinfo);
	return @fileinfo;
}
}