[Rt-commit] r12024 - in rt/branches/3.8-TESTING: . etc etc/upgrade/3.7.85 html/installation lib lib/RT lib/RT/Action sbin t/maildigest

jesse at bestpractical.com jesse at bestpractical.com
Fri May 2 19:13:40 EDT 2008


Author: jesse
Date: Fri May  2 19:13:40 2008
New Revision: 12024

Added:
   rt/branches/3.8-TESTING/etc/upgrade/3.7.85/
   rt/branches/3.8-TESTING/etc/upgrade/3.7.85/content
   rt/branches/3.8-TESTING/lib/RT/FauxObject.pm
   rt/branches/3.8-TESTING/sbin/rt-send-digest.in
   rt/branches/3.8-TESTING/t/maildigest/
   rt/branches/3.8-TESTING/t/maildigest/attributes.t
Modified:
   rt/branches/3.8-TESTING/   (props changed)
   rt/branches/3.8-TESTING/Makefile.in
   rt/branches/3.8-TESTING/README
   rt/branches/3.8-TESTING/configure.ac
   rt/branches/3.8-TESTING/etc/initialdata
   rt/branches/3.8-TESTING/html/NoAuth/css/web2/boxes.css
   rt/branches/3.8-TESTING/html/NoAuth/css/web2/layout.css
   rt/branches/3.8-TESTING/html/installation/Basics.html
   rt/branches/3.8-TESTING/html/installation/DatabaseDetails.html
   rt/branches/3.8-TESTING/html/installation/Finish.html
   rt/branches/3.8-TESTING/html/installation/Initialize.html
   rt/branches/3.8-TESTING/html/installation/Sendmail.html
   rt/branches/3.8-TESTING/lib/RT.pm.in
   rt/branches/3.8-TESTING/lib/RT/Action/SendEmail.pm
   rt/branches/3.8-TESTING/lib/RT/Config.pm
   rt/branches/3.8-TESTING/lib/RT/Dashboard.pm
   rt/branches/3.8-TESTING/lib/RT/Installer.pm
   rt/branches/3.8-TESTING/lib/RT/SavedSearch.pm
   rt/branches/3.8-TESTING/lib/RT/Transaction_Overlay.pm
   rt/branches/3.8-TESTING/sbin/rt-setup-database.in

Log:
 r30390 at 54:  jesse | 2008-05-02 19:13:18 -0400
 * Revert the last commit which was a mistaken mass-revert


Modified: rt/branches/3.8-TESTING/Makefile.in
==============================================================================
--- rt/branches/3.8-TESTING/Makefile.in	(original)
+++ rt/branches/3.8-TESTING/Makefile.in	Fri May  2 19:13:40 2008
@@ -137,6 +137,8 @@
 RT_MAILGATE_BIN		=	$(RT_BIN_PATH)/rt-mailgate
 # RT's cron tool
 RT_CRON_BIN		=	$(RT_BIN_PATH)/rt-crontool
+# RT's dashboard emailer
+RT_DASHBOARD_BIN		=	$(RT_BIN_PATH)/rt-email-dashboards
 
 # }}}
 
@@ -145,12 +147,14 @@
 				$(DESTDIR)/$(RT_MAILGATE_BIN) \
 				$(DESTDIR)/$(RT_CLI_BIN) \
 				$(DESTDIR)/$(RT_CRON_BIN) \
+				$(DESTDIR)/$(RT_DASHBOARD_BIN) \
 				$(DESTDIR)/$(RT_STANDALONE_SERVER) \
 				$(DESTDIR)/$(RT_SPEEDYCGI_HANDLER) \
 				$(DESTDIR)/$(RT_FASTCGI_HANDLER) \
 				$(DESTDIR)/$(RT_WIN32_FASTCGI_HANDLER)
 SYSTEM_BINARIES		=	$(DESTDIR)/$(RT_SBIN_PATH)/rt-dump-database \
 				$(DESTDIR)/$(RT_SBIN_PATH)/rt-setup-database \
+				$(DESTDIR)/$(RT_SBIN_PATH)/rt-send-digest \
 				$(DESTDIR)/$(RT_SBIN_PATH)/rt-test-dependencies \
 				$(DESTDIR)/$(RT_SBIN_PATH)/rt-clean-sessions \
 				$(DESTDIR)/$(RT_SBIN_PATH)/rt-shredder \
@@ -450,7 +454,8 @@
 bin-install:
 	mkdir -p $(DESTDIR)/$(RT_BIN_PATH)
 	chmod +x bin/rt-mailgate \
-		bin/rt-crontool
+		bin/rt-crontool \
+		bin/rt-email-dashboards
 	-cp -rp \
 		bin/rt-mailgate \
 		bin/mason_handler.fcgi \
@@ -460,6 +465,7 @@
 		bin/rt \
 		bin/webmux.pl \
 		bin/rt-crontool \
+		bin/rt-email-dashboards \
 		$(DESTDIR)/$(RT_BIN_PATH)
 # }}}
 

Modified: rt/branches/3.8-TESTING/README
==============================================================================
--- rt/branches/3.8-TESTING/README	(original)
+++ rt/branches/3.8-TESTING/README	Fri May  2 19:13:40 2008
@@ -168,8 +168,20 @@
 
     NOTE: root's password for the web interface is "password" 
     (without the quotes).  Not changing this is a SECURITY risk!
-    
-10   Set up users, groups, queues, scrips and access control.
+ 
+10  Set up automated recurring tasks (cronjobs):
+
+    To generate email digest messages, you must arrange for the provided
+    utility to be run once daily, and once weekly.  For example, if
+    your task scheduler is cron, you can configure it as follows:
+
+        crontab -e    # as the RT administrator (probably root)
+        # insert the following lines:
+        0 0 * * * /opt/rt3/sbin/rt-send-digest -m daily
+        0 0 * * 0 /opt/rt3/sbin/rt-send-digest -m weekly
+
+
+11   Set up users, groups, queues, scrips and access control.
 
     Until you do this, RT will not be able to send or receive email,
     nor will it be more than marginally functional.  This is not an

Modified: rt/branches/3.8-TESTING/configure.ac
==============================================================================
--- rt/branches/3.8-TESTING/configure.ac	(original)
+++ rt/branches/3.8-TESTING/configure.ac	Fri May  2 19:13:40 2008
@@ -375,6 +375,7 @@
                  sbin/rt-dump-database
                  sbin/rt-setup-database
                  sbin/rt-test-dependencies
+                 sbin/rt-send-digest
                  sbin/rt-clean-sessions
                  sbin/rt-shredder
                  sbin/rt-validator
@@ -383,6 +384,7 @@
                  bin/mason_handler.scgi
                  bin/standalone_httpd
                  bin/rt-crontool
+                 bin/rt-email-dashboards
                  bin/rt-mailgate
                  bin/rt],
                 [chmod ug+x $ac_file]

Modified: rt/branches/3.8-TESTING/etc/initialdata
==============================================================================
--- rt/branches/3.8-TESTING/etc/initialdata	(original)
+++ rt/branches/3.8-TESTING/etc/initialdata	Fri May  2 19:13:40 2008
@@ -418,6 +418,16 @@
   {$NewPassword}
 }
     },
+
+	       {   Queue       => '0',
+		   Name        => 'Email Digest',    # loc
+		   Description => 'Email template for periodic notification digests',  # loc
+		   Content => q[Subject: RT Email Digest
+
+{ $Argument }
+],
+               },
+
 );
 # }}}
 

Added: rt/branches/3.8-TESTING/etc/upgrade/3.7.85/content
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/etc/upgrade/3.7.85/content	Fri May  2 19:13:40 2008
@@ -0,0 +1,11 @@
+ at Templates = ( 
+	       
+	       {   Queue       => '0',
+		   Name        => 'Email Digest',    # loc
+		   Description => 'Email template for periodic notification digests',  # loc
+		   Content => q[Subject: RT Email Digest
+
+{ $Argument }
+],
+               },
+);

Modified: rt/branches/3.8-TESTING/html/NoAuth/css/web2/boxes.css
==============================================================================
--- rt/branches/3.8-TESTING/html/NoAuth/css/web2/boxes.css	(original)
+++ rt/branches/3.8-TESTING/html/NoAuth/css/web2/boxes.css	Fri May  2 19:13:40 2008
@@ -69,15 +69,22 @@
 .titlebox .titlebox { 
 
  background-color: #ffffff;
- padding-top: 1em;
  margin-top: 1em;
  -moz-border-radius: 0.5em;
  -webkit-border-radius: 0.5em;
- margin-right: 1em;
+ margin-right: 0.25em;
  
 }
 
 
+.titlebox {
+ margin-left: 0em;
+ margin-right: 0em;
+
+
+}
+
+
 
 .titlebox .titlebox-title {
  position: relative;
@@ -187,3 +194,6 @@
     background-image: url(/NoAuth/images//css/rolldown-arrow.gif);
 }
 
+}
+
+

Modified: rt/branches/3.8-TESTING/html/NoAuth/css/web2/layout.css
==============================================================================
--- rt/branches/3.8-TESTING/html/NoAuth/css/web2/layout.css	(original)
+++ rt/branches/3.8-TESTING/html/NoAuth/css/web2/layout.css	Fri May  2 19:13:40 2008
@@ -210,4 +210,7 @@
  color: #fff;
 }
 
+body#comp-index td.boxcontainer {
+    padding-right: 1em;
+}
 

Modified: rt/branches/3.8-TESTING/html/installation/Basics.html
==============================================================================
--- rt/branches/3.8-TESTING/html/installation/Basics.html	(original)
+++ rt/branches/3.8-TESTING/html/installation/Basics.html	Fri May  2 19:13:40 2008
@@ -62,7 +62,6 @@
 
 <%init>
 my @results;
-push @results, 'Connected Database with success!' unless $RT::Installer->{InstallConfig}{DatabaseType} eq 'SQLite';
 
 my @Types = qw/rtname Organization MinimumPasswordLength Timezone/;
 
@@ -82,8 +81,8 @@
         RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
 'installation/DatabaseDetails.html');
     }
-    if ( $RT::Installer->{InstallConfig}{DatabaseType} eq 'SQLite' ?
-            @results == 0 : @results == 1 ) {
+
+    unless ( @results ) {
         RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
 'installation/Emails.html');
     }

Modified: rt/branches/3.8-TESTING/html/installation/DatabaseDetails.html
==============================================================================
--- rt/branches/3.8-TESTING/html/installation/DatabaseDetails.html	(original)
+++ rt/branches/3.8-TESTING/html/installation/DatabaseDetails.html	Fri May  2 19:13:40 2008
@@ -54,9 +54,15 @@
     CurrentValue => RT::Installer->CurrentValues(@Types) &>
 <input type="hidden" name="Run" value="1">
 
-<& /Elements/Submit, Label => $RT::Installer->{InstallConfig}{DatabaseType} eq
-'SQLite' ? loc('Next: Customize Basics') : loc('Next: Check Database Connectivity'), Back => 1, BackLabel => loc('Back: Select Database Type'),
+<& /Elements/Submit, Label => loc('Next: Check Database Connectivity'), 
+Back => 1, BackLabel => loc('Back: Select Database Type'),
 &>
+
+% if ( $results[0] eq 'connect succeed!' ) {
+<& /Elements/Submit, Label => loc('Next: Customize Basics'), Name => 'Next' &>
+% }
+
+
 </form>
 </&>
 <%init>
