Mail-Salsa
view release on metacpan or search on metacpan
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) { 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/) {
}
}
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) {
lib/Mail/Salsa/Action/Admin.pm view on Meta::CPAN
}
sub normalize {
local $_ = shift;
if(/^($patterns[0]) +<($patterns[1])>\s+/) { return([lc($2), $1]); }
if(/^<?($patterns[1])>?\s+/) { return([lc($1), ""]); }
return(["", ""]);
}
sub update_file {
my $newfile = shift;
my $oldfile = shift;
open(NEW, "<", $newfile) or die("$!");
open(OLD, ">", $oldfile) or die("$!");
select(OLD);
while(<NEW>) {
s/\x0d//g;
print OLD $_;
}
lib/Mail/Salsa/Action/Admin.pm view on Meta::CPAN
my ($addr, $name) = @{&normalize($_)};
$addr ? ($_[0]->{$addr} = $name) : push(@error, "line $n: $_");
$n++;
}
close(FILE);
unlink($file) or die("$!");
return(\@error);
}
sub update_list {
my $list = shift;
my $hash = shift;
open(OLDLIST, "<", $list) or die("$!");
open(NEWLIST, ">", "$list\.new") or die("$!");
select(NEWLIST);
while(<OLDLIST>) {
my ($addr, $name) = @{&normalize($_)};
$addr or next;
if(exists($hash->{'unsubscribe'}->{$addr})) {
( run in 0.766 second using v1.01-cache-2.11-cpan-4d4bc49f3ae )