--- /dev/null
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# <sales@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
+# 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 }}}
+
+package RT::Dashboard::Mailer;
+use strict;
+use warnings;
+
+use HTML::Mason;
+use HTML::RewriteAttributes::Links;
+use HTML::RewriteAttributes::Resources;
+use MIME::Types;
+use POSIX 'tzset';
+use RT::Dashboard;
+use RT::Interface::Web::Handler;
+use RT::Interface::Web;
+use File::Temp 'tempdir';
+
+sub MailDashboards {
+ my $self = shift;
+ my %args = (
+ All => 0,
+ DryRun => 0,
+ Time => time,
+ @_,
+ );
+
+ $RT::Logger->debug("Using time $args{Time} for dashboard generation");
+
+ my $from = $self->GetFrom();
+ $RT::Logger->debug("Sending email from $from");
+
+ # look through each user for her subscriptions
+ my $Users = RT::Users->new(RT->SystemUser);
+ $Users->LimitToPrivileged;
+
+ while (defined(my $user = $Users->Next)) {
+ if ($user->PrincipalObj->Disabled) {
+ $RT::Logger->debug("Skipping over " . $user->Name . " due to having a disabled account.");
+ next;
+ }
+
+ my ($hour, $dow, $dom) = HourDowDomIn($args{Time}, $user->Timezone || RT->Config->Get('Timezone'));
+ $hour .= ':00';
+ $RT::Logger->debug("Checking ".$user->Name."'s subscriptions: hour $hour, dow $dow, dom $dom");
+
+ my $currentuser = RT::CurrentUser->new;
+ $currentuser->LoadByName($user->Name);
+
+ # look through this user's subscriptions, are any supposed to be generated
+ # right now?
+ for my $subscription ($user->Attributes->Named('Subscription')) {
+ next unless $self->IsSubscriptionReady(
+ %args,
+ Subscription => $subscription,
+ User => $user,
+ LocalTime => [$hour, $dow, $dom],
+ );
+
+ my $email = $subscription->SubValue('Recipient')
+ || $user->EmailAddress;
+
+ eval {
+ $self->SendDashboard(
+ %args,
+ CurrentUser => $currentuser,
+ Email => $email,
+ Subscription => $subscription,
+ From => $from,
+ )
+ };
+ if ( $@ ) {
+ $RT::Logger->error("Caught exception: $@");
+ }
+ else {
+ my $counter = $subscription->SubValue('Counter') || 0;
+ $subscription->SetSubValues(Counter => $counter + 1)
+ unless $args{DryRun};
+ }
+ }
+ }
+}
+
+sub IsSubscriptionReady {
+ my $self = shift;
+ my %args = (
+ All => 0,
+ Subscription => undef,
+ User => undef,
+ LocalTime => [0, 0, 0],
+ @_,
+ );
+
+ return 1 if $args{All};
+
+ my $subscription = $args{Subscription};
+
+ my $counter = $subscription->SubValue('Counter') || 0;
+
+ my $sub_frequency = $subscription->SubValue('Frequency');
+ my $sub_hour = $subscription->SubValue('Hour');
+ my $sub_dow = $subscription->SubValue('Dow');
+ my $sub_dom = $subscription->SubValue('Dom');
+ my $sub_fow = $subscription->SubValue('Fow');
+
+ my ($hour, $dow, $dom) = @{ $args{LocalTime} };
+
+ $RT::Logger->debug("Checking against subscription " . $subscription->Id . " for " . $args{User}->Name . " with frequency $sub_frequency, hour $sub_hour, dow $sub_dow, dom $sub_dom, fow $sub_fow, counter $counter");
+
+ return 0 if $sub_frequency eq 'never';
+
+ # correct hour?
+ return 0 if $sub_hour ne $hour;
+
+ # all we need is the correct hour for daily dashboards
+ return 1 if $sub_frequency eq 'daily';
+
+ if ($sub_frequency eq 'weekly') {
+ # correct day of week?
+ return 0 if $sub_dow ne $dow;
+
+ # does it match the "every N weeks" clause?
+ $sub_fow = 1 if !$sub_fow;
+
+ return 1 if $counter % $sub_fow == 0;
+
+ $subscription->SetSubValues(Counter => $counter + 1)
+ unless $args{DryRun};
+ return 0;
+ }
+
+ # if monthly, correct day of month?
+ if ($sub_frequency eq 'monthly') {
+ return $sub_dom == $dom;
+ }
+
+ # monday through friday
+ if ($sub_frequency eq 'm-f') {
+ return 0 if $dow eq 'Sunday' || $dow eq 'Saturday';
+ return 1;
+ }
+
+ $RT::Logger->debug("Invalid subscription frequency $sub_frequency for " . $args{User}->Name);
+
+ # unknown frequency type, bail out
+ return 0;
+}
+
+sub GetFrom {
+ RT->Config->Get('DashboardAddress') || RT->Config->Get('OwnerEmail')
+}
+
+sub SendDashboard {
+ my $self = shift;
+ my %args = (
+ CurrentUser => undef,
+ Email => undef,
+ Subscription => undef,
+ DryRun => 0,
+ @_,
+ );
+
+ my $currentuser = $args{CurrentUser};
+ my $subscription = $args{Subscription};
+
+ my $rows = $subscription->SubValue('Rows');
+
+ my $DashboardId = $subscription->SubValue('DashboardId');
+
+ my $dashboard = RT::Dashboard->new($currentuser);
+ my ($ok, $msg) = $dashboard->LoadById($DashboardId);
+
+ # failed to load dashboard. perhaps it was deleted or it changed privacy
+ if (!$ok) {
+ $RT::Logger->warning("Unable to load dashboard $DashboardId of subscription ".$subscription->Id." for user ".$currentuser->Name.": $msg");
+ return $self->ObsoleteSubscription(
+ %args,
+ Subscription => $subscription,
+ );
+ }
+
+ $RT::Logger->debug('Generating dashboard "'.$dashboard->Name.'" for user "'.$currentuser->Name.'":');
+
+ if ($args{DryRun}) {
+ print << "SUMMARY";
+ Dashboard: @{[ $dashboard->Name ]}
+ User: @{[ $currentuser->Name ]} <$args{Email}>
+SUMMARY
+ return;
+ }
+
+ local $HTML::Mason::Commands::session{CurrentUser} = $currentuser;
+ local $HTML::Mason::Commands::r = RT::Dashboard::FakeRequest->new;
+
+ my $content = RunComponent(
+ '/Dashboards/Render.html',
+ id => $dashboard->Id,
+ Preview => 0,
+ );
+
+ if ( RT->Config->Get('EmailDashboardRemove') ) {
+ for ( RT->Config->Get('EmailDashboardRemove') ) {
+ $content =~ s/$_//g;
+ }
+ }
+
+ $RT::Logger->debug("Got ".length($content)." characters of output.");
+
+ $content = HTML::RewriteAttributes::Links->rewrite(
+ $content,
+ RT->Config->Get('WebURL') . '/Dashboards/Render.html',
+ );
+
+ $self->EmailDashboard(
+ %args,
+ Dashboard => $dashboard,
+ Content => $content,
+ );
+}
+
+sub ObsoleteSubscription {
+ my $self = shift;
+ my %args = (
+ From => undef,
+ To => undef,
+ Subscription => undef,
+ CurrentUser => undef,
+ @_,
+ );
+
+ my $subscription = $args{Subscription};
+
+ my $ok = RT::Interface::Email::SendEmailUsingTemplate(
+ From => $args{From},
+ To => $args{Email},
+ Template => 'Error: Missing dashboard',
+ Arguments => {
+ SubscriptionObj => $subscription,
+ },
+ ExtraHeaders => {
+ 'X-RT-Dashboard-Subscription-Id' => $subscription->Id,
+ 'X-RT-Dashboard-Id' => $subscription->SubValue('DashboardId'),
+ },
+ );
+
+ # only delete the subscription if the email looks like it went through
+ if ($ok) {
+ my ($deleted, $msg) = $subscription->Delete();
+ if ($deleted) {
+ $RT::Logger->debug("Deleted an obsolete subscription: $msg");
+ }
+ else {
+ $RT::Logger->warning("Unable to delete an obsolete subscription: $msg");
+ }
+ }
+ else {
+ $RT::Logger->warning("Unable to notify ".$args{CurrentUser}->Name." of an obsolete subscription");
+ }
+}
+
+sub EmailDashboard {
+ my $self = shift;
+ my %args = (
+ CurrentUser => undef,
+ Email => undef,
+ Dashboard => undef,
+ Subscription => undef,
+ Content => undef,
+ @_,
+ );
+
+ my $subscription = $args{Subscription};
+ my $dashboard = $args{Dashboard};
+ my $currentuser = $args{CurrentUser};
+ my $email = $args{Email};
+
+ my $frequency = $subscription->SubValue('Frequency');
+
+ my %frequency_lookup = (
+ 'm-f' => 'Weekday', # loc
+ 'daily' => 'Daily', # loc
+ 'weekly' => 'Weekly', # loc
+ 'monthly' => 'Monthly', # loc
+ 'never' => 'Never', # loc
+ );
+
+ my $frequency_display = $frequency_lookup{$frequency}
+ || $frequency;
+
+ my $subject = sprintf '[%s] ' . RT->Config->Get('DashboardSubject'),
+ RT->Config->Get('rtname'),
+ $currentuser->loc($frequency_display),
+ $dashboard->Name;
+
+ my $entity = $self->BuildEmail(
+ %args,
+ To => $email,
+ Subject => $subject,
+ );
+
+ $entity->head->replace('X-RT-Dashboard-Id', $dashboard->Id);
+ $entity->head->replace('X-RT-Dashboard-Subscription-Id', $subscription->Id);
+
+ $RT::Logger->debug('Mailing dashboard "'.$dashboard->Name.'" to user '.$currentuser->Name." <$email>");
+
+ my $ok = RT::Interface::Email::SendEmail(
+ Entity => $entity,
+ );
+
+ if (!$ok) {
+ $RT::Logger->error("Failed to email dashboard to user ".$currentuser->Name." <$email>");
+ return;
+ }
+
+ $RT::Logger->debug("Done sending dashboard to ".$currentuser->Name." <$email>");
+}
+
+sub BuildEmail {
+ my $self = shift;
+ my %args = (
+ Content => undef,
+ From => undef,
+ To => undef,
+ Subject => undef,
+ @_,
+ );
+
+ my @parts;
+ my %cid_of;
+
+ my $content = HTML::RewriteAttributes::Resources->rewrite($args{Content}, sub {
+ my $uri = shift;
+
+ # already attached this object
+ return "cid:$cid_of{$uri}" if $cid_of{$uri};
+
+ $cid_of{$uri} = time() . $$ . int(rand(1e6));
+ my ($data, $filename, $mimetype, $encoding) = GetResource($uri);
+
+ # downgrade non-text strings, because all strings are utf8 by
+ # default, which is wrong for non-text strings.
+ if ( $mimetype !~ m{text/} ) {
+ utf8::downgrade( $data, 1 ) or $RT::Logger->warning("downgrade $data failed");
+ }
+
+ push @parts, MIME::Entity->build(
+ Top => 0,
+ Data => $data,
+ Type => $mimetype,
+ Encoding => $encoding,
+ Disposition => 'inline',
+ Name => $filename,
+ 'Content-Id' => $cid_of{$uri},
+ );
+
+ return "cid:$cid_of{$uri}";
+ },
+ inline_css => sub {
+ my $uri = shift;
+ my ($content) = GetResource($uri);
+ return $content;
+ },
+ inline_imports => 1,
+ );
+
+ my $entity = MIME::Entity->build(
+ From => $args{From},
+ To => $args{To},
+ Subject => $args{Subject},
+ Type => "multipart/mixed",
+ );
+
+ $entity->attach(
+ Data => Encode::encode_utf8($content),
+ Type => 'text/html',
+ Charset => 'UTF-8',
+ Disposition => 'inline',
+ );
+
+ for my $part (@parts) {
+ $entity->add_part($part);
+ }
+
+ return $entity;
+}
+
+{
+ my $mason;
+ my $outbuf = '';
+ my $data_dir = '';
+
+ sub _mason {
+ unless ($mason) {
+ $RT::Logger->debug("Creating Mason object.");
+
+ # user may not have permissions on the data directory, so create a
+ # new one
+ $data_dir = tempdir(CLEANUP => 1);
+
+ $mason = HTML::Mason::Interp->new(
+ RT::Interface::Web::Handler->DefaultHandlerArgs,
+ out_method => \$outbuf,
+ autohandler_name => '', # disable forced login and more
+ data_dir => $data_dir,
+ );
+ }
+ return $mason;
+ }
+
+ sub RunComponent {
+ _mason->exec(@_);
+ my $ret = $outbuf;
+ $outbuf = '';
+ return $ret;
+ }
+}
+
+{
+ my %cache;
+
+ sub HourDowDomIn {
+ my $now = shift;
+ my $tz = shift;
+
+ my $key = "$now $tz";
+ return @{$cache{$key}} if exists $cache{$key};
+
+ my ($hour, $dow, $dom);
+
+ {
+ local $ENV{'TZ'} = $tz;
+ ## Using POSIX::tzset fixes a bug where the TZ environment variable
+ ## is cached.
+ tzset();
+ (undef, undef, $hour, $dom, undef, undef, $dow) = localtime($now);
+ }
+ tzset(); # return back previous value
+
+ $hour = "0$hour"
+ if length($hour) == 1;
+ $dow = (qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/)[$dow];
+
+ return @{$cache{$key}} = ($hour, $dow, $dom);
+ }
+}
+
+sub GetResource {
+ my $uri = URI->new(shift);
+ my ($content, $filename, $mimetype, $encoding);
+
+ $RT::Logger->debug("Getting resource $uri");
+
+ # strip out the equivalent of WebURL, so we start at the correct /
+ my $path = $uri->path;
+ my $webpath = RT->Config->Get('WebPath');
+ $path =~ s/^\Q$webpath//;
+
+ # add a leading / if needed
+ $path = "/$path"
+ unless $path =~ m{^/};
+
+ $HTML::Mason::Commands::r->path_info($path);
+
+ # grab the query arguments
+ my %args;
+ for (split /&/, ($uri->query||'')) {
+ my ($k, $v) = /^(.*?)=(.*)$/
+ or die "Unable to parse query parameter '$_'";
+
+ for ($k, $v) { s/%(..)/chr hex $1/ge }
+
+ # no value yet, simple key=value
+ if (!exists $args{$k}) {
+ $args{$k} = $v;
+ }
+ # already have key=value, need to upgrade it to key=[value1, value2]
+ elsif (!ref($args{$k})) {
+ $args{$k} = [$args{$k}, $v];
+ }
+ # already key=[value1, value2], just add the new value
+ else {
+ push @{ $args{$k} }, $v;
+ }
+ }
+
+ $RT::Logger->debug("Running component '$path'");
+ $content = RunComponent($path, %args);
+
+ # guess at the filename from the component name
+ $filename = $1 if $path =~ m{^.*/(.*?)$};
+
+ # the rest of this was taken from Email::MIME::CreateHTML::Resolver::LWP
+ ($mimetype, $encoding) = MIME::Types::by_suffix($filename);
+
+ my $content_type = $HTML::Mason::Commands::r->content_type;
+ if ($content_type) {
+ $mimetype = $content_type;
+
+ # strip down to just a MIME type
+ $mimetype = $1 if $mimetype =~ /(\S+);\s*charset=(.*)$/;
+ }
+
+ #If all else fails then some conservative and general-purpose defaults are:
+ $mimetype ||= 'application/octet-stream';
+ $encoding ||= 'base64';
+
+ $RT::Logger->debug("Resource $uri: length=".length($content)." filename='$filename' mimetype='$mimetype', encoding='$encoding'");
+
+ return ($content, $filename, $mimetype, $encoding);
+}
+
+
+{
+ package RT::Dashboard::FakeRequest;
+ sub new { bless {}, shift }
+ sub header_out { shift }
+ sub headers_out { shift }
+ sub content_type {
+ my $self = shift;
+ $self->{content_type} = shift if @_;
+ return $self->{content_type};
+ }
+ sub path_info {
+ my $self = shift;
+ $self->{path_info} = shift if @_;
+ return $self->{path_info};
+ }
+}
+
+RT::Base->_ImportOverlays();
+
+1;
+
projects / freeside.git / blobdiff