@@ -75,39 +81,78 @@
 
 if ( $Run ) {
 
-    $m->comp('/Widgets/BulkProcess', Types => \@Types, Arguments => \%ARGS, Store
-            => $RT::Installer->{InstallConfig}, Meta =>
-            $RT::Installer->{Meta}, KeepUndef => 1 ); 
+    $m->comp('/Widgets/BulkProcess', Types => \@Types, Arguments => \%ARGS, 
+            Store => $RT::Installer->{InstallConfig}, 
+            Meta => $RT::Installer->{Meta}, KeepUndef => 1 ); 
     if ( $Back ) {
         RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
 'installation/DatabaseType.html');
     }
-
-    my $handle = DBIx::SearchBuilder::Handle->new();
-    my $db_type = $RT::Installer->{InstallConfig}{DatabaseType};
-    
-    my $dsn;
-    $dsn = "dbi:$db_type:";
-    if ( $db_type eq 'Pg' ) {
-        # with postgres, you want to connect to template1 database
-        $dsn .= 'dbname=template1';
-    }
-    $dsn .= ";host=$ARGS{DatabaseHost}" if $ARGS{DatabaseHost};
-    $dsn .= ";port=$ARGS{DatabasePort}" if $ARGS{DatabasePort};
-    $dsn .= ";requiressl=1" if $ARGS{DatabaseRequireSSL};
     
-    my $dbh = DBI->connect(
-        $dsn, $ARGS{DatabaseUser}, $ARGS{DatabasePassword},
-        { RaiseError => 0, PrintError => 0 },
-    );
-
-    if ( $dbh ) {
+    if ( $ARGS{Next} ) {
         RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
 'installation/Basics.html');
     }
+
+    my ( $status, $msg ) = RT::Installer->SaveConfig;
+    if ( $status ) {
+        RT->LoadConfig;
+    # dba connect systemdsn
+        my $dbh = DBI->connect(
+            RT::Handle->SystemDSN, $ARGS{DatabaseAdmin}, $ARGS{DatabaseAdminPassword}, { RaiseError => 0, PrintError => 0 },
+        );
+    
+        if ( $dbh ) {
+            push @results, 'connect succeed!';
+            # dba connect dsn, which has table info
+            $dbh = DBI->connect(
+                RT::Handle->DSN, $ARGS{DatabaseAdmin}, $ARGS{DatabaseAdminPassword}, { RaiseError => 0, PrintError => 0 },
+            );
+    
+            if ( $dbh ) {
+                # check if Tickets table exists
+                my $sth = $dbh->table_info('', '', 'Tickets', 'TABLE');
+                # get 'Tickets' if it exists
+                if ( ($sth->fetchrow_array)[2] ) {
+    
+                    $sth = $dbh->prepare('select id from Users where Name=?');
+                    $sth->execute('RT_System'); 
+                    if ( $sth->fetchrow_array ) {
+                        $RT::Installer->{DatabaseAction} = 'none';
+                        push @results, "Database $RT::DatabaseName seems complete,
+    don't need to initialize any more.";
+                    }
+                    else {
+                        $RT::Installer->{DatabaseAction} = 'acl,coredata,insert';
+                        push @results, "Database $RT::DatabaseName already exists 
+    and has RT tables in place, but does not contain RT's metadata. 'Initialize
+    Database' later can use this existing db and tables and insert metadata, if this's ok, click 'Customize Baisc' below to go on customizing RT";
+                    }
+                }
+                else {
+                    $RT::Installer->{DatabaseAction} = 'schema,acl,coredata,insert';
+                    push @results, "Database $RT::DatabaseName already exists, but
+    does not contain RT's tables and metadata. 'Initialize Database' later can use
+    this existing db and insert tables and metadata, if this's ok, click
+    'Customize Baisc' below to go on customizing RT";
+                }
+    
+            }
+            else {
+                $RT::Installer->{DatabaseAction} =
+    'create,schema,acl,coredata,insert';
+            }
+        }
+        else {
+            $RT::Installer->{DatabaseAction} = 'error';
+            push @results, "Failed to connect: $DBI::errstr";
+        }
+    }
     else {
-        push @results, "Failed to connect: $DBI::errstr";
+        push @results, $msg;
     }
+
+
 }
 
 </%init>

Modified: rt/branches/3.8-TESTING/html/installation/Finish.html
==============================================================================
--- rt/branches/3.8-TESTING/html/installation/Finish.html	(original)
+++ rt/branches/3.8-TESTING/html/installation/Finish.html	Fri May  2 19:13:40 2008
@@ -62,4 +62,25 @@
 it as you want.
 </p>
 </div>
+
+<form method="post">
+<input type="hidden" value="1" name="Run" />
+<& /Elements/Submit, Label => 'Start RT Journey!' &>
+</form>
+
 </&>
+<%init>
+if ( $Run ) {
+    RT->InstallMode(0);
+    RT->LoadConfig;
+    RT->ConnectToDatabase();
+    RT->InitSystemObjects();
+    RT->InitClasses();
+    RT->InitPlugins();
+    RT::Interface::Web::Redirect(RT->Config->Get('WebURL'));
+}
+</%init>
+
+<%args>
+$Run => undef
+</%args>

Modified: rt/branches/3.8-TESTING/html/installation/Initialize.html
==============================================================================
--- rt/branches/3.8-TESTING/html/installation/Initialize.html	(original)
+++ rt/branches/3.8-TESTING/html/installation/Initialize.html	Fri May  2 19:13:40 2008
@@ -69,11 +69,61 @@
 'installation/Sendmail.html');
     }
 
-    my $msg = `echo | $^X sbin/rt-setup-database --action init --dba $RT::Installer->{InstallConfig}{DatabaseUser} --dba-password '$RT::Installer->{InstallConfig}{DatabasePassword}' 2>&1`;
-    @results = split /\n/, $msg;
-# XXX $? doesn't work here, so I decided to grep the strings to find if any
-# error happens
-    unless ( grep { /^ERROR:|aborted/ } @results ) {
+    my @actions = split /,/, $RT::Installer->{DatabaseAction};
+
+    my $sysdbh = DBI->connect(
+        RT::Handle->SystemDSN,
+        $RT::Installer->{InstallConfig}{DatabaseAdmin},
+        $RT::Installer->{InstallConfig}{DatabaseAdminPassword}, 
+        { RaiseError => 0, PrintError => 0 },
+    );
+    die $DBI::errstr unless $sysdbh;
+
+    my ( $status, $msg ) = ( 1, '' );
+    if ( shift @actions eq 'create' ) {
+        ($status, $msg) = RT::Handle->CreateDatabase( $sysdbh );
+        unless ( $status ) {
+            push @results, "ERROR: $msg";
+        }
+    }
+
+    if ( $status ) {
+        my $dbh = DBI->connect(
+            RT::Handle->DSN, $RT::Installer->{InstallConfig}{DatabaseAdmin},
+            $RT::Installer->{InstallConfig}{DatabaseAdminPassword}, 
+            { RaiseError => 0, PrintError => 0 },
+        );
+        die $DBI::errstr unless $dbh;
+
+        foreach my $action ( @actions ) {
+            ($status, $msg) = (1, '');
+            if ( $action eq 'schema' ) {
+                ($status, $msg) = RT::Handle->InsertSchema( $dbh );
+            }
+            elsif ( $action eq 'acl' ) {
+                ($status, $msg) = RT::Handle->InsertACL( $dbh );
+            }
+            elsif ( $action eq 'coredata' ) {
+                $RT::Handle = new RT::Handle;
+                $RT::Handle->dbh( undef );
+                RT::ConnectToDatabase();
+                RT::InitLogging();
+                ($status, $msg) = $RT::Handle->InsertInitialData;
+            }
+            elsif ( $action eq 'insert' ) {
+                $RT::Handle = new RT::Handle;
+                RT::Init();
+                my $file = $RT::EtcPath . "/initialdata";
+                ($status, $msg) = $RT::Handle->InsertData( $file );
+            }
+            unless ( $status ) {
+                push @results, "ERROR: $msg";
+                last;
+            }
+        }
+    }
+
+    unless ( @results ) {
         RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
 'installation/Finish.html');
     }

Modified: rt/branches/3.8-TESTING/html/installation/Sendmail.html
==============================================================================
--- rt/branches/3.8-TESTING/html/installation/Sendmail.html	(original)
+++ rt/branches/3.8-TESTING/html/installation/Sendmail.html	Fri May  2 19:13:40 2008
@@ -58,7 +58,8 @@
     CurrentValue => RT::Installer->CurrentValues(@Types) &>
 
 <input type="hidden" name="Run" value="1">
-<& /Elements/Submit, Label => loc('Next: Initialize Database'), Back => 1,
+<& /Elements/Submit, Label => $RT::Installer->{DatabaseAction} eq 'none' ?
+loc('Next: Finish') : loc('Next: Initialize Database'), Back => 1,
     BackLabel => loc('Back: Customize Emails') &>
 </form>
 </&>
@@ -80,22 +81,22 @@
 
     unless ( @results ) {
 
+        my ( $status, $msg ) = RT::Installer->SaveConfig;
 
-        require File::Spec;
-        my $file = File::Spec->catfile($RT::EtcPath, 'RT_SiteConfig.pm');
+        if ( $status ) {
+            RT->LoadConfig;
 
-        if ( open my $fh, '>', $file  ) {
-            for ( keys %{$RT::Installer->{InstallConfig}} ) {
-                 print $fh "Set( \$$_, '$RT::Installer->{InstallConfig}{$_}' );\n";
-            }
-            print $fh "1;\n";
-            close $fh;
-
-            RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
+            if ( $RT::Installer->{DatabaseAction} ne 'none' ) {
+                RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
 'installation/Initialize.html');
+            }
+            else {
+                RT::Interface::Web::Redirect(RT->Config->Get('WebURL') .
+'installation/Finish.html');
+            }
         }
         else {
-            push @results, "Can't open config file $file to write: $!";
+            push @results, $msg;
         }
     }
 }

Modified: rt/branches/3.8-TESTING/lib/RT.pm.in
==============================================================================
--- rt/branches/3.8-TESTING/lib/RT.pm.in	(original)
+++ rt/branches/3.8-TESTING/lib/RT.pm.in	Fri May  2 19:13:40 2008
@@ -63,6 +63,7 @@
 our $BasePath = '@RT_PATH@';
 our $EtcPath = '@RT_ETC_PATH@';
 our $BinPath = '@RT_BIN_PATH@';
+our $SbinPath = '@RT_SBIN_PATH@';
 our $VarPath = '@RT_VAR_PATH@';
 our $LocalPath = '@RT_LOCAL_PATH@';
 our $LocalEtcPath = '@LOCAL_ETC_PATH@';
@@ -103,7 +104,7 @@
             File::Spec->catfile( $pm_path, File::Spec->updir ) );
     }
 
-    for my $path ( qw/EtcPath BinPath VarPath LocalPath LocalEtcPath
+    for my $path ( qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath
             LocalLibPath LocalLexiconPath LocalPluginPath MasonComponentRoot
             MasonLocalComponentRoot MasonDataDir MasonSessionDir/ ) {
         no strict 'refs';

Modified: rt/branches/3.8-TESTING/lib/RT/Action/SendEmail.pm
==============================================================================
--- rt/branches/3.8-TESTING/lib/RT/Action/SendEmail.pm	(original)
+++ rt/branches/3.8-TESTING/lib/RT/Action/SendEmail.pm	Fri May  2 19:13:40 2008
@@ -104,6 +104,8 @@
 sub Commit {
     my $self = shift;
 
+
+    $self->DeferDigestRecipients() if RT->Config->Get('RecordOutgoingEmail');
     my $message = $self->TemplateObj->MIMEObj;
 
     my $orig_message;
@@ -139,7 +141,10 @@
             );
         }
         $self->RecordOutgoingMailTransaction($message);
+        $self->RecordDeferredRecipients();
     }
