[perltidy] foerste hhsp-dovecot-0.1
authorMatthias Förste foerste@schlittermann.de
Tue, 13 Dec 2011 13:39:03 +0100
branchfoerste
changeset 64 6a6c18cddf46
parent 63 96f567261e87
child 65 f1a66928471f
[perltidy]
.perltidyrc
Common.pm
account.pm
acl.pm
--- a/.perltidyrc	Tue Dec 13 13:01:23 2011 +0100
+++ b/.perltidyrc	Tue Dec 13 13:39:03 2011 +0100
@@ -1,2 +1,2 @@
 -ce
--nolc
+-noll
--- a/Common.pm	Tue Dec 13 13:01:23 2011 +0100
+++ b/Common.pm	Tue Dec 13 13:39:03 2011 +0100
@@ -37,8 +37,7 @@
     imap_password  => { ARGS => "=s" },
     imap_quota =>
       { ARGS => "=i", DEFAULT => 300 * 1024 * 1024, ALIAS => "quota" },
-    imap_aclgroups => 
-      { ARGS => "=s", ALIAS => "aclgroups" },
+    imap_aclgroups => { ARGS => "=s", ALIAS => "aclgroups" },
 
     # dovecots mail_location (%1, %u & %d supported)
     imap_mail_location =>
@@ -56,11 +55,11 @@
     address  => { ARGS => "=s", ALIAS => "primary" },
 
     # * acl *
-    acl_admin => { ARGS => "=s" },
+    acl_admin    => { ARGS => "=s" },
     acl_password => { ARGS => "=s" },
-    folder   => { ARGS => ":s@" },
-    acl      => { ARGS => "=s" },
-    recursive => { ARGS => "!", DEFAULT => 0 },
+    folder       => { ARGS => ":s@" },
+    acl          => { ARGS => "=s" },
+    recursive    => { ARGS => "!", DEFAULT => 0 },
 
     # * alias * group *
     members => { ARGS => ":s" },
@@ -81,10 +80,10 @@
     ldap_oc_recipient   => { ARGS => "=s", DEFAULT => "XXXmailRecipient" },
     ldap_oc_accessgroup => { ARGS => "=s", DEFAULT => "XXXmailAccessGroup" },
 
-    ldap_at_address => { ARGS => "=s", DEFAULT => "XXXmailAddress" },
-    ldap_at_group   => { ARGS => "=s", DEFAULT => "XXXmailGroup" },
-    ldap_at_quota   => { ARGS => "=s", DEFAULT => "XXXmailQuota" },
-    ldap_at_aclgroups   => { ARGS => "=s", DEFAULT => "XXXmailACLGroups" },
+    ldap_at_address   => { ARGS => "=s", DEFAULT => "XXXmailAddress" },
+    ldap_at_group     => { ARGS => "=s", DEFAULT => "XXXmailGroup" },
+    ldap_at_quota     => { ARGS => "=s", DEFAULT => "XXXmailQuota" },
+    ldap_at_aclgroups => { ARGS => "=s", DEFAULT => "XXXmailACLGroups" },
     ldap_at_forwardingaddress =>
       { ARGS => "=s", DEFAULT => "XXXmailForwardingAddress" },
     ldap_at_primaryaddress =>
--- a/account.pm	Tue Dec 13 13:01:23 2011 +0100
+++ b/account.pm	Tue Dec 13 13:39:03 2011 +0100
@@ -190,7 +190,9 @@
 
             verbose('exists')
 
-        } elsif ( ($imap->login( $user, $pw ) or die $@) and $imap->capability->{acl} ) {
+        } elsif ( ( $imap->login( $user, $pw ) or die $@ )
+            and $imap->capability->{acl} )
+        {
 
             # wenn wir acl verwenden,
             #  * dann triggert 'list' acl file (und damit maildir) erzeugung
@@ -199,6 +201,7 @@
             #  (sofern wir das nicht eleganter über globale acl regeln können)
             #    (lra: sicht-, les- und administrierbar)
             my $f = $imap->list( '', '*' ) or die $@;
+
             #$imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@;
             verbose('ok');
 
@@ -325,10 +328,10 @@
 
             my $ag = $Cf->aclgroups;
 
-            if ($ag =~ /(^|,\s*)[+-]/) {
+            if ( $ag =~ /(^|,\s*)[+-]/ ) {
                 my %x;
-                @x{split /,/, $e->get_value(AT_ACLGROUPS)} = ();
-                for (split /,/, $ag) {
+                @x{ split /,/, $e->get_value(AT_ACLGROUPS) } = ();
+                for ( split /,/, $ag ) {
                     if (s/^-//) {
                         delete $x{$_};
                     } else {
@@ -440,7 +443,8 @@
             }
         }
 
-        print "Don't forget to remove acl entries for this user if any exist!\n";
+        print
+          "Don't forget to remove acl entries for this user if any exist!\n";
         verbose("\n");
 
     }
@@ -488,14 +492,14 @@
         $imap->login( "$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
 
         my %q;
-        if ($imap->capability->{quota}) {
+        if ( $imap->capability->{quota} ) {
 
             # prepare patterns for shared folders - we want to ignore them in
             # quota calculations (TODO: what happens if a user has/attempts to
             # create a folder with the name of a namespace? he could avoid
             # quota limits that way?)
             my $ns = $imap->namespace() or die $@;
-            my @p = map qr{^\Q$_->[0]\E}, (@{$ns->[1]}, @{$ns->[2]});
+            my @p = map qr{^\Q$_->[0]\E}, ( @{ $ns->[1] }, @{ $ns->[2] } );
 
             my $folders = $imap->list( '', '*' ) or die $@;
 
@@ -504,10 +508,11 @@
                 # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername]
                 #next if '\\Noselect' ~~ $f->[0];
                 # ignore shared folders
-                map { next if ( $f->[2] . $f->[1]) =~ $_ } @p;
+                map { next if ( $f->[2] . $f->[1] ) =~ $_ } @p;
                 my $q = $imap->getquotaroot( $f->[2] )
-                    or $@ eq q{IMAP Command : 'getquotaroot' failed. Response was : no - Not showing other users' quota.}
-                    or die $@;
+                  or $@ eq
+                  q{IMAP Command : 'getquotaroot' failed. Response was : no - Not showing other users' quota.}
+                  or die $@;
                 delete $q->{quotaroot};
                 %q = ( %q, %{$q} );
 
@@ -539,7 +544,7 @@
         print wrap( "\t", "\t\t", "Other Adresses: $ml\n" ) if $ml;
         print wrap( "\t", "\t\t", "Mail Groups: $mg\n" )    if $mg;
         print wrap( "\t", "\t\t", "Forwardings: $forw\n" )  if $forw;
-        print wrap( "\t", "\t\t", "ACL Groups: $ag\n" )  if $ag;
+        print wrap( "\t", "\t\t", "ACL Groups: $ag\n" )     if $ag;
 
     }
 }
--- a/acl.pm	Tue Dec 13 13:01:23 2011 +0100
+++ b/acl.pm	Tue Dec 13 13:39:03 2011 +0100
@@ -18,7 +18,7 @@
 use Term::ReadKey;
 
 my $Cf;
-my ( $ldap, $ubase, $abase );
+my ( $ldap, $ubase,        $abase );
 my ( $imap, $acl_password, $nspat );
 END { $imap and $imap = undef; }
 
@@ -80,22 +80,23 @@
     $imap = Mail::IMAPTalk->new(
         Server => $Cf->imap_server,
         Port   => $Cf->imap_port
-    )
-        or die "Can't connect to IMAP Server '", $Cf->imap_server,
-    "', Port '", $Cf->imap_port, "': ", $@;
+      )
+      or die "Can't connect to IMAP Server '", $Cf->imap_server,
+      "', Port '", $Cf->imap_port, "': ", $@;
     $imap->login( $Cf->acl_admin, $acl_password ) or die $@;
-    die "IMAP Server does not advertise acl support" unless $imap->capability->{acl};
+    die "IMAP Server does not advertise acl support"
+      unless $imap->capability->{acl};
 
     # requires an imap connection
     my $ns = $imap->namespace() or die "No public namespaces available: $@";
     $nspat = [];
-    for (@{$ns->[2]}) {
-        (my $n = $_->[0]) =~ s/$_->[1]$//;
-        push @{$nspat}, [qr/\Q$n\E($_->[1]|$)/, $_->[1]];
+    for ( @{ $ns->[2] } ) {
+        ( my $n = $_->[0] ) =~ s/$_->[1]$//;
+        push @{$nspat}, [ qr/\Q$n\E($_->[1]|$)/, $_->[1] ];
     }
 
-    if ( $Cf->add ) { _modify() }
-    elsif ( $Cf->delete ) { $Cf->acl('delete') ; _modify() }
+    if    ( $Cf->add )    { _modify() }
+    elsif ( $Cf->delete ) { $Cf->acl('delete'); _modify() }
     elsif ( $Cf->list )   { _list() }
     elsif ( $Cf->modify ) { _modify() }
     else { die "Need action (--add|--delete|--list|--modify)\n" }
@@ -110,23 +111,27 @@
     @ARGV or die "Need user(s)\n";
     $Cf->folder ~~ [] and die "Need folders(s)\n";
     $Cf->acl or die "Need acl\n";
-    $Cf->recursive and $Cf->create and die "Use either --recursive or --create but not both\n";
+    $Cf->recursive
+      and $Cf->create
+      and die "Use either --recursive or --create but not both\n";
 
     my $r = $ldap->search(
         base   => $ubase,
         filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")"
     );
     die $r->error if $r->code;
-    unless ($r->count) {
-        prompt('No matching user found in ldap. Continue? (y/N)', "n\n") =~ /y/i or exit 0;
+    unless ( $r->count ) {
+        prompt( 'No matching user found in ldap. Continue? (y/N)', "n\n" ) =~
+          /y/i
+          or exit 0;
         @users = @ARGV;
     }
 
-    while (my $e = ($r->shift_entry or shift @users)) {
+    while ( my $e = ( $r->shift_entry or shift @users ) ) {
 
-        my ($user, $dn);
+        my ( $user, $dn );
 
-        if (ref $e eq 'Net::LDAP::Entry') {
+        if ( ref $e eq 'Net::LDAP::Entry' ) {
             $user = $e->get_value("uid");
             $dn   = $e->dn;
         } else {
@@ -138,23 +143,27 @@
         verbose "$user:\n";
         verbose "\t$dn...\n";
 
-        for my $folder (@{$Cf->folder}) {
-
-            $imap->create($folder) or die "Can't create folder '$folder': $@" if $Cf->create;
+        for my $folder ( @{ $Cf->folder } ) {
 
-            for my $f (@{acl_folders($folder)}) {
+            $imap->create($folder)
+              or die "Can't create folder '$folder': $@"
+              if $Cf->create;
 
-                if ($Cf->acl eq 'delete') {
-                    $imap->deleteacl($f, $user) or die "Can't delete acl: $@";
+            for my $f ( @{ acl_folders($folder) } ) {
+
+                if ( $Cf->acl eq 'delete' ) {
+                    $imap->deleteacl( $f, $user ) or die "Can't delete acl: $@";
                     verbose "\t$f: none\n";
                 } else {
-                    $imap->setacl($f, $user, $Cf->acl) or die "Can't set acl: $@";
+                    $imap->setacl( $f, $user, $Cf->acl )
+                      or die "Can't set acl: $@";
                     verbose "\t$f: " . $Cf->acl . "\n";
                 }
 
             }
 
         }
+
         # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen
         #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) {
         #$e->add(objectClass => "iusMailOptions");
@@ -178,28 +187,31 @@
 
     die "option acl_admin required\n" unless $Cf->acl_admin;
 
-    if ($Cf->aclgroups) {
+    if ( $Cf->aclgroups ) {
 
-        warn "--folder option ignored when listing groups" unless $Cf->folder ~~ [];
+        warn "--folder option ignored when listing groups"
+          unless $Cf->folder ~~ [];
         list_groups(@ARGV);
 
     } elsif (@ARGV) {
 
-#        my $uid = $ARGV[0];
-#        # searching by more than use user may be too expensive
-#        die "Searching by more than one user not supported" unless @ARGV == 1 or $uid =~ /\*/;
+        #        my $uid = $ARGV[0];
+        #        # searching by more than use user may be too expensive
+        #        die "Searching by more than one user not supported" unless @ARGV == 1 or $uid =~ /\*/;
         #list_by_user($_) for @ARGV;
 
-        warn "--folder option ignored when listing by user" unless $Cf->folder ~~ [];
-        list_by_user($imap, @ARGV);
+        warn "--folder option ignored when listing by user"
+          unless $Cf->folder ~~ [];
+        list_by_user( $imap, @ARGV );
 
-    } elsif (not $Cf->folder ~~ []) {
+    } elsif ( not $Cf->folder ~~ [] ) {
 
-        list_by_folder($_) for @{$Cf->folder};
+        list_by_folder($_) for @{ $Cf->folder };
 
     } else {
 
-        die "Need either user or --folder. If you really want to search all users then supply the pattern '*'.";
+        die
+          "Need either user or --folder. If you really want to search all users then supply the pattern '*'.";
 
     }
 
@@ -210,33 +222,35 @@
     @_ = ('*') unless @_;
     my @ag = split ',', $Cf->imap_aclgroups;
     my $ag_att = AT_ACLGROUPS;
-    my $filter = "(&($ag_att=*)"
-               . "(|" . join( "", map { "(uid=$_)" } @_ ) . "))";
+    my $filter =
+      "(&($ag_att=*)" . "(|" . join( "", map { "(uid=$_)" } @_ ) . "))";
     my $r = $ldap->search(
-        attrs  => ['uid', AT_ACLGROUPS],
+        attrs  => [ 'uid', AT_ACLGROUPS ],
         filter => $filter,
         base   => $ubase,
     );
     die $r->error if $r->code;
 
-    unless ($r->count) {
-        print ("No aclgroups found in ldap\n");
+    unless ( $r->count ) {
+        print("No aclgroups found in ldap\n");
         exit 0;
     }
 
     my $users;
-    while (my $e = ($r->shift_entry)) {
+    while ( my $e = ( $r->shift_entry ) ) {
         my $uid = $e->get_value('uid');
         my @ag_cur = split ',', $e->get_value($ag_att);
         for (@ag) {
-            $users->{$_} = defined $users->{$_}
-            ? [@{$users->{$_}}, $uid]
-            : [ $uid ]
-            if $_ ~~ @ag_cur
+            $users->{$_} =
+              defined $users->{$_}
+              ? [ @{ $users->{$_} }, $uid ]
+              : [$uid]
+              if $_ ~~ @ag_cur;
         }
     }
 
-    print "$_:\n\t", join("\n\t", @{$users->{$_}}), "\n\n" for keys %{$users};
+    print "$_:\n\t", join( "\n\t", @{ $users->{$_} } ), "\n\n"
+      for keys %{$users};
 
 }
 
@@ -244,6 +258,7 @@
 
     my $imap = shift;
     my $filter = "(|" . join( "", map { "(uid=$_)" } @_ ) . ")";
+
     #my $filter = "(uid=$uid)";
     my $r = $ldap->search(
         filter => $filter,
@@ -251,18 +266,18 @@
     );
     die $r->error if $r->code;
     my @users;
-    unless ($r->count) {
+    unless ( $r->count ) {
         verbose("No matching users found in ldap.\n");
         @users = @_;
     }
 
-    while (my $e = ($r->shift_entry or shift @users)) {
+    while ( my $e = ( $r->shift_entry or shift @users ) ) {
 
-        my ($uid, $cn, $mr);
-        if (ref $e eq 'Net::LDAP::Entry') {
-            $uid  = $e->get_value("uid");
-            $cn   = join( ", ", $e->get_value("cn") );
-            $mr   = $e->get_value(AT_PRIMARYADDRESS) || "";                  # ??
+        my ( $uid, $cn, $mr );
+        if ( ref $e eq 'Net::LDAP::Entry' ) {
+            $uid = $e->get_value("uid");
+            $cn  = join( ", ", $e->get_value("cn") );
+            $mr  = $e->get_value(AT_PRIMARYADDRESS) || "";    # ??
         } else {
             $uid = $e;
             $cn  = '[cn not available]';
@@ -275,7 +290,9 @@
         #print " INTERNAL";
         #}
 
-        die "IMAP Server does not advertise acl support" unless $imap->capability->{acl};
+        die "IMAP Server does not advertise acl support"
+          unless $imap->capability->{acl};
+
         # namespace() result looks like this
         # [
         #   [   # list of private namespace(s)
@@ -300,16 +317,17 @@
         #   ]
         my $hasacl;
         my $ns = $imap->namespace() or die "No public namespaces available: $@";
+
         # uns interessieren nur 'public' namespaces
-        for my $n (@{$ns->[2]}) {
+        for my $n ( @{ $ns->[2] } ) {
 
             my $folders = imap_rlist( '', $n->[0], $n->[1] );
             for my $f ( @{$folders} ) {
 
                 #next if '\\Noselect' ~~ $f->[0];
-                my $perms = $imap->getacl( $f ) or die "Can't getacl '$f': $@";
-                my ($u, $p);
-                while ($u = shift @{$perms} and $p = shift @{$perms}) { 
+                my $perms = $imap->getacl($f) or die "Can't getacl '$f': $@";
+                my ( $u, $p );
+                while ( $u = shift @{$perms} and $p = shift @{$perms} ) {
                     next unless $u eq $uid;
                     $hasacl = 1;
                     print "\t$f: $u [$p]\n";
@@ -319,7 +337,8 @@
 
         }
 
-        print "\tno acl found on listable folders in shared namespaces\n" unless $hasacl;
+        print "\tno acl found on listable folders in shared namespaces\n"
+          unless $hasacl;
         print "\n";
 
     }
@@ -330,18 +349,18 @@
 
     my ($folder) = @_;
 
-    for my $f ( @{acl_folders($folder)} ) {
+    for my $f ( @{ acl_folders($folder) } ) {
 
         my $hasacl;
         print "$f\n";
 
-        my $perms = $imap->getacl( $f ) or die $@;
-        my ($u, $p);
-        while ($u = shift @{$perms} and $p = shift @{$perms}) {
+        my $perms = $imap->getacl($f) or die $@;
+        my ( $u, $p );
+        while ( $u = shift @{$perms} and $p = shift @{$perms} ) {
 
             # '#user' will be listed when we have a global acl for 'user'
-            my $gl = $u =~ /^#/ ? ' [global acl]' : '';
-            my $gr = $u =~ /^\$/ ? ' [group acl]' : '';
+            my $gl = $u =~ /^#/  ? ' [global acl]' : '';
+            my $gr = $u =~ /^\$/ ? ' [group acl]'  : '';
             $hasacl = 1;
             print "\t$u [$p]$gr$gl\n";
         }
@@ -382,11 +401,14 @@
 
 sub imap_list($$) {
 
-    my ($ref, $folder) = @_;
+    my ( $ref, $folder ) = @_;
 
-    my $list = $imap->list($ref, $folder) or die "Can't list('$ref', '$folder'): $@";
+    my $list = $imap->list( $ref, $folder )
+      or die "Can't list('$ref', '$folder'): $@";
+
     # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername]
     ref $list and return [ map $_->[2], @{$list} ];
+
     # assuming empty result list otherwise
     return [];
 
@@ -394,11 +416,11 @@
 
 sub imap_rlist($$$) {
 
-    my ($ref, $folder, $sep) = @_;
+    my ( $ref, $folder, $sep ) = @_;
     $folder =~ s/$sep+$//;
 
-    my $list = imap_list($ref, $folder);
-    push @{$list}, @{imap_list($ref, "$folder$sep*")} if $Cf->recursive;
+    my $list = imap_list( $ref, $folder );
+    push @{$list}, @{ imap_list( $ref, "$folder$sep*" ) } if $Cf->recursive;
     return $list;
 }
 
@@ -407,10 +429,11 @@
     my ($f) = @_;
     my $folders;
 
-    for my $np (@{$nspat}) {
+    for my $np ( @{$nspat} ) {
+
         # don't modify $f!
-        (my $ft = $f) =~ s/$np->[1]$//;
-        return imap_rlist('', $f, $np->[1]) if ($ft =~ /$np->[0]/);
+        ( my $ft = $f ) =~ s/$np->[1]$//;
+        return imap_rlist( '', $f, $np->[1] ) if ( $ft =~ /$np->[0]/ );
     }
 
     die "Foldername '$f' must begin with the name of a shared namespace\n";
@@ -418,11 +441,13 @@
 }
 
 sub prompt($$) {
-    my ($prompt, $default) = @_;
-    print $prompt, substr($default, 0, 1), "\b";
-    ReadMode 4; my $r = ReadKey(0); ReadMode 0;
-    if ($r eq "\n") { $r = $default }
-    else { $r .= substr($default, 1) }
+    my ( $prompt, $default ) = @_;
+    print $prompt, substr( $default, 0, 1 ), "\b";
+    ReadMode 4;
+    my $r = ReadKey(0);
+    ReadMode 0;
+    if ( $r eq "\n" ) { $r = $default }
+    else              { $r .= substr( $default, 1 ) }
     print $r;
     return $r;
 }