[Rt-commit] r12014 - in rt/branches/3.8-TESTING: . etc etc/upgrade/3.7.85 lib lib/RT/Action sbin
jesse at bestpractical.com
jesse at bestpractical.com
Fri May 2 18:48:51 EDT 2008
Author: jesse
Date: Fri May 2 18:48:51 2008
New Revision: 12014
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/sbin/rt-send-digest.in
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/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/Transaction_Overlay.pm
rt/branches/3.8-TESTING/sbin/rt-setup-database.in
Log:
r30350 at 54: jesse | 2008-05-02 12:38:24 -0400
* Checkpointing digested email so I don't accidentally delete the whole thing again.
r30351 at 54: jesse | 2008-05-02 17:05:57 -0400
* Cleanup to how deferred mail works
r30352 at 54: jesse | 2008-05-02 18:44:32 -0400
* RT Now supports batched email 'digests' (Weekly or daily) as well as the ability for a user disable mail him or herself
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 18:48:51 2008
@@ -154,6 +154,7 @@
$(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 \
Modified: rt/branches/3.8-TESTING/README
==============================================================================
--- rt/branches/3.8-TESTING/README (original)
+++ rt/branches/3.8-TESTING/README Fri May 2 18:48:51 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 18:48:51 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
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 18:48:51 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 18:48:51 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/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 18:48:51 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 18:48:51 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 18:48:51 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,24 +147,39 @@
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 {
@@ -177,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 = ();
@@ -197,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;
}
@@ -217,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;
}
@@ -233,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;
@@ -258,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],
@@ -297,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;
@@ -339,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;
@@ -362,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;
}
@@ -385,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.
@@ -405,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
@@ -429,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
@@ -560,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/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 18:48:51 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 18:48:51 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 18:48:51 2008
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!@PERL@
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
More information about the Rt-commit
mailing list