+
+
     return ( abs $ret );
 }
 
@@ -243,7 +248,7 @@
 
 sub To {
     my $self = shift;
-    return ( $self->_AddressesFromHeader('To') );
+    return ( $self->AddressesFromHeader('To') );
 }
 
 =head2 Cc
@@ -254,7 +259,7 @@
 
 sub Cc {
     my $self = shift;
-    return ( $self->_AddressesFromHeader('Cc') );
+    return ( $self->AddressesFromHeader('Cc') );
 }
 
 =head2 Bcc
@@ -265,11 +270,11 @@
 
 sub Bcc {
     my $self = shift;
-    return ( $self->_AddressesFromHeader('Bcc') );
+    return ( $self->AddressesFromHeader('Bcc') );
 
 }
 
-sub _AddressesFromHeader {
+sub AddressesFromHeader {
     my $self      = shift;
     my $field     = shift;
     my $header    = $self->TemplateObj->MIMEObj->head->get($field);
@@ -308,13 +313,23 @@
         Ticket      => $self->TicketObj,
         Transaction => $self->TransactionObj,
     );
-    return $status unless $status > 0;
+
+     
+    return $status unless ($status > 0 || exists ($self->{'Deferred'}));;
 
     my $success = $msgid . " sent ";
     foreach (@EMAIL_RECIPIENT_HEADERS) {
         my $recipients = $MIMEObj->head->get($_);
         $success .= " $_: " . $recipients if $recipients;
     }
+	
+    
+    if( exists $self->{'Deferred'} ) {
+        for (qw(daily weekly susp)) {
+            $success .= "\nBatched email $_ for: ". join(", ",keys % {$self->{'Deferred'}->{$_}} ) if (exists $self->{'Deferred'}->{$_});
+        }
+    }
+
     $success =~ s/\n//g;
 
     $RT::Logger->info($success);
@@ -608,6 +623,98 @@
 
 }
 
+
+sub DeferDigestRecipients {
+    my $self = shift;
+    $RT::Logger->debug( "Calling SetRecipientDigests for transaction " . $self->TransactionObj . ", id " . $self->TransactionObj->id );
+
+    # The digest attribute will be an array of notifications that need to
+    # be sent for this transaction.  The array will have the following
+    # format for its objects.
+    # $digest_hash -> {daily|weekly|susp} -> address -> {To|Cc|Bcc}
+    #                                     -> sent -> {true|false}
+    # The "sent" flag will be used by the cron job to indicate that it has
+    # run on this transaction.
+    # In a perfect world we might move this hash construction to the
+    # extension module itself.
+    my $digest_hash = {};
+
+    foreach my $mailfield (@EMAIL_RECIPIENT_HEADERS) {
+        $RT::Logger->debug( "Working on mailfield $mailfield; recipients are " . join( ',', @{ $self->{$mailfield} } ) );
+
+        # Store the 'daily digest' folk in an array.
+        my ( @send_now, @daily_digest, @weekly_digest, @suspended );
+
+        # Have to get the list of addresses directly from the MIME header
+        # at this point.
+        $RT::Logger->debug( $self->TemplateObj->MIMEObj->head->as_string );
+        foreach my $rcpt ( map { $_->address } $self->AddressesFromHeader($mailfield) ) {
+            next unless $rcpt;
+            my $user_obj = RT::User->new($RT::SystemUser);
+            $user_obj->LoadByEmail($rcpt);
+            if  ( ! $user_obj->id ) {
+                # If there's an email address in here without an associated
+                # RT user, pass it on through.
+                $RT::Logger->debug( "User $rcpt is not associated with an RT user object.  Send mail.");
+                push( @send_now, $rcpt );
+                next;
+            }
+
+            my $mailpref = RT->Config->Get( 'EmailFrequency', $user_obj ) || '';
+            $RT::Logger->debug( "Got user mail preference '$mailpref' for user $rcpt");
+
+            if ( $mailpref =~ /daily/i ) { push( @daily_digest, $rcpt ) }
+            elsif ( $mailpref =~ /weekly/i ) { push( @weekly_digest, $rcpt ) }
+            elsif ( $mailpref =~ /suspend/i ) { push( @suspended, $rcpt ) }
+            else { push( @send_now, $rcpt ) }
+        }
+
+        # Reset the relevant mail field.
+        $RT::Logger->debug( "Removing deferred recipients from $mailfield: line");
+        if (@send_now) {
+            $self->SetHeader( $mailfield, join( ', ', @send_now ) );
+        } else {    # No recipients!  Remove the header.
+            $self->TemplateObj->MIMEObj->head->delete($mailfield);
+        }
+
+        # Push the deferred addresses into the appropriate field in
+        # our attribute hash, with the appropriate mail header.
+        $RT::Logger->debug(
+            "Setting deferred recipients for attribute creation");
+        $digest_hash->{'daily'}->{$_} = {'header' => $mailfield , _sent => 0}  for (@daily_digest);
+        $digest_hash->{'weekly'}->{$_} ={'header' =>  $mailfield, _sent => 0}  for (@weekly_digest);
+        $digest_hash->{'susp'}->{$_} = {'header' => $mailfield, _sent =>0 }  for (@suspended);
+    }
+
+    if ( scalar keys %$digest_hash ) {
+
+        # Save the hash so that we can add it as an attribute to the
+        # outgoing email transaction.
+        $self->{'Deferred'} = $digest_hash;
+    } else {
+        $RT::Logger->debug( "No recipients found for deferred delivery on "
+                . "transaction #"
+                . $self->TransactionObj->id );
+    }
+}
+
+
+    
+sub  RecordDeferredRecipients {
+	my $self = shift;
+	my $txn_id = $self->{'OutgoingMailTransaction'};
+	return unless $txn_id;
+	
+	my $txn_obj = RT::Transaction->new( $self->CurrentUser );
+	$txn_obj->Load( $txn_id );
+    my( $ret, $msg ) = $txn_obj->AddAttribute( Name => 'DeferredRecipients',
+					      Content => $self->{'Deferred'});
+	$RT::Logger->warning( "Unable to add deferred recipients to outgoing transaction: $msg" ) 
+	    unless $ret;
+
+        return ($ret,$msg);
+}
+
 =head2 SquelchMailTo [@ADDRESSES]
 
 Mark ADDRESSES to be removed from list of the recipients. Returns list of the addresses.

Modified: rt/branches/3.8-TESTING/lib/RT/Config.pm
==============================================================================
--- rt/branches/3.8-TESTING/lib/RT/Config.pm	(original)
+++ rt/branches/3.8-TESTING/lib/RT/Config.pm	Fri May  2 19:13:40 2008
@@ -1,40 +1,40 @@
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
-#  
-# This software is Copyright (c) 1996-2008 Best Practical Solutions, LLC 
+#
+# This software is Copyright (c) 1996-2008 Best Practical Solutions, LLC
 #                                          <jesse at bestpractical.com>
-# 
+#
 # (Except where explicitly superseded by other copyright notices)
-# 
-# 
+#
+#
 # LICENSE:
-# 
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 # 02110-1301 or visit their web page on the internet at
 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-# 
-# 
+#
+#
 # CONTRIBUTION SUBMISSION POLICY:
-# 
+#
 # (The following paragraph is not intended to limit the rights granted
 # to you to modify and distribute this software under the terms of
 # the GNU General Public License and is only of importance to you if
 # you choose to contribute your changes and enhancements to the
 # community by submitting them to Best Practical Solutions, LLC.)
-# 
+#
 # By intentionally submitting any modifications, corrections or
 # derivatives to this work, or any other work intended for use with
 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
@@ -43,7 +43,7 @@
 # royalty-free, perpetual, license to use, copy, create derivative
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
-# 
+#
 # END BPS TAGGED BLOCK }}}
 
 package RT::Config;
