--- a/update-mailboxes Wed May 28 13:51:32 2008 +0000
+++ b/update-mailboxes Thu Jul 17 07:59:44 2008 +0000
@@ -24,16 +24,16 @@
my $opt_help = 0;
my $opt_man = 0;
my $opt_verbose = -t STDOUT;
-my $opt_dry = 0;
+my $opt_dry = 0;
sub get_credentials($$);
-my ( $USER, $PASS ) = get_credentials( $PRIVATE => "cyrusadmin" );
-my ( $LDAPADMIN, $LDAPPASS ) = get_credentials( $PRIVATE => "ldapadmin" );
+my ($USER, $PASS) = get_credentials($PRIVATE => "cyrusadmin");
+my ($LDAPADMIN, $LDAPPASS) = get_credentials($PRIVATE => "ldapadmin");
-my ( $LDAPBASE, $LDAPSERVER );
+my ($LDAPBASE, $LDAPSERVER);
{
- open( my $in, $LDAPCONF );
+ open(my $in, $LDAPCONF);
$_ = join "", <$in>;
($LDAPBASE) = /^\s*BASE\s+(.*?)\s*$/ms;
($LDAPSERVER) = /^\s*URI\s+(.*?)\s*$/ms;
@@ -41,12 +41,12 @@
my @OU;
{
- open( my $in, $OULIST );
+ open(my $in, $OULIST);
@OU = grep /^(?!#)\S+/, map { /(\S+)/; $1 } <$in>;
}
my %BLACK;
-if ( open( my $in, $BLACKLIST ) ) {
+if (open(my $in, $BLACKLIST)) {
while (<$in>) {
chomp;
s/#.*//;
@@ -62,16 +62,16 @@
"p|protocol=s" => \$opt_protocol,
"d|delete" => \$opt_delete,
"v|verbose!" => \$opt_verbose,
- "n|dry!" => \$opt_dry,
+ "n|dry!" => \$opt_dry,
"man" => \$opt_man,
"help" => \$opt_help,
) or pod2usage();
- pod2usage( -exitval => 0, -verbose => 3 ) if $opt_man;
- pod2usage( -exitval => 0, -verbose => 1 ) if $opt_help;
+ pod2usage(-exitval => 0, -verbose => 3) if $opt_man;
+ pod2usage(-exitval => 0, -verbose => 1) if $opt_help;
$opt_verbose and $| = 1
- or open( STDOUT, ">/dev/null" );
+ or open(STDOUT, ">/dev/null");
# IMAP anzapfen
my $imap = new Mail::IMAPClient(
@@ -88,18 +88,18 @@
my @entries;
{
- my $ldap = new Net::LDAP( $LDAPSERVER, onerror => "die" );
- $ldap->bind( $LDAPADMIN, password => $LDAPPASS );
+ my $ldap = new Net::LDAP($LDAPSERVER, onerror => "die");
+ $ldap->bind($LDAPADMIN, password => $LDAPPASS);
foreach my $ou (@OU) {
- eval {
- my $msg = $ldap->search(
- base => "$ou,$LDAPBASE",
- filter => "(&(samAccountName=*))",
- attrs => ["samAccountName"],
- );
- push @entries, $msg->entries;
- };
- warn "problem using $ou,$LDAPBASE: $@\n" if $@;
+ eval {
+ my $msg = $ldap->search(
+ base => "$ou,$LDAPBASE",
+ filter => "(&(samAccountName=*))",
+ attrs => ["samAccountName"],
+ );
+ push @entries, $msg->entries;
+ };
+ warn "problem using $ou,$LDAPBASE: $@\n" if $@;
}
}
@@ -110,7 +110,7 @@
my $mbox = $e->get_value("samAccountName");
- if ( $BLACK{$mbox} ) {
+ if ($BLACK{$mbox}) {
print "$mbox blacklisted\n";
next;
}
@@ -119,20 +119,20 @@
print "$folder: ";
- if ( $imap->exists($folder) ) {
+ if ($imap->exists($folder)) {
print "exists\n";
$mbox{$mbox} = $folder;
next;
}
- if ($opt_dry) {
- $mbox{$mbox} = $folder;
- print " doing nothing (dry run)\n";
- next;
- }
+ if ($opt_dry) {
+ $mbox{$mbox} = $folder;
+ print " doing nothing (dry run)\n";
+ next;
+ }
print "creating ";
- if ( !$imap->create($folder) ) {
+ if (!$imap->create($folder)) {
warn "$folder: $@\n";
next;
}
@@ -140,7 +140,7 @@
$mbox{$mbox} = $folder;
print "acl ";
- if ( !$imap->setacl( $folder, $USER, "lrswipcda" ) ) {
+ if (!$imap->setacl($folder, $USER, "lrswipcda")) {
warn "$folder: $@\n";
next;
}
@@ -153,44 +153,43 @@
# now check if there are still folders we didn't touch;
delete @folder{ map { "user/$_" } keys %mbox };
- if ( keys %folder ) {
- print scalar( keys %folder )
+ if (keys %folder) {
+ print scalar(keys %folder)
. " unused mailboxe(s):\n" . "\t"
- . join( "\n\t", keys %folder ) . "\n";
+ . join("\n\t", keys %folder) . "\n";
if ($opt_delete && $opt_dry == 0) {
print "deleting unused mailboxes\n";
- foreach ( keys %folder ) {
+ foreach (keys %folder) {
print "$_ ";
$imap->delete($_) and print "ok\n"
or warn "$_: ($@)\n";
}
}
else {
- %mbox = ( %mbox, %folder );
+ %mbox = (%mbox, %folder);
}
}
if ($opt_protocol) {
- open( my $o, ">$opt_protocol" )
+ open(my $o, ">$opt_protocol")
or die "Can't open >$opt_protocol: $!\n";
print $o join "\n", "# Liste der Mailboxen (nur zur Info)",
"# updater: $0 "
. '($Id$)',
- sort( keys %mbox ), "";
+ sort(keys %mbox), "";
}
exit 0;
}
sub get_credentials($$) {
- my ( $file, $pattern ) = @_;
- open( my $fh, $file ) or die "Can't open $file: $!\n";
- my ( undef, $u, $p ) =
- ( split /\s*:\s*/, ( grep /^$pattern\s*:/, <$fh> )[0] );
- chomp( $u, $p );
- return ( $u, $p );
+ my ($file, $pattern) = @_;
+ open(my $fh, $file) or die "Can't open $file: $!\n";
+ my (undef, $u, $p) = (split /\s*:\s*/, (grep /^$pattern\s*:/, <$fh>)[0]);
+ chomp($u, $p);
+ return ($u, $p);
}
__END__