view release on metacpan or  search on metacpan

bin/fiesta  view on Meta::CPAN

			my @args = ("hash", "$virtusertable\.db");
			exec("makemap", @args) or die("Can't exec program: $!");
		}
	}
	exit();
}

#---rmlistfiles-------------------------------------------------------------

sub rmlistfiles {
	my $dirs = shift;
	my $list = shift;

	print "Clean mailing list directories and files:\n";
	my ($name, $domain) = split(/\@/, $list);
	for my $dir (@{$dirs}) {
		$dir =~ s/\/+$//;
		$dir =~ /\/salsa\/?/ or die("$!\n");
		unless(-d $dir) {
			print "The directory \"$dir\" not exists!\n";
			next;
		}
		opendir(DIRECTORY, $dir) or die("Can't opendir $dir: $!\n");
		while(defined(my $file = readdir(DIRECTORY))) {
			next if($file =~ /^\.\.?$/);
			$file eq $domain or next;
			(-d "$dir/$file") or next;
			my $path = join("/", $dir, $domain, $name);
			(-d $path) or next;

			opendir(DIR, $path) or die("Can't opendir $path: $!\n");
			while(defined(my $file = readdir(DIR))) {
				next if($file =~ /^\.\.?$/);
				unlink("$path/$file") or die("Couldn't unlink file $path/$file: $!");
				print "The file \"$path/$file\" has been removed...\n";
			}
			closedir(DIR);
			rmdir($path) or die("Couldn't remove dir $path: $!");
			print "The directory \"$path\" has been removed...\n";

			$path =~ s/\/[^\/]+$//;
			my $count = 0;
			opendir(DIR, $path) or die("Can't opendir $path: $!\n");
			while(defined(my $file = readdir(DIR))) {
				next if($file =~ /^\.\.?$/);
				$count++;
			}
			closedir(DIR);
			unless($count) {
				rmdir($path) or die("Couldn't remove dir $path: $!");
				print "The directory \"$path\" has been removed...\n";
			}
		}
		closedir(DIRECTORY);
	}
	return();
}

#---update_file-------------------------------------------------------------

sub update_file {
	my $file = shift;
	my $callback = shift;

	die("The file \"$file\.lock\" already exists: $!") if(-e "$file\.lock");
	my $notexist = 1;
	open(FILE, "<", $file) or die("$!");
	flock(FILE, LOCK_EX);
	open(UPDATE, ">", "$file\.lock") or die("$!");
	select(UPDATE);
	while(<FILE>) {
		if($notexist == 1 || $notexist == 3) {
			my $res = $callback->($notexist);
			if($res == 1) { next; }
			elsif($res == 2) { last; }
		}
		print UPDATE $_;
	}
	$notexist = 0 if($notexist == 3);
	close(UPDATE);
	flock(FILE, LOCK_UN);
	close(FILE);

	if($notexist) { unlink("$file\.lock") or die("$!"); }
	else { rename("$file\.lock", $file) or die("$!"); }
	select(STDOUT);

	return($notexist);
}

#---update_aliases----------------------------------------------------------

sub update_aliases {
	my $list = shift;
	my $file = shift;
	my $personalized = shift;

	my ($name, $domain) = split(/\@/, $list);
	my $pattern = "\^$name\\\_at_$domain\\\: +\\\"[^\\\"]+ (P[a-z]+)\\\"\\s\$";
	my $type = $personalized eq "yes" ? "Personalize" : "Post";

	my $callback = sub {
		if(/$pattern/) {
			my $oldtype = $1;
			if($type eq $oldtype) {
				$_[0] = 2;
				return(2);
			} else {
				s/$oldtype(?=\")/$type/;
				$_[0] = 0;
			}
		}
		return(0);
	};

	return(&update_file($file, $callback));
}

#---upadte_vutable----------------------------------------------------------

sub update_vutable {
	my $list = shift;
	my $file = shift;
	my $owner = shift;

	my ($name, $domain) = split(/\@/, $list);
	my $pattern = "\^$name-owner\\\@$domain\[ \\t\]\+(\[\^\\\@\]\+\\\@\[\^\\\@\]\+)\\s\$";

	my $callback = sub {
		if(/$pattern/) {
			if($1 eq $owner) {
				$_[0] = 2;
				return(2);
			} else {
				$_[0] = 0;
				$_ = "$name-owner\@$domain\t$owner\n";
			}
		}
		return(0);
	};
	return(&update_file($file, $callback));
}

#---remove_mlist------------------------------------------------------------

sub remove_mlist {
	my $file = shift;
	my $type = shift;
	my $list = shift;

	my ($name, $domain) = split(/\@/, $list);
	my %pattern = (
		'aliases' => "\^$name\-\?\[\^_\]\*_at_$domain\: \+",
		'vtable'  => "\^$name\-\?\[\^\@\]\*\@$domain\[ \\t\]\+"
	);

	my $callback = sub {
		if(/$pattern{$type}/) {
			$_[0] = 3;
			return(1);
		}
		return(0);
	};
	return(&update_file($file, $callback));
}

#---add_mlist---------------------------------------------------------------

sub add_mlist {
	my $file = shift;
	my $type = shift;
	my $list = shift;
	my $owner = shift;
	my $personalized = shift || "no";

	my ($name, $domain) = split(/\@/, $list);
	my $exist = 0;

	my %pattern = (
		'aliases' => "\^$name\_at_$domain\:\[ \\t\]\+",
		'vtable'  => "\^$list\[ \\t\]\+",