@@ -99,13 +99,13 @@
 
 our %META = (
     WebDefaultStylesheet => {
-        Section         => 'General', #loc
+        Section         => 'General',                #loc
         Overridable     => 1,
         Widget          => '/Widgets/Form/Select',
         WidgetArguments => {
-            Description => 'Theme', #loc
-            # XXX: we need support for 'get values callback'
-            Values      => [qw(3.5-default 3.4-compat web2)],
+            Description => 'Theme',                  #loc
+                 # XXX: we need support for 'get values callback'
+            Values => [qw(3.5-default 3.4-compat web2)],
         },
     },
     DefaultSummaryRows => {
@@ -113,7 +113,7 @@
         Overridable     => 1,
         Widget          => '/Widgets/Form/Integer',
         WidgetArguments => {
-            Description => 'Number of search results', #loc
+            Description => 'Number of search results',    #loc
         },
     },
     MessageBoxWidth => {
@@ -121,7 +121,7 @@
         Overridable     => 1,
         Widget          => '/Widgets/Form/Integer',
         WidgetArguments => {
-            Description => 'Message box width', #loc
+            Description => 'Message box width',           #loc
         },
     },
     MessageBoxHeight => {
@@ -129,16 +129,17 @@
         Overridable     => 1,
         Widget          => '/Widgets/Form/Integer',
         WidgetArguments => {
-            Description => 'Message box height', #loc
+            Description => 'Message box height',          #loc
         },
     },
     MaxInlineBody => {
-        Section         => 'Ticket display', #loc
+        Section         => 'Ticket display',              #loc
         Overridable     => 1,
         Widget          => '/Widgets/Form/Integer',
         WidgetArguments => {
-            Description => 'Maximum inline message length', #loc
-            Hints => "Length in characters; Use '0' to show all messages inline, regardless of length" #loc
+            Description => 'Maximum inline message length',    #loc
+            Hints =>
+                "Length in characters; Use '0' to show all messages inline, regardless of length" #loc
         },
     },
     OldestTransactionsFirst => {
@@ -146,27 +147,43 @@
         Overridable     => 1,
         Widget          => '/Widgets/Form/Boolean',
         WidgetArguments => {
-            Description => 'Show oldest history first', #loc
+            Description => 'Show oldest history first',    #loc
         },
     },
-    DateTimeFormat      => {
-        Section         => 'Locale', #loc
+    DateTimeFormat => {
+        Section         => 'Locale',                       #loc
         Overridable     => 1,
         Widget          => '/Widgets/Form/Select',
         WidgetArguments => {
-            Description => 'Date format', #loc
+            Description => 'Date format',                            #loc
             Values      => [qw(DefaultFormat RFC2822 ISO W3CDTF)],
             ValuesLabel => {
-                DefaultFormat => 'Tue Dec 25 21:59:12 1995', #loc
-                RFC2822       => 'Tue, 25 Dec 1995 21:59:12 -0300', #loc
-                ISO           => '1995-11-25 21:59:12', #loc
-                W3CDTF        => '1995-11-25T21:59:12Z', #loc
+                DefaultFormat => 'Tue Dec 25 21:59:12 1995',           #loc
+                RFC2822       => 'Tue, 25 Dec 1995 21:59:12 -0300',    #loc
+                ISO           => '1995-11-25 21:59:12',                #loc
+                W3CDTF        => '1995-11-25T21:59:12Z',               #loc
             },
         },
     },
+     EmailFrequency => {
+        Section         => 'Mail',                                     #loc
+        Overridable     => 1,
+            Default     => 'Individual messages',
+        Widget          => '/Widgets/Form/Select',
+        WidgetArguments => {
+            Description => 'Email delivery',
+            Values      => [
+                'Individual messages',
+                'Daily digest',
+                'Weekly digest',
+                'Suspended'
+            ]
+            }
+            },
     DisableGraphViz => {
         Type            => 'SCALAR',
         PostLoadCheck   => sub {
+            my $self  = shift;
             my $value = shift;
             return if $value;
             return if $INC{'GraphViz'};
@@ -176,15 +193,9 @@
             $self->Set( DisableGraphViz => 1 );
         },
     },
-    MailPlugins         => {
-        Type            => 'ARRAY'
-    },
-    GnuPG               => {
-        Type            => 'HASH'
-    },
-    GnuPGOptions        => {
-        Type            => 'HASH'
-    },
+    MailPlugins  => { Type => 'ARRAY' },
+    GnuPG        => { Type => 'HASH' },
+    GnuPGOptions => { Type => 'HASH' },
 );
 my %OPTIONS = ();
 
@@ -196,17 +207,15 @@
 
 =cut
 
-sub new
-{
+sub new {
     my $proto = shift;
-    my $class = ref($proto)? ref($proto): $proto;
-    my $self = bless {}, $class;
+    my $class = ref($proto) ? ref($proto) : $proto;
+    my $self  = bless {}, $class;
     $self->_Init(@_);
     return $self;
 }
 
-sub _Init
-{
+sub _Init {
     return;
 }
 
@@ -216,10 +225,9 @@
 
 =cut
 
-sub InitConfig
-{
+sub InitConfig {
     my $self = shift;
-    my %args = (File => '', @_);
+    my %args = ( File => '', @_ );
     $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
     return 1;
 }
@@ -232,9 +240,8 @@
 
 =cut
 
-sub LoadConfigs
-{
-    my $self = shift;
+sub LoadConfigs {
+    my $self    = shift;
     my @configs = $self->Configs;
     $self->InitConfig( File => $_ ) foreach @configs;
     $self->LoadConfig( File => $_ ) foreach @configs;
@@ -257,35 +264,34 @@
 
 =cut
 
-sub LoadConfig
-{
+sub LoadConfig {
     my $self = shift;
-    my %args = (File => '', @_);
+    my %args = ( File => '', @_ );
     $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
-    if ($args{'File'} eq 'RT_SiteConfig.pm' and my $site_config = $ENV{RT_SITE_CONFIG}) {
+    if ( $args{'File'} eq 'RT_SiteConfig.pm'
+        and my $site_config = $ENV{RT_SITE_CONFIG} )
+    {
         $self->_LoadConfig( %args, File => $site_config );
-    }
-    else {
-        $self->_LoadConfig( %args );
+    } else {
+        $self->_LoadConfig(%args);
     }
     $args{'File'} =~ s/Site(?=Config\.pm$)//;
-    $self->_LoadConfig( %args );
+    $self->_LoadConfig(%args);
     return 1;
 }
 
-sub _LoadConfig
-{
+sub _LoadConfig {
     my $self = shift;
-    my %args = (File => '', @_);
+    my %args = ( File => '', @_ );
 
-    my $is_ext = $args{'File'} !~ /^RT_(?:Site)?Config/? 1: 0;
-    my $is_site = $args{'File'} =~ /SiteConfig/? 1: 0;
+    my $is_ext = $args{'File'} !~ /^RT_(?:Site)?Config/ ? 1 : 0;
+    my $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
 
     eval {
         package RT;
         local *Set = sub(\[$@%]@) {
-            my ($opt_ref, @args) = @_;
-            my ($pack, $file, $line) = caller;
+            my ( $opt_ref, @args ) = @_;
+            my ( $pack, $file, $line ) = caller;
             return $self->SetFromConfig(
                 Option     => $opt_ref,
                 Value      => [@args],
@@ -296,30 +302,31 @@
                 Extension  => $is_ext,
             );
         };
-        local @INC = ($RT::LocalEtcPath, $RT::EtcPath, @INC);
+        local @INC = ( $RT::LocalEtcPath, $RT::EtcPath, @INC );
         require $args{'File'};
     };
-    if( $@ ) {
+    if ($@) {
         return 1 if $is_site && $@ =~ qr{^Can't locate \Q$args{File}};
         if ( $is_site || $@ !~ qr{^Can't locate \Q$args{File}} ) {
             die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
         }
 
         my $username = getpwuid($>);
-        my $group = getgrgid($();
+        my $group    = getgrgid($();
 
-        my ($file_path, $fileuid, $filegid);
+        my ( $file_path, $fileuid, $filegid );
         foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
             my $tmp = File::Spec->catfile( $_, $args{File} );
-            ($fileuid,$filegid) = (stat( $tmp ))[4,5];
+            ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
             if ( defined $fileuid ) {
                 $file_path = $tmp;
                 last;
             }
         }
-        unless ( $file_path ) {
-            die qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
-               .qq{The file couldn't be find in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
+        unless ($file_path) {
+            die
+                qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
+                . qq{The file couldn't be find in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
         }
 
         my $message = <<EOF;
@@ -338,10 +345,9 @@
 EOF
 
         my $fileusername = getpwuid($fileuid);
-        my $filegroup = getgrgid($filegid);
-        my $errormessage = sprintf($message,
-            $file_path, $fileusername, $filegroup, $filegroup
-        );
+        my $filegroup    = getgrgid($filegid);
+        my $errormessage = sprintf( $message,
+            $file_path, $fileusername, $filegroup, $filegroup );
         die "$errormessage\n$@";
     }
     return 1;
@@ -361,21 +367,20 @@
 
 =cut
 
-sub Configs
-{
-    my $self = shift;
+sub Configs {
+    my $self    = shift;
     my @configs = ();
-    foreach my $path( $RT::LocalEtcPath, $RT::EtcPath ) {
-        my $mask = File::Spec->catfile($path, "*_Config.pm");
+    foreach my $path ( $RT::LocalEtcPath, $RT::EtcPath ) {
+        my $mask = File::Spec->catfile( $path, "*_Config.pm" );
         my @files = glob $mask;
         @files = grep !/^RT_Config\.pm$/,
-                 grep $_ && /^\w+_Config\.pm$/,
-                 map { s/^.*[\\\/]//; $_ } @files;
+            grep $_ && /^\w+_Config\.pm$/,
+            map { s/^.*[\\\/]//; $_ } @files;
         push @configs, @files;
     }
 
     @configs = sort @configs;
-    unshift(@configs, 'RT_Config.pm');
+    unshift( @configs, 'RT_Config.pm' );
 
     return @configs;
 }
@@ -384,6 +389,11 @@
 
 Takes name of the option as argument and returns its current value.
 
+In the case of a user-overridable option, first checks the user's preferences before looking for site-wide configuration.
+
+Returns values from RT_SiteConfig, RT_Config and then the %META hash of configuration variables's "Default" for this config variable, in that order.
+
+
 Returns different things in scalar and array contexts. For scalar
 options it's not that important, however for arrays and hash it's.
 In scalar context returns references to arrays and hashes.
@@ -404,16 +414,17 @@
 =cut
 
 sub Get {
-    my ($self, $name, $user) = @_;
+    my ( $self, $name, $user ) = @_;
 
     my $res;
-    if ( $user&& $user->id && $META{ $name }->{'Overridable'} ) {
+    if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
         $user = $user->UserObj if $user->isa('RT::CurrentUser');
-        my $prefs = $user->Preferences( $RT::System );
-        $res = $prefs->{ $name } if $prefs;
+        my $prefs = $user->Preferences($RT::System);
+        $res = $prefs->{$name} if $prefs;
     }
-    $res = $OPTIONS{ $name } unless defined $res;
-    return $self->_ReturnValue($res, $META{ $name }->{'Type'} || 'SCALAR');
+    $res = $OPTIONS{$name}           unless defined $res;
+    $res = $META{$name}->{'Default'} unless defined $res;
+    return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
 }
 
 =head2 Set
@@ -428,128 +439,131 @@
 =cut
 
 sub Set {
-    my ($self, $name) = (shift, shift);
-    
-    my $old = $OPTIONS{ $name };
-    my $type = $META{ $name }->{'Type'} || 'SCALAR';
+    my ( $self, $name ) = ( shift, shift );
+
+    my $old = $OPTIONS{$name};
+    my $type = $META{$name}->{'Type'} || 'SCALAR';
     if ( $type eq 'ARRAY' ) {
-        $OPTIONS{$name} = [ @_ ];
-        { no strict 'refs';  @{"RT::$name"} = (@_); }
+        $OPTIONS{$name} = [@_];
+        { no strict 'refs'; @{"RT::$name"} = (@_); }
     } elsif ( $type eq 'HASH' ) {
-        $OPTIONS{$name} = { @_ };
-        { no strict 'refs';  %{"RT::$name"} = (@_); }
+        $OPTIONS{$name} = {@_};
+        { no strict 'refs'; %{"RT::$name"} = (@_); }
     } else {
         $OPTIONS{$name} = shift;
-        { no strict 'refs';  ${"RT::$name"} = $OPTIONS{$name}; }
+        { no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
     }
     $META{$name}->{'Type'} = $type;
-    return $self->_ReturnValue($old, $type);
+    return $self->_ReturnValue( $old, $type );
 }
 
 sub _ReturnValue {
-    my ($self, $res, $type) = @_;
+    my ( $self, $res, $type ) = @_;
     return $res unless wantarray;
 
-    if( $type eq 'ARRAY' ) {
+    if ( $type eq 'ARRAY' ) {
         return @{ $res || [] };
-    } elsif( $type eq 'HASH' ) {
+    } elsif ( $type eq 'HASH' ) {
         return %{ $res || {} };
     }
     return $res;
 }
 
-sub SetFromConfig
-{
+sub SetFromConfig {
     my $self = shift;
     my %args = (
-        Option => undef,
-        Value => [],
-        Package => 'RT',
-        File => '',
-        Line => 0,
+        Option     => undef,
+        Value      => [],
+        Package    => 'RT',
+        File       => '',
+        Line       => 0,
         SiteConfig => 1,
-        Extension => 0,
+        Extension  => 0,
         @_
     );
 
     unless ( $args{'File'} ) {
-        ($args{'Package'}, $args{'File'}, $args{'Line'}) = caller(1);
+        ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
     }
 
     my $opt = $args{'Option'};
 
     my $type;
-    my $name = $self->__GetNameByRef( $opt );
-    if( $name ) {
+    my $name = $self->__GetNameByRef($opt);
+    if ($name) {
         $type = ref $opt;
         $name =~ s/.*:://;
     } else {
         $name = $$opt;
-        $type = $META{ $name }->{'Type'} || 'SCALAR';
+        $type = $META{$name}->{'Type'} || 'SCALAR';
     }
 
-    return 1 if exists $OPTIONS{ $name } && !$args{'SiteConfig'};
+    return 1 if exists $OPTIONS{$name} && !$args{'SiteConfig'};
 
-    $META{ $name }->{'Type'} = $type;
-    foreach ( qw(Package File Line SiteConfig Extension) ) {
-        $META{ $name }->{'Source'}->{$_} = $args{$_};
+    $META{$name}->{'Type'} = $type;
+    foreach (qw(Package File Line SiteConfig Extension)) {
+        $META{$name}->{'Source'}->{$_} = $args{$_};
     }
     $self->Set( $name, @{ $args{'Value'} } );
 
     return 1;
 }
 
-{ my $last_pack = '';
-sub __GetNameByRef
 {
-    my $self = shift;
-    my $ref = shift;
-    my $pack = shift;
-    if ( !$pack && $last_pack ) {
-        my $tmp = $self->__GetNameByRef( $ref, $last_pack );
-        return $tmp if $tmp;
-    }
-    $pack ||= 'main::';
-    $pack .= '::' unless substr($pack, -2) eq '::';
-
-    my %ref_sym = (
-        SCALAR => '$',
-        ARRAY => '@',
-        HASH => '%',
-        CODE => '&',
-    );
-    no strict 'refs';
-    my $name = undef;
-    # scan $pack name table(hash)
-    foreach my $k( keys %{$pack} ) {
-        # hash for main:: has reference on itself
-        next if $k eq 'main::';
-
-        # if entry has trailing '::' then
-        # it is link to other name space
-        if ( $k =~ /::$/ ) {
-            $name = $self->__GetNameByRef($ref, $k);
-            return $name if $name;
+    my $last_pack = '';
+
+    sub __GetNameByRef {
+        my $self = shift;
+        my $ref  = shift;
+        my $pack = shift;
+        if ( !$pack && $last_pack ) {
+            my $tmp = $self->__GetNameByRef( $ref, $last_pack );
+            return $tmp if $tmp;
         }
+        $pack ||= 'main::';
+        $pack .= '::' unless substr( $pack, -2 ) eq '::';
+
+        my %ref_sym = (
+            SCALAR => '$',
+            ARRAY  => '@',
+            HASH   => '%',
+            CODE   => '&',
+        );
+        no strict 'refs';
+        my $name = undef;
+
+        # scan $pack name table(hash)
+        foreach my $k ( keys %{$pack} ) {
+
+            # hash for main:: has reference on itself
+            next if $k eq 'main::';
 
-        # entry of the table with references to
-        # SCALAR, ARRAY... and other types with
-        # the same name
-        my $entry = ${$pack}{$k};
-        next unless $entry;
-
-        # get entry for type we are looking for
-        my $entry_ref = *{$entry}{ref($ref)};
-        next unless $entry_ref;
-
-        # if references are equal then we've found
-        if( $entry_ref == $ref ) {
-            $last_pack = $pack;
-            return ($ref_sym{ref($ref)} || '*') . $pack . $k;
+            # if entry has trailing '::' then
+            # it is link to other name space
+            if ( $k =~ /::$/ ) {
+                $name = $self->__GetNameByRef( $ref, $k );
+                return $name if $name;
+            }
+
+            # entry of the table with references to
+            # SCALAR, ARRAY... and other types with
+            # the same name
+            my $entry = ${$pack}{$k};
+            next unless $entry;
+
+            # get entry for type we are looking for
+            my $entry_ref = *{$entry}{ ref($ref) };
+            next unless $entry_ref;
+
+            # if references are equal then we've found
+            if ( $entry_ref == $ref ) {
+                $last_pack = $pack;
+                return ( $ref_sym{ ref($ref) } || '*' ) . $pack . $k;
+            }
         }
+        return '';
     }
-    return '';
-} }
+}
 
 =head2 Metadata
 
@@ -559,25 +573,29 @@
 =cut
 
 sub Meta {
-    return $META{$_[1]};
+    return $META{ $_[1] };
 }
 
 sub Sections {
     my $self = shift;
     my %seen;
     return sort
-           grep !$seen{$_}++,
-           map $_->{'Section'} || 'General',
-           values %META;
+        grep !$seen{$_}++,
+        map $_->{'Section'} || 'General',
+        values %META;
 }
 
 sub Options {
     my $self = shift;
     my %args = ( Section => undef, Overridable => 1, @_ );
-    my @res = sort keys %META;
-    @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'}, @res ) if defined $args{'Section'};
+    my @res  = sort keys %META;
+    @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
+        @res )
+        if defined $args{'Section'};
     if ( defined $args{'Overridable'} ) {
-        @res = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'}, @res );
+        @res
+            = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
+            @res );
     }
     return @res;
 }

Modified: rt/branches/3.8-TESTING/lib/RT/Dashboard.pm
==============================================================================
--- rt/branches/3.8-TESTING/lib/RT/Dashboard.pm	(original)
+++ rt/branches/3.8-TESTING/lib/RT/Dashboard.pm	Fri May  2 19:13:40 2008
@@ -66,27 +66,15 @@
 
 package RT::Dashboard;
 
-use RT::Base;
-use RT::Attribute;
 use RT::SavedSearch;
 
 use strict;
 use warnings;
-use base qw/RT::Base/;
-
-sub new  {
-    my $proto = shift;
-    my $class = ref($proto) || $proto;
-    my $self  = {};
-    $self->{'Id'} = 0;
-    bless ($self, $class);
-    $self->CurrentUser(@_);
-    return $self;
-}
+use base qw/RT::FauxObject/;
 
 my %new_rights = (
-    ModifyDashboard    => 'Create and modify dashboards',
-    SubscribeDashboard => 'Subscribe to email dashboards',
+    ModifyDashboard    => 'Create and modify dashboards', #loc_pair
+    SubscribeDashboard => 'Subscribe to email dashboards', #loc_pair
 );
 
 use RT::System;
@@ -94,183 +82,42 @@
 %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES,
                                   map { lc($_) => $_ } keys %new_rights);
 
-=head2 Load
+=head2 ObjectName
 
-Takes a privacy specification, an object ID, and a dashboard ID.  Loads
-the given dashboard ID if it belongs to the stated user or group.
-Returns a tuple of status and message, where status is true on
-success.
+An object of this class is called "dashboard"
 
 =cut
 
-sub Load {
-    my $self = shift;
-    my ($privacy, $id) = @_;
-    my $object = $self->_GetObject($privacy);
-
-    if ($object) {
-	$self->{'Attribute'} = $object->Attributes->WithId($id);
-	if ($self->{'Attribute'}->Id) {
-	    $self->{'Id'} = $self->{'Attribute'}->Id;
-	    $self->{'Privacy'} = $privacy;
-	    return (1, $self->loc("Loaded dashboard [_1]", $self->Name));
-	} else {
-	    $RT::Logger->error("Could not load attribute " . $id
-			       . " for object " . $privacy);
-	    return (0, $self->loc("Dashboard attribute load failure"));
-	}
-    } else {
-	$RT::Logger->warning("Could not load object $privacy when loading dashboard");
-	return (0, $self->loc("Could not load object for [_1]", $privacy));
-    }
-
-}
-
-=head2 Save
-
-Takes a privacy, a name, and an arrayref containing an arrayref of saved
-searches and their names. Saves the given parameters to the appropriate user/
-group object, and loads the resulting dashboard. Returns a tuple of status and
-message, where status is true on success. Defaults are:
-  Privacy:  undef
-  Name:     "new dashboard"
-  Searches: (empty array)
-
-=cut
+sub ObjectName { "dashboard" }
 
-sub Save {
-    my $self = shift;
-    my %args = ('Privacy' => 'RT::User-' . $self->CurrentUser->Id,
-		'Name' => 'new dashboard',
-		'Searches' => [],
-		@_);
-    my $privacy = $args{'Privacy'};
-    my $name = $args{'Name'};
-    my @params = @{$args{'Searches'} || []};
-
-    my $object = $self->_GetObject($privacy);
-
-    return (0, $self->loc("Failed to load object for [_1]", $privacy))
-        unless $object;
-
-    if ( $object->isa('RT::System') ) {
-        return (0, $self->loc("No permission to save system-wide dashboards"))
-            unless $self->CurrentUser->HasRight(
-            Object => $RT::System,
-            Right  => 'SuperUser'
-        );
-    }
+sub SaveAttribute {
+    my $self   = shift;
+    my $object = shift;
+    my $args   = shift;
 
-    my ( $att_id, $att_msg ) = $object->AddAttribute(
+    return $object->AddAttribute(
         'Name'        => 'Dashboard',
-        'Description' => $name,
-        'Content'     => {Searches => \@params},
+        'Description' => $args{'Name'},
+        'Content'     => {Searches => $args{'Searches'}},
     );
-    if ($att_id) {
-        $self->{'Attribute'} = $object->Attributes->WithId($att_id);
-        $self->{'Id'}        = $att_id;
-        $self->{'Privacy'}   = $privacy;
-        return ( 1, $self->loc( "Saved dashboard [_1]", $name ) );
-    }
-    else {
-        $RT::Logger->error("Dashboard save failure: $att_msg");
-        return ( 0, $self->loc("Failed to create dashboard attribute") );
-    }
 }
 
-=head2 Update
-
-Updates the parameters of an existing dashboard. Takes the arguments "Name" and
-"Searches"; Searches should be an arrayref of arrayrefs of saved searches. If
-Searches or Name is not specified, then they will not be changed.
-
-=cut
-
-sub Update {
+sub UpdateAttribute {
     my $self = shift;
-    my %args = ('Name' => '',
-		@_);
- 
-    return(0, $self->loc("No dashboard loaded")) unless $self->Id;
-    return(0, $self->loc("Could not load dashboard attribute"))
-        unless $self->{'Attribute'}->Id;
+    my $args = shift;
 
     my ($status, $msg) = (1, undef);
-    if (defined $args{'Searches'}) {
+    if (defined $args->{'Searches'}) {
         ($status, $msg) = $self->{'Attribute'}->SetSubValues(
-            Searches => $args{'Searches'},
+            Searches => $args->{'Searches'},
         );
     }
 
-    if ($status && $args{'Name'}) {
-        ($status, $msg) = $self->{'Attribute'}->SetDescription($args{'Name'});
+    if ($status && $args->{'Name'}) {
+        ($status, $msg) = $self->{'Attribute'}->SetDescription($args->{'Name'});
     }
 
-    return (1, $self->loc("Dashboard update: Nothing changed"))
-        if !defined $msg;
-
-    # prevent useless warnings
-    if ($msg =~ /That is already the current value/) {
-        return (1, $self->loc("Dashboard updated"));
-    }
-
-    return ($status, $self->loc("Dashboard update: [_1]", $msg));
-}
-
-=head2 Delete
-    
-Deletes the existing dashboard.  Returns a tuple of status and message,
-where status is true upon success.
-
-=cut
-
-sub Delete {
-    my $self = shift;
-
-    my ($status, $msg) = $self->{'Attribute'}->Delete;
-    if ($status) {
-	return (1, $self->loc("Deleted dashboard"));
-    } else {
-	return (0, $self->loc("Delete failed: [_1]", $msg));
-    }
-}
-	
-
-### Accessor methods
-
-=head2 Name
-
-Returns the name of the dashboard.
-
-=cut
-
-sub Name {
-    my $self = shift;
-    return unless ref($self->{'Attribute'}) eq 'RT::Attribute';
-    return $self->{'Attribute'}->Description();
-}
-
-=head2 Id
-
-Returns the numerical id of this dashboard.
-
-=cut
-
-sub Id {
-     my $self = shift;
-     return $self->{'Id'};
-}
-
-=head2 Privacy
-
-Returns the principal object to whom this dashboard belongs, in a string
-"<class>-<id>", e.g. "RT::Group-16".
-
-=cut
-
-sub Privacy {
-    my $self = shift;
-    return $self->{'Privacy'};
+    return ($status, $msg);
 }
 
 =head2 Searches

Added: rt/branches/3.8-TESTING/lib/RT/FauxObject.pm
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/lib/RT/FauxObject.pm	Fri May  2 19:13:40 2008
@@ -0,0 +1,253 @@
+# BEGIN BPS TAGGED BLOCK {{{
+# 
+# COPYRIGHT:
+#  
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC 
+#                                          <jesse at bestpractical.com>
+# 
+# (Except where explicitly superseded by other copyright notices)
+# 
+# 
+# LICENSE:
+# 
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+# 
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/copyleft/gpl.html.
+# 
+# 
+# CONTRIBUTION SUBMISSION POLICY:
+# 
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+# 
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+# 
+# END BPS TAGGED BLOCK }}}
+=head1 NAME
+
+  RT::FauxObject - an API for faux-objects
+
+=head1 SYNOPSIS
+
+  use RT::FauxObject
+
+=head1 DESCRIPTION
+
+  A FauxObject is an object that can belong to an RT::User or an RT::Group. It
+  consists of an ID, a name, and some arbitrary data.
+
+=head1 METHODS
+
+
+=cut
+
+package RT::FauxObject;
+use strict;
+use warnings;
+use RT::Attribute;
+use base qw/RT::Base/;
+
+sub new  {
+    my $proto = shift;
+    my $class = ref($proto) || $proto;
+    my $self  = {};
+    $self->{'Id'} = 0;
+    bless ($self, $class);
+    $self->CurrentUser(@_);
+    return $self;
+}
+
+=head2 Load
+
+Takes a privacy specification, an object ID, and a faux-object ID.  Loads the
+given object ID if it belongs to the stated user or group.  Calls the PostLoad
+method on success for any further initialization. Returns a tuple of status and
+message, where status is true on success.
+
+=cut
+
+sub Load {
+    my $self = shift;
+    my ($privacy, $id) = @_;
+    my $object = $self->_GetObject($privacy);
+
+    if ($object) {
+        $self->{'Attribute'} = $object->Attributes->WithId($id);
+        if ($self->{'Attribute'}->Id) {
+            $self->{'Id'} = $self->{'Attribute'}->Id;
+            $self->{'Privacy'} = $privacy;
+            $self->PostLoad();
+            return (1, $self->loc("Loaded [_1] [_2]", $self->ObjectName, $self->Name));
+        } else {
+            $RT::Logger->error("Could not load attribute " . $id
+                    . " for object " . $privacy);
+            return (0, $self->loc("[_1] attribute load failure", ucfirst($self->ObjectName)));
+        }
+    } else {
+        $RT::Logger->warning("Could not load object $privacy when loading " . $self->ObjectName);
+        return (0, $self->loc("Could not load object for [_1]", $privacy));
+    }
+}
+
+sub PostLoad { }
+
+=head2 Save
+
+Takes a privacy, a name, and any other arguments. Saves the given parameters to
+the appropriate user/group object, and loads the resulting object. Arguments
+are passed to the SaveAttribute method, which does the actual update. Returns a
+tuple of status and message, where status is true on success. Defaults are:
+  Privacy:  CurrentUser only
+  Name:     "new (ObjectName)"
+
+=cut
+
+sub Save {
+    my $self = shift;
+    my %args = (
+        'Privacy' => 'RT::User-' . $self->CurrentUser->Id,
+        'Name'    => "new " . $self->ObjectName,
+		@_,
+    );
+
+    my $privacy = $args{'Privacy'};
+    my $name    = $args{'Name'},
+    my $object  = $self->_GetObject($privacy);
+
+    return (0, $self->loc("Failed to load object for [_1]", $privacy))
+        unless $object;
+
+    if ( $object->isa('RT::System') ) {
+        return (0, $self->loc("No permission to save system-wide [_1]", $self->ObjectName))
+            unless $self->CurrentUser->HasRight(
+                Object => $RT::System,
+                Right  => 'SuperUser',
+            );
+    }
+
+    my ($att_id, $att_msg) = $self->SaveAttribute($object, \%args);
+
+    if ($att_id) {
+        $self->{'Attribute'} = $object->Attributes->WithId($att_id);
+        $self->{'Id'}        = $att_id;
+        $self->{'Privacy'}   = $privacy;
+        return ( 1, $self->loc( "Saved [_1] [_2]", $self->ObjectName, $name ) );
+    }
+    else {
+        $RT::Logger->error($self->ObjectName . " save failure: $att_msg");
+        return ( 0, $self->loc("Failed to create [_1] attribute", $self->ObjectName) );
+    }
+}
+
+=head2 Update
+
+Updates the parameters of an existing faux-object. Any arguments are passed to
+the UpdateAttribute method. Returns a tuple of status and message, where status
+is true on success. 
+
+=cut
+
+sub Update {
+    my $self = shift;
+    my %args = @_;
+
+    return(0, $self->loc("No [_1] loaded", $self->ObjectName)) unless $self->Id;
+    return(0, $self->loc("Could not load [_1] attribute", $self->ObjectName))
+        unless $self->{'Attribute'}->Id;
+
+    my ($status, $msg) = $self->UpdateAttribute(\%args);
+
+    return (1, $self->loc("[_1] update: Nothing changed", ucfirst($self->ObjectName)))
+        if !defined $msg;
+
+    # prevent useless warnings
+    return (1, $self->loc("[_1] updated"), ucfirst($self->ObjectName))
+        if $msg =~ /That is already the current value/;
+
+    return ($status, $self->loc("[_1] update: [_2]", ucfirst($self->ObjectName), $msg));
+}
+
+=head2 Delete
+    
+Deletes the existing faux-object. Returns a tuple of status and message, where
+status is true upon success.
+
+=cut
+
+sub Delete {
+    my $self = shift;
+
+    my ($status, $msg) = $self->{'Attribute'}->Delete;
+    if ($status) {
+        return (1, $self->loc("Deleted [_1]", $self->ObjectName));
+    } else {
+        return (0, $self->loc("Delete failed: [_1]", $msg));
+    }
+}
+
+### Accessor methods
+
+=head2 Name
+
+Returns the name of this faux-object.
+
+=cut
+
+sub Name {
+    my $self = shift;
+    return unless ref($self->{'Attribute'}) eq 'RT::Attribute';
+    return $self->{'Attribute'}->Description();
+}
+
+=head2 Id
+
+Returns the numerical ID of this faux-object.
+
+=cut
+
+sub Id {
+     my $self = shift;
+     return $self->{'Id'};
+}
+
+=head2 Privacy
+
+Returns the principal object to whom this faux-object belongs, in a string
+"<class>-<id>", e.g. "RT::Group-16".
+
+=cut
+
+sub Privacy {
+    my $self = shift;
+    return $self->{'Privacy'};
+}
+
+eval "require RT::FauxObject_Vendor";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/FauxObject_Vendor.pm});
+eval "require RT::FauxObject_Local";
+die $@ if ($@ && $@ !~ qr{^Can't locate RT/FauxObject_Local.pm});
+
+1;
+

Modified: rt/branches/3.8-TESTING/lib/RT/Installer.pm
==============================================================================
--- rt/branches/3.8-TESTING/lib/RT/Installer.pm	(original)
+++ rt/branches/3.8-TESTING/lib/RT/Installer.pm	Fri May  2 19:13:40 2008
@@ -244,6 +244,24 @@
     return { map { $_ => CurrentValue($_) } @types };
 }
 
+
+sub SaveConfig {
+
+    require File::Spec;
+    my $file = File::Spec->catfile($RT::EtcPath, 'RT_SiteConfig.pm');
+
+    if ( open my $fh, '>', $file  ) {
+        for ( keys %{$RT::Installer->{InstallConfig}} ) {
+             print $fh "Set( \$$_, '$RT::Installer->{InstallConfig}{$_}' );\n";
+        }
+        print $fh "1;\n";
+        close $fh;
+        return ( 1, 'saved config with success' );
+    }
+
+    return ( 0, "can't save config to $file: $!" );
+}
+
 =head1 NAME
 
     RT::Installer - RT's Installer

Modified: rt/branches/3.8-TESTING/lib/RT/SavedSearch.pm
==============================================================================
--- rt/branches/3.8-TESTING/lib/RT/SavedSearch.pm	(original)
+++ rt/branches/3.8-TESTING/lib/RT/SavedSearch.pm	Fri May  2 19:13:40 2008
@@ -67,169 +67,48 @@
 
 package RT::SavedSearch;
 
-use RT::Base;
-use RT::Attribute;
-
 use strict;
 use warnings;
-use base qw/RT::Base/;
-
-sub new  {
-    my $proto = shift;
-    my $class = ref($proto) || $proto;
-    my $self  = {};
-    $self->{'Id'} = 0;
-    bless ($self, $class);
-    $self->CurrentUser(@_);
-    return $self;
-}
+use base qw/RT::FauxObject/;
 
-=head2 Load
+=head2 ObjectName
 
-Takes a privacy specification, an object ID, and a search ID.  Loads
-the given search ID if it belongs to the stated user or group.
-Returns a tuple of status and message, where status is true on
-success.
+An object of this class is called "search"
 
 =cut
 
-sub Load {
-    my $self = shift;
-    my ($privacy, $id) = @_;
-    my $object = $self->_GetObject($privacy);
-
-    if ($object) {
-	$self->{'Attribute'} = $object->Attributes->WithId($id);
-	if ($self->{'Attribute'}->Id) {
-	    $self->{'Id'} = $self->{'Attribute'}->Id;
-	    $self->{'Privacy'} = $privacy;
-	    $self->{'Type'} = $self->{'Attribute'}->SubValue('SearchType');
-	    return (1, $self->loc("Loaded search [_1]", $self->Name));
-	} else {
-	    $RT::Logger->error("Could not load attribute " . $id
-			       . " for object " . $privacy);
-	    return (0, $self->loc("Search attribute load failure"));
-	}
-    } else {
-	$RT::Logger->warning("Could not load object $privacy when loading search");
-	return (0, $self->loc("Could not load object for [_1]", $privacy));
-    }
+sub ObjectName { "search" }
 
+sub PostLoad {
+    my $self = shift;
+    $self->{'Type'} = $self->{'Attribute'}->SubValue('SearchType');
 }
 
-=head2 Save
-
-Takes a privacy, an optional type, a name, and a hashref containing the
-search parameters.  Saves the given parameters to the appropriate user/
-group object, and loads the resulting search.  Returns a tuple of status
-and message, where status is true on success.  Defaults are:
-  Privacy:      undef
-  Type:         Ticket
-  Name:         "new search"
-  SearchParams: (empty hash)
-
-=cut
+sub SaveAttribute {
+    my $self   = shift;
+    my $object = shift;
+    my $args   = shift;
 
-sub Save {
-    my $self = shift;
-    my %args = ('Privacy' => 'RT::User-' . $self->CurrentUser->Id,
-		'Type' => 'Ticket',
-		'Name' => 'new search',
-		'SearchParams' => {},
-		@_);
-    my $privacy = $args{'Privacy'};
-    my $type = $args{'Type'};
-    my $name = $args{'Name'};
-    my %params = %{$args{'SearchParams'}};
-
-    $params{'SearchType'} = $type;
-    my $object = $self->_GetObject($privacy);
-
-    return (0, $self->loc("Failed to load object for [_1]", $privacy))
-        unless $object;
-
-    if ( $object->isa('RT::System') ) {
-        return ( 0, $self->loc("No permission to save system-wide searches") )
-            unless $self->CurrentUser->HasRight(
-            Object => $RT::System,
-            Right  => 'SuperUser'
-        );
-    }
-
-    my ( $att_id, $att_msg ) = $object->AddAttribute(
+    return $object->AddAttribute(
         'Name'        => 'SavedSearch',
-        'Description' => $name,
-        'Content'     => \%params
+        'Description' => $args->{'Name'},
+        'Content'     => $args->{'SearchParams'},
     );
-    if ($att_id) {
-        $self->{'Attribute'} = $object->Attributes->WithId($att_id);
-        $self->{'Id'}        = $att_id;
-        $self->{'Privacy'}   = $privacy;
-        $self->{'Type'}      = $type;
-        return ( 1, $self->loc( "Saved search [_1]", $name ) );
-    }
-    else {
-        $RT::Logger->error("SavedSearch save failure: $att_msg");
-        return ( 0, $self->loc("Failed to create search attribute") );
-    }
 }
 
-=head2 Update
 
-Updates the parameters of an existing search.  Takes the arguments
-"Name" and "SearchParams"; SearchParams should be a hashref containing
-the new parameters of the search.  If Name is not specified, the name
-will not be changed.
-
-=cut
-
-sub Update {
+sub UpdateAttribute {
     my $self = shift;
-    my %args = ('Name' => '',
-		'SearchParams' => {},
-		@_);
-    
-    return(0, $self->loc("No search loaded")) unless $self->Id;
-    return(0, $self->loc("Could not load search attribute"))
-	unless $self->{'Attribute'}->Id;
-    my ($status, $msg) = $self->{'Attribute'}->SetSubValues(%{$args{'SearchParams'}});
-    if ($status && $args{'Name'}) {
-	($status, $msg) = $self->{'Attribute'}->SetDescription($args{'Name'});
-    }
-    return ($status, $self->loc("Search update: [_1]", $msg));
-}
-
-=head2 Delete
-    
-Deletes the existing search.  Returns a tuple of status and message,
-where status is true upon success.
+    my $args = shift;
+    my $params = $args->{'SearchParams'} || {};
 
-=cut
-
-sub Delete {
-    my $self = shift;
+    my ($status, $msg) = $self->{'Attribute'}->SetSubValues(%$params);
 
-    my ($status, $msg) = $self->{'Attribute'}->Delete;
-    if ($status) {
-	return (1, $self->loc("Deleted search"));
-    } else {
-	return (0, $self->loc("Delete failed: [_1]", $msg));
+    if ($status && $args->{'Name'}) {
+        ($status, $msg) = $self->{'Attribute'}->SetDescription($args->{'Name'});
     }
-}
-	
-
-### Accessor methods
-
-=head2 Name
 
-Returns the name of the search.
-
-=cut
-
-sub Name {
-    my $self = shift;
-    return unless ref($self->{'Attribute'}) eq 'RT::Attribute';
-    return $self->{'Attribute'}->Description();
+    return ($status, $msg);
 }
 
 =head2 GetParameter
@@ -245,17 +124,6 @@
     return $self->{'Attribute'}->SubValue($param);
 }
 
-=head2 Id
-
-Returns the numerical id of this search.
-
-=cut
-
-sub Id {
-     my $self = shift;
-     return $self->{'Id'};
-}
-
 =head2 Privacy
 
 Returns the principal object to whom this search belongs, in a string

Modified: rt/branches/3.8-TESTING/lib/RT/Transaction_Overlay.pm
==============================================================================
--- rt/branches/3.8-TESTING/lib/RT/Transaction_Overlay.pm	(original)
+++ rt/branches/3.8-TESTING/lib/RT/Transaction_Overlay.pm	Fri May  2 19:13:40 2008
@@ -1103,7 +1103,54 @@
     "RT::Queue-RT::Ticket-RT::Transaction";
 }
 
-# Transactions don't change. by adding this cache congif directiove, we don't lose pathalogically on long tickets.
+
+=item DeferredRecipients($freq, $include_sent )
+
+Takes the following arguments:
+
+=over
+
+=item * a string to indicate the frequency of digest delivery.  Valid values are "daily", "weekly", or "susp".
+
+=item * an optional argument which, if true, will return addresses even if this notification has been marked as 'sent' for this transaction.
+
+=back
+
+Returns an array of users who should now receive the notification that
+was recorded in this transaction.  Returns an empty array if there were
+no deferred users, or if $include_sent was not specified and the deferred
+notifications have been sent.
+
+=cut
+
+sub DeferredRecipients {
+    my $self = shift;
+    my $freq = shift;
+    my $include_sent = @_? shift : 0;
+
+    my $attr = $self->FirstAttribute('DeferredRecipients');
+
+    return () unless ($attr);
+
+    my $deferred = $attr->Content;
+
+    return () unless ( ref($deferred) eq 'HASH' && exists $deferred->{$freq} );
+
+    # Skip it.
+   
+    for my $user (keys %{$deferred->{$freq}}) {
+        if ($deferred->{$freq}->{$user}->{_sent} && !$include_sent) { 
+        delete $deferred->{$freq}->{$user} 
+    } 
+    }
+    # Now get our users.  Easy.
+    
+    return keys %{ $deferred->{$freq} };
+}
+
+
+
+# Transactions don't change. by adding this cache config directive, we don't lose pathalogically on long tickets.
 sub _CacheConfig {
   {
      'cache_p'        => 1,

Added: rt/branches/3.8-TESTING/sbin/rt-send-digest.in
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/sbin/rt-send-digest.in	Fri May  2 19:13:40 2008
@@ -0,0 +1,268 @@
+#!@PERL@
+
+use warnings;
+use strict;
+
+use lib qw( @RT_LIB_PATH@ );
+use Date::Format qw( strftime );
+use Getopt::Long;
+use RT;
+use RT::Interface::CLI qw( CleanEnv loc );
+use RT::Interface::Email;
+
+CleanEnv();
+RT::LoadConfig();
+RT::Init();
+
+sub usage {
+    my ($error) = @_;
+    print loc("Usage: ") . "$0 -m (daily|weekly) [--print] [--help]\n";
+    print loc(
+        "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.",
+        $0
+    ) . "\n";
+    print "\n\t-m, --mode\t"
+        . loc("Specify whether this is a daily or weekly run.") . "\n";
+    print "\t-p, --print\t"
+        . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent")
+        . "\n";
+    print "\t-h, --help\t" . loc("Print this message") . "\n";
+
+    if ( $error eq 'help' ) {
+        exit 0;
+    } else {
+        print loc("Error") . ": " . loc($error) . "\n";
+        exit 1;
+    }
+}
+
+my ( $frequency, $print, $help ) = ( '', '', '' );
+GetOptions(
+    'mode=s' => \$frequency,
+    'print'  => \$print,
+    'help'   => \$help,
+);
+
+usage('help') if $help;
+usage("Mode argument must be 'daily' or 'weekly'")
+    unless $frequency =~ /^(daily|weekly)$/;
+
+run( $frequency, $print );
+
+sub run {
+    my $frequency = shift;
+    my $print     = shift;
+
+## Find all the tickets that have been modified within the time frame
+##    described by $frequency.
+
+    my ( $all_digest, $sent_transactions ) = find_transactions($frequency);
+
+## Iterate through our huge hash constructing the digest message
+##    for each user and sending it.
+
+    foreach my $user ( keys %$all_digest ) {
+        my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} );
+        # Now we have a content head and a content body.  We can send a message.
+        if ( send_digest( $user, $contents_list, $contents_body ) ) {
+            print "Sent message to $user\n";
+            mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print);
+        } else {
+            print "Failed to send message to $user\n";
+        }
+    }
+}
+exit 0;
+
+# Subroutines.
+
+sub send_digest {
+    my ( $to, $index, $messages ) = @_;
+
+    # Combine the index and the messages.
+
+    my $body = "============== Tickets with activity in the last "
+        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+
+    $body .= $index;
+    $body .= "\n\n============== Messages recorded in the last "
+        . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
+    $body .= $messages;
+
+    # Load our template.  If we cannot load the template, abort
+    # immediately rather than failing through many loops.
+    my $digest_template = RT::Template->new( RT->SystemUser );
+    my ( $ret, $msg ) = $digest_template->Load('Email Digest');
+    unless ($ret) {
+        print loc("Failed to load template")
+            . " 'Email Digest': "
+            . $msg
+            . ".  Cannot continue.\n";
+        exit 1;
+    }
+    ( $ret, $msg ) = $digest_template->Parse( Argument => $body );
+    unless ($ret) {
+        print loc("Failed to parse template")
+            . " 'Email Digest'.  Cannot continue.\n";
+        exit 1;
+    }
+
+    # Set our sender and recipient.
+    $digest_template->MIMEObj->head->replace( 'From', RT::Config->Get('CorrespondAddress') );
+    $digest_template->MIMEObj->head->replace( 'To',   $to );
+
+    if ($print) {
+        $digest_template->MIMEObj->print;
+        return 1;
+    } else {
+        return  RT::Interface::Email::SendEmail( Entity      => $digest_template->MIMEObj)
+    }
+}
+
+=item mark_transactions_sent( $frequency, $user, @txn_list );
+
+Takes a frequency string (either 'daily' or 'weekly'), a user  and one or more
+transaction objects as its arguments.  Marks the given deferred
+notifications as sent.
+
+=cut
+
+sub mark_transactions_sent {
+    my ( $freq, $user, @txns ) = @_;
+    return unless $freq =~ /(daily|weekly)/;
+    return unless @txns;
+    foreach my $txn (@txns) {
+
+        # Grab the attribute, mark the "sent" as true, and store the new
+        # value.
+        if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) {
+            my $deferred = $attr->Content;
+            $deferred->{$freq}->{$user}->{'_sent'} = 1;
+            $txn->SetAttribute(
+                Name        => 'DeferredRecipients',
+                Description => 'Deferred recipients for this message',
+                Content     => $deferred,
+            );
+        }
+    }
+}
+
+sub since_date {
+    my $frequency = shift;
+
+    # Specify a short time for digest overlap, in case we aren't starting
+    # this process exactly on time.
+    my $OVERLAP_HEDGE = -30;
+
+    my $since_date = RT::Date->new( RT->SystemUser );
+    $since_date->Set( Format => 'unix', Value => time() );
+    if ( $frequency eq 'daily' ) {
+        $since_date->AddDays(-1);
+    } else {
+        $since_date->AddDays(-7);
+    }
+
+    $since_date->AddSeconds($OVERLAP_HEDGE);
+
+    return $since_date;
+}
+
+sub find_transactions {
+    my $frequency  = shift;
+    my $since_date = since_date($frequency);
+
+    my $txns = RT::Transactions->new( RT->SystemUser );
+
+    # First limit to recent transactions.
+    $txns->Limit(
+        FIELD    => 'Created',
+        OPERATOR => '>',
+        VALUE    => $since_date->ISO
+    );
+
+    # Next limit to ticket transactions.
+    $txns->Limit(
+        FIELD           => 'ObjectType',
+        OPERATOR        => '=',
+        VALUE           => 'RT::Ticket',
+        ENTRYAGGREGATOR => 'AND'
+    );
+    my $all_digest        = {};
+    my $sent_transactions = {};
+
+    while ( my $txn = $txns->Next ) {
+        my $ticket = $txn->Ticket;
+        my $queue  = $txn->TicketObj->QueueObj->Name;
+        # Xxx todo - may clobber if two queues have the same name
+        foreach my $user ( $txn->DeferredRecipients($frequency) ) {
+            $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn->ContentObj;
+            $sent_transactions->{$user}->{ $txn->id } = $txn;
+        }
+    }
+
+    return ( $all_digest, $sent_transactions );
+}
+
+sub build_digest_for_user {
+    my $user        = shift;
+    my $user_digest = shift;
+
+    my $contents_list = '';    # Holds the digest index.
+    my $contents_body = '';    # Holds the digest body.
+
+    # Has the user been disabled since a message was deferred on his/her
+    # behalf?
+    my $user_obj = RT::User->new( RT->SystemUser );
+    $user_obj->LoadByEmail($user);
+    if ( $user_obj->PrincipalObj->Disabled ) {
+        print STDERR loc("Skipping disabled user") . " $user\n";
+        next;
+    }
+
+    print loc("Message for user") . " $user:\n\n" if $print;
+    foreach my $queue ( keys %$user_digest ) {
+        $contents_list .= "Queue $queue:\n";
+        $contents_body .= "Queue $queue:\n";
+        foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) {
+            my $tkt_txns   = $user_digest->{$queue}->{$ticket};
+            my $ticket_obj = RT::Ticket->new( RT->SystemUser );
+            $ticket_obj->Load($ticket);
+
+            # Spit out the index entry for this ticket.
+            my $ticket_title = sprintf(
+                "#%d %s [%s]\t%s\n",
+                $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name,
+                $ticket_obj->Subject
+            );
+            $contents_list .= $ticket_title;
+
+            # Spit out the messages for the transactions on this ticket.
+            $contents_body .= "\n== $ticket_title\n";
+            foreach my $txn ( sort keys %$tkt_txns ) {
+                my $msg = $tkt_txns->{$txn};
+
+                # $msg contains an RT::Attachment with our outgoing
+                # message.  Print a few headers for clarity's sake.
+                $contents_body .= "From: " . $msg->GetHeader('From') . "\n";
+                my $date = $msg->GetHeader('Date ');
+                unless ($date) {
+                    my $txn_obj = RT::Transaction->new( RT->SystemUser );
+                    $txn_obj->Load($txn);
+                    my $date_obj = RT::Date->new( RT->SystemUser );
+                    $date_obj->Set(
+                        Format => 'sql',
+                        Value  => $txn_obj->Created
+                    );
+                    $date = strftime( '%a, %d %b %Y %H:%M:%S %z',
+                        @{ [ localtime( $date_obj->Unix ) ] } );
+                }
+                $contents_body .= "Date: $date\n\n";
+                $contents_body .= $msg->Content . "\n";
+                $contents_body .= "-------\n";
+            }    # foreach transaction
+        }    # foreach ticket
+    }    # foreach queue
+
+    return ( $contents_list, $contents_body );
+
+}

Modified: rt/branches/3.8-TESTING/sbin/rt-setup-database.in
==============================================================================
--- rt/branches/3.8-TESTING/sbin/rt-setup-database.in	(original)
+++ rt/branches/3.8-TESTING/sbin/rt-setup-database.in	Fri May  2 19:13:40 2008
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!@PERL@
 # BEGIN BPS TAGGED BLOCK {{{
 # 
 # COPYRIGHT:

Added: rt/branches/3.8-TESTING/t/maildigest/attributes.t
==============================================================================
--- (empty file)
+++ rt/branches/3.8-TESTING/t/maildigest/attributes.t	Fri May  2 19:13:40 2008
@@ -0,0 +1,178 @@
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 31;
+use RT;
+use RT::Test;
+my @users = qw/ emailnormal at example.com emaildaily at example.com emailweekly at example.com emailsusp at example.com /;
+
+my( $ret, $msg );
+my $user_n = RT::User->new( $RT::SystemUser );
+( $ret, $msg ) = $user_n->LoadOrCreateByEmail( $users[0] );
+ok( $ret, "user with default email prefs created: $msg" );
+$user_n->SetPrivileged( 1 );
+
+my $user_d = RT::User->new( $RT::SystemUser );
+( $ret, $msg ) = $user_d->LoadOrCreateByEmail( $users[1] );
+ok( $ret, "user with daily digest email prefs created: $msg" );
+# Set a username & password for testing the interface.
+$user_d->SetPrivileged( 1 );
+$user_d->SetPreferences($RT::System => { %{ $user_d->Preferences( $RT::System ) || {}}, EmailFrequency => 'Daily digest'});
+
+
+
+my $user_w = RT::User->new( $RT::SystemUser );
+( $ret, $msg ) = $user_w->LoadOrCreateByEmail( $users[2] );
+ok( $ret, "user with weekly digest email prefs created: $msg" );
+$user_w->SetPrivileged( 1 );
+$user_w->SetPreferences($RT::System => { %{ $user_w->Preferences( $RT::System ) || {}}, EmailFrequency => 'Weekly digest'});
+
+my $user_s = RT::User->new( $RT::SystemUser );
+( $ret, $msg ) = $user_s->LoadOrCreateByEmail( $users[3] );
+ok( $ret, "user with suspended email prefs created: $msg" );
+$user_s->SetPreferences($RT::System => { %{ $user_s->Preferences( $RT::System ) || {}}, EmailFrequency => 'Suspended'});
+$user_s->SetPrivileged( 1 );
+
+
+is(RT::Config->Get('EmailFrequency' => $user_s), 'Suspended');
+
+# Make a testing queue for ourselves.
+my $testq = RT::Queue->new( $RT::SystemUser );
+if( $testq->ValidateName( 'EmailDigest-testqueue' ) ) {
+    ( $ret, $msg ) = $testq->Create( Name => 'EmailDigest-testqueue' );
+    ok( $ret, "Our test queue is created: $msg" );
+} else {
+    $testq->Load( 'EmailDigest-testqueue' );
+    ok( $testq->id, "Our test queue is loaded" );
+}
+
+# Allow anyone to open a ticket on the test queue.
+my $everyone = RT::Group->new( $RT::SystemUser );
+( $ret, $msg ) = $everyone->LoadSystemInternalGroup( 'Everyone' );
+ok( $ret, "Loaded 'everyone' group: $msg" );
+
+( $ret, $msg ) = $everyone->PrincipalObj->GrantRight( Right => 'CreateTicket',
+						      Object => $testq );
+ok( $ret || $msg =~ /already has/, "Granted everyone CreateTicket on testq: $msg" );
+
+# Make user_d an admincc for the queue.
+( $ret, $msg ) = $user_d->PrincipalObj->GrantRight( Right => 'AdminQueue',
+						    Object => $testq );
+ok( $ret || $msg =~ /already has/, "Granted dduser AdminQueue on testq: $msg" );
+( $ret, $msg ) = $testq->AddWatcher( Type => 'AdminCc',
+			     PrincipalId => $user_d->PrincipalObj->id );
+ok( $ret || $msg =~ /already/, "dduser added as a queue watcher: $msg" );
+
+# Give the others queue rights.
+( $ret, $msg ) = $user_n->PrincipalObj->GrantRight( Right => 'AdminQueue',
+						    Object => $testq );
+ok( $ret || $msg =~ /already has/, "Granted emailnormal right on testq: $msg" );
+( $ret, $msg ) = $user_w->PrincipalObj->GrantRight( Right => 'AdminQueue',
+						    Object => $testq );
+ok( $ret || $msg =~ /already has/, "Granted emailweekly right on testq: $msg" );
+( $ret, $msg ) = $user_s->PrincipalObj->GrantRight( Right => 'AdminQueue',
+						    Object => $testq );
+ok( $ret || $msg =~ /already has/, "Granted emailsusp right on testq: $msg" );
+
+# Create a ticket with To: Cc: Bcc: fields using our four users.
+my $id;
+my $ticket = RT::Ticket->new( $RT::SystemUser );
+( $id, $ret, $msg ) = $ticket->Create( Queue => $testq->Name,
+				       Requestor => [ $user_w->Name ],
+				       Subject => 'Test ticket for RT::Extension::EmailDigest',
+				       );
+ok( $ret, "Ticket $id created: $msg" );
+
+# Make the other users ticket watchers.
+( $ret, $msg ) = $ticket->AddWatcher( Type => 'Cc',
+		      PrincipalId => $user_n->PrincipalObj->id );
+ok( $ret, "Added user_w as a ticket watcher: $msg" );
+( $ret, $msg ) = $ticket->AddWatcher( Type => 'Cc',
+		      PrincipalId => $user_s->PrincipalObj->id );
+ok( $ret, "Added user_s as a ticket watcher: $msg" );
+
+my $obj;
+($id, $msg, $obj ) = $ticket->Correspond(
+	Content => "This is a ticket response for CC action" );
+ok( $ret, "Transaction created: $msg" );
+
+# Get the deferred notifications that should result.  Should be two for
+# email daily, and one apiece for emailweekly and emailsusp.
+my @notifications;
+
+my $txns = RT::Transactions->new( $RT::SystemUser );
+$txns->LimitToTicket( $ticket->id );
+my( $c_daily, $c_weekly, $c_susp ) = ( 0, 0, 0 );
+while( my $txn = $txns->Next ) {
+    my @daily_rcpt = $txn->DeferredRecipients( 'daily' );
+    my @weekly_rcpt = $txn->DeferredRecipients('weekly' );
+    my @susp_rcpt = $txn->DeferredRecipients(  'susp' );
+
+    $c_daily++ if @daily_rcpt;
+    $c_weekly++ if @weekly_rcpt;
+    $c_susp++ if @susp_rcpt;
+
+    # If the transaction has content...
+    if( $txn->ContentObj ) {
+	# ...none of the deferred folk should be in the header.
+	my $headerstr = $txn->ContentObj->Headers;
+	foreach my $rcpt( @daily_rcpt, @weekly_rcpt, @susp_rcpt ) {
+	    ok( $headerstr !~ /$rcpt/, "Deferred recipient $rcpt not found in header" );
+	}
+    }
+}
+
+# Finally, check to see that we got the correct number of each sort of
+# deferred recipient.
+is( $c_daily, 2, "correct number of daily-sent messages" );
+is( $c_weekly, 2, "correct number of weekly-sent messages" );
+is( $c_susp, 1, "correct number of suspended messages" );
+
+
+
+
+
+# Now let's actually run the daily and weekly digest tool to make sure we generate those
+
+# the first time get the content
+{open (my $digester, "-|", $RT::SbinPath."/rt-send-digest --mode daily --print");
+my @results = <$digester>;
+my $content = join ('', @results);
+like($content, qr/in the last day/);
+} {
+# The second time run it for real so we make sure that we get RT to mark the txn as sent
+open (my $digester, "-|", $RT::SbinPath."/rt-send-digest --mode daily");
+my @results = <$digester>;
+my $content = join ('', @results);
+like($content, qr/maildaily\@/);
+close($digester);
+}
+# now we should have nothing to do, so no content.
+{open (my $digester, "-|", $RT::SbinPath."/rt-send-digest --mode daily --print");
+my @results = <$digester>;
+my $content = join ('', @results);
+is ($content, '');
+} 
+
+# the first time get the content
+{open (my $digester, "-|", $RT::SbinPath."/rt-send-digest --mode weekly --print");
+my @results = <$digester>;
+my $content = join ('', @results);
+like($content, qr/in the last seven days/);
+} {
+# The second time run it for real so we make sure that we get RT to mark the txn as sent
+open (my $digester, "-|", $RT::SbinPath."/rt-send-digest --mode weekly");
+my @results = <$digester>;
+my $content = join ('', @results);
+like($content, qr/mailweekly\@/);
+close($digester);
+}
+# now we should have nothing to do, so no content.
+{open (my $digester, "-|", $RT::SbinPath."/rt-send-digest --mode weekly --print");
+my @results = <$digester>;
+my $content = join ('', @results);
+is ($content, '');
+} 
+
+


More information about the Rt-commit mailing list