rt 4.2.14 (#13852)
[freeside.git] / rt / etc / upgrade / generate-rtaddressregexp.in
index a0787ca..9a097e9 100644 (file)
@@ -3,7 +3,7 @@
 #
 # COPYRIGHT:
 #
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+# This software is Copyright (c) 1996-2017 Best Practical Solutions, LLC
 #                                          <sales@bestpractical.com>
 #
 # (Except where explicitly superseded by other copyright notices)
 # those contributions and any derivatives thereof.
 #
 # END BPS TAGGED BLOCK }}}
+use 5.10.1;
 use strict;
 use warnings;
 
 use lib "@LOCAL_LIB_PATH@";
 use lib "@RT_LIB_PATH@";
 
-use RT;
-RT::LoadConfig();
-RT->Config->Set('LogToScreen' => 'debug');
-RT::Init();
-
-$| = 1;
+use RT::Interface::CLI qw(Init);
+Init();
 
 if (my $re = RT->Config->Get('RTAddressRegexp')) {
     print "No need to use this script, you already have RTAddressRegexp set to $re\n";
@@ -65,23 +62,45 @@ if (my $re = RT->Config->Get('RTAddressRegexp')) {
 }
 
 use RT::Queues;
-my $queues = RT::Queues->new( $RT::SystemUser );
+my $queues = RT::Queues->new( RT->SystemUser );
 $queues->UnLimit;
-$queues->RowsPerPage(100);
 
-my @addresses = (RT->Config->Get('CorrespondAddress'), RT->Config->Get('CommentAddress'));
+my %merged;
+merge(\%merged, RT->Config->Get('CorrespondAddress'), RT->Config->Get('CommentAddress'));
 while ( my $queue = $queues->Next ) {
-    push @addresses, $queue->CorrespondAddress, $queue->CommentAddress;
+    merge(\%merged, $queue->CorrespondAddress, $queue->CommentAddress);
 }
 
-my %seen;
-my $re = join '|', map "\Q$_\E",
-    grep defined && length && !$seen{ lc $_ }++,
-    @addresses;
+my @domains;
+for my $domain (sort keys %merged) {
+    my @addresses;
+    for my $base (sort keys %{$merged{$domain}}) {
+        my @subbits = keys(%{$merged{$domain}{$base}});
+        if (@subbits > 1) {
+            push @addresses, "\Q$base\E(?:".join("|",@subbits).")";
+        } else {
+            push @addresses, "\Q$base\E$subbits[0]";
+        }
+    }
+    if (@addresses > 1) {
+        push @domains, "(?:".join("|", @addresses).")\Q\@$domain\E";
+    } else {
+        push @domains, "$addresses[0]\Q\@$domain\E";
+    }
+}
+my $re = join "|", @domains;
 
 print <<ENDDESCRIPTION;
 You can add the following to RT_SiteConfig.pm, but may want to collapse it into a more efficient regexp.
 Keep in mind that this only contains the email addresses that RT knows about, you should also examine
 your mail system for aliases that reach RT but which RT doesn't know about.
 ENDDESCRIPTION
-print "Set(\$RTAddressRegexp,'^(?:${re})\$');\n";
+print "Set(\$RTAddressRegexp,qr{^(?:${re})\$}i);\n";
+
+sub merge {
+    my $merged = shift;
+    for my $address (grep {defined and length} @_) {
+        $address =~ /^\s*(.*?)(-comments?)?\@(.*?)\s*$/;
+        $merged->{lc $3}{$1}{$2||''}++;
+    }
+}