514 lines
15 KiB
Perl
514 lines
15 KiB
Perl
package WebGUI::AssetAspect::Subscribable;
|
|
|
|
use strict;
|
|
use Class::C3;
|
|
|
|
=head1 NAME
|
|
|
|
WebGUI::AssetAspect::Subscribable - Let users subscribe to your asset
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
|
|
=head1 METHODS
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 definition ( session [, definition ] )
|
|
|
|
=cut
|
|
|
|
sub definition {
|
|
my $class = shift;
|
|
my $session = shift;
|
|
my $definition = shift;
|
|
my $i18n = __PACKAGE__->i18n($session);
|
|
|
|
tie my %properties, 'Tie::IxHash', (
|
|
subscriptionGroupId => {
|
|
tab => "security",
|
|
fieldType => "subscriptionGroup",
|
|
label => $i18n->echo("Subscription Group"),
|
|
hoverHelp => $i18n->echo("The users who are subscribed to recieve e-mail alerts for this asset"),
|
|
defaultValue => undef,
|
|
noFormPost => 1,
|
|
},
|
|
subscriptionTemplateId => {
|
|
tab => "display",
|
|
fieldType => "template",
|
|
namespace => $class->getSubscriptionTemplateNamespace,
|
|
label => $i18n->echo("Subscription Template"),
|
|
hoverHelp => $i18n->echo("The template to use to send out e-mail notifications"),
|
|
},
|
|
skipNotification => {
|
|
autoGenerate => 0,
|
|
noFormPost => 1,
|
|
fieldType => 'yesNo',
|
|
},
|
|
);
|
|
|
|
push @{ $definition }, {
|
|
autoGenerateForms => 1,
|
|
tableName => "assetAspect_Subscribable",
|
|
properties => \%properties,
|
|
};
|
|
|
|
return $class->maybe::next::method( $session, $definition );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 addRevision ( properties [, revisionDate, options ] )
|
|
|
|
Override addRevision to set skipNotification to 0 for each new revision.
|
|
|
|
=cut
|
|
|
|
sub addRevision {
|
|
my $self = shift;
|
|
my $properties = shift;
|
|
|
|
$properties->{ skipNotification } = 0;
|
|
|
|
return $self->maybe::next::method( $properties, @_ );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 canSubscribe ( [userId ] )
|
|
|
|
Returns true if the user is allowed to subscribe to this asset. C<userId> is
|
|
a userId to check, defaults to the current user.
|
|
|
|
By default, Visitors are not allowed to subscribe. Anyone else who canView,
|
|
canSubscribe.
|
|
|
|
=cut
|
|
|
|
sub canSubscribe {
|
|
my $self = shift;
|
|
my $userId = shift || $self->session->user->userId;
|
|
|
|
return 0 if $userId eq "1";
|
|
return $self->canView( $userId );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 commit ( )
|
|
|
|
By default, send the notification out when the asset is committed. Override
|
|
this if you don't want this asset to send out notifications (but you still
|
|
want to be able to subscribe to children)
|
|
|
|
=cut
|
|
|
|
sub commit {
|
|
my ( $self, @args ) = @_;
|
|
$self->maybe::next::method( @args );
|
|
if ( !$self->shouldSkipNotification ) {
|
|
$self->notifySubscribers;
|
|
}
|
|
return;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 createSubscriptionGroup ( )
|
|
|
|
Create a group to hold subscribers to this asset, if there is not one already.
|
|
|
|
=cut
|
|
|
|
sub createSubscriptionGroup {
|
|
my $self = shift;
|
|
|
|
if ( my $groupId = $self->get('subscriptionGroupId') ) {
|
|
return WebGUI::Group->new( $self->session, $groupId );
|
|
}
|
|
else {
|
|
my $group = WebGUI::Group->new($self->session, "new");
|
|
$group->name( "Subscription " . $self->getTitle );
|
|
$group->description( "Subscription Group for " . $self->getTitle . "(" . $self->getId . ")" );
|
|
$group->isEditable( 0 );
|
|
$group->showInForms( 0 );
|
|
$group->deleteGroups( [ "3" ] ); # admins don't want to be auto subscribed to this thing
|
|
$self->update({
|
|
subscriptionGroupId => $group->getId
|
|
});
|
|
|
|
return $group;
|
|
}
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 DOES ( role )
|
|
|
|
Returns true if the asset does the specified role. This mixin does the
|
|
"Subscribable" role.
|
|
|
|
=cut
|
|
|
|
sub DOES {
|
|
my $self = shift;
|
|
my $role = shift;
|
|
|
|
return 1 if ( lc $role eq "subscribable" );
|
|
return $self->maybe::next::method( $role );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 getSubscriptionContent ( )
|
|
|
|
Get the content to send to subscribers. By default, will process the template
|
|
from C<getSubscriptionTemplate> with the variables from C<getTemplateVars> or
|
|
C<get>.
|
|
|
|
=cut
|
|
|
|
sub getSubscriptionContent {
|
|
my $self = shift;
|
|
my $template = $self->getSubscriptionTemplate;
|
|
my $var;
|
|
if ( $self->can("getTemplateVars") ) {
|
|
# Rely on getTemplateVars sub judgement
|
|
$var = $self->getTemplateVars;
|
|
}
|
|
else {
|
|
# Try to make sense of the asset properties
|
|
$var = {
|
|
%{ $self->get },
|
|
url => $self->session->url->getSiteURL . $self->getUrl,
|
|
}
|
|
}
|
|
|
|
return $template->process( $var );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 getSubscriptionGroup ( )
|
|
|
|
Gets the WebGUI::Group for the subscribers group.
|
|
|
|
=cut
|
|
|
|
sub getSubscriptionGroup {
|
|
my $self = shift;
|
|
my $groupId = $self->get( "subscriptionGroupId" );
|
|
my $group = $groupId ? WebGUI::Group->new( $self->session, $groupId ) : $self->createSubscriptionGroup;
|
|
return $group;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 getSubscriptionTemplate ( )
|
|
|
|
Get a WebGUI::Asset::Template object for the subscription template.
|
|
|
|
=cut
|
|
|
|
sub getSubscriptionTemplate {
|
|
my $self = shift;
|
|
my $templateId = $self->get( "subscriptionTemplateId" );
|
|
my $template = WebGUI::Asset::Template->new( $self->session, $templateId ); # This should throw if we don't
|
|
return $template;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 getSubscriptionTemplateNamespace ( )
|
|
|
|
Get the namespace for the subscription template.
|
|
|
|
=cut
|
|
|
|
sub getSubscriptionTemplateNamespace {
|
|
return "AssetAspect/Subscribable";
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 getSubscribeUrl ( )
|
|
|
|
Get the URL to subscribe to this asset.
|
|
|
|
=cut
|
|
|
|
sub getSubscribeUrl {
|
|
my $self = shift;
|
|
return $self->getUrl( 'func=subscribe' );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 getUnsubscribeUrl ( )
|
|
|
|
Get the URL to unsubscribe from this asset.
|
|
|
|
=cut
|
|
|
|
sub getUnsubscribeUrl {
|
|
my $self = shift;
|
|
return $self->getUrl( 'func=unsubscribe' );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 i18n ( )
|
|
|
|
Get the i18n for RSSCapable
|
|
|
|
=cut
|
|
|
|
sub i18n {
|
|
my $class = shift;
|
|
my $session = shift;
|
|
|
|
return WebGUI::International->new( $session );
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 isSubscribed ( [userId] )
|
|
|
|
Returns true if the user is subscribed to the asset. C<userId> is a userId to
|
|
check, defaults to the current user.
|
|
|
|
=cut
|
|
|
|
sub isSubscribed {
|
|
my $self = shift;
|
|
my $userId = shift;
|
|
my $user = $userId
|
|
? WebGUI::User->new( $self->session, $userId )
|
|
: $self->session->user
|
|
;
|
|
my $group = $self->getSubscriptionGroup;
|
|
# TODO: Make WebGUI::Group throw error if group not found
|
|
if ( !$group ) {
|
|
return 0;
|
|
}
|
|
else {
|
|
return $user->isInGroup( $group->getId );
|
|
}
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 _makeMessageId ( string )
|
|
|
|
Make the message ID following proper RFC2822. C<string> is a unique identifier
|
|
for the message.
|
|
|
|
=cut
|
|
|
|
sub _makeMessageId {
|
|
my $self = shift;
|
|
my $string = shift;
|
|
my $domain = $self->session->config->get( "sitename" )->[ 0 ];
|
|
return "wg-" . $string . "@" . $domain;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 notifySubscribers ( [options] )
|
|
|
|
Notify all the subscribers of this asset. C<options> is a hash reference of
|
|
options with the following keys:
|
|
|
|
content -> Content to send to the subscribers. Defaults to getSubscriptionContent
|
|
subject -> E-mail subject. Defaults to the asset title.
|
|
from -> E-mail address this message is from. Defaults to the e-mail address of
|
|
the owner of this asset, or the Company E-Mail from settings
|
|
replyTo -> E-mail address to reply to. Defaults to the listAddress, the Mail
|
|
Return Path from settings, or the Company E-Mail from settings
|
|
inReplyTo -> Asset ID of the asset this subscription message is replying to
|
|
listAddress -> The address of the mailing list this is being sent from, if necessary
|
|
|
|
=cut
|
|
|
|
sub notifySubscribers {
|
|
my $self = shift;
|
|
my $opt = shift;
|
|
my $session = $self->session;
|
|
my $setting = $self->session->setting;
|
|
my $companyEmail = $setting->get( "companyEmail" );
|
|
my $mailReturnPath = $setting->get( "mailReturnPath" );
|
|
|
|
$opt->{ subject } ||= $self->getTitle;
|
|
$opt->{ content } ||= $self->getSubscriptionContent;
|
|
WebGUI::Macro::process( $self->session, \$opt->{content} );
|
|
|
|
if ( !$opt->{ from } ) {
|
|
my $owner = WebGUI::User->new( $self->session, $self->get( "ownerUserId" ) );
|
|
$opt->{ from } = $owner->profileField( "email" ) || $opt->{ listAddress } || $companyEmail;
|
|
}
|
|
|
|
if ( !$opt->{ replyTo } ) {
|
|
$opt->{ replyTo } = $opt->{listAddress} || $mailReturnPath || $companyEmail;
|
|
}
|
|
|
|
$opt->{ returnPath } = $mailReturnPath || $opt->{listAddress} || $companyEmail || $opt->{ from };
|
|
|
|
my $messageId = $self->_makeMessageId( $self->getId );
|
|
|
|
### Get all the people we need to send to
|
|
# Any parent asset that does subscribable
|
|
# First asset in this list is the topmost parent, and is the list ID
|
|
my @assets = ( $self );
|
|
my $parentAsset = $self->getParent;
|
|
while ( $parentAsset ) {
|
|
last if !$parentAsset->DOES( "subscribable" );
|
|
unshift @assets, $parentAsset;
|
|
$parentAsset = $parentAsset->getParent;
|
|
}
|
|
|
|
### Prepare the actual sender address (the address of the process sending,
|
|
# not the address of the user who initiated the sending)
|
|
my $sender = $opt->{listAddress} || $companyEmail || $opt->{from};
|
|
my $siteurl = $session->url->getSiteURL;
|
|
# XXX This doesnt seem right...
|
|
my $listId = $sender;
|
|
$listId =~ s/\@/\./;
|
|
|
|
for my $asset ( @assets ) {
|
|
my $group = $asset->getSubscriptionGroup;
|
|
my $mail
|
|
= WebGUI::Mail::Send->create( $self->session, {
|
|
from => '<' . $opt->{ from } . '>',
|
|
returnPath => '<' . $opt->{ returnPath } . '>',
|
|
replyTo => '<' . $opt->{ replyTo } . '>',
|
|
toGroup => $group->getId,
|
|
subject => $opt->{ subject },
|
|
messageId => '<' . $messageId . '>',
|
|
} );
|
|
|
|
# Add threading headers
|
|
if ( $opt->{ inReplyTo } ) {
|
|
$mail->addHeaderField( "In-Reply-To", '<' . $opt->{inReplyTo} . '>' );
|
|
$mail->addHeaderField( "References", '<' . $opt->{inReplyTo} . '>' );
|
|
}
|
|
|
|
$mail->addHeaderField("List-ID", $assets[0]->getTitle." <".$listId.">");
|
|
$mail->addHeaderField("List-Help", "<mailto:".$companyEmail.">, <".$setting->get("companyURL").">");
|
|
$mail->addHeaderField("List-Owner", "<mailto:".$companyEmail.">, <".$setting->get("companyURL")."> (".$setting->get("companyName").")");
|
|
$mail->addHeaderField("Sender", "<".$sender.">");
|
|
$mail->addHeaderField("List-Unsubscribe", "<".$siteurl.$asset->getUnsubscribeUrl.">");
|
|
$mail->addHeaderField("X-Unsubscribe-Web", "<".$siteurl.$asset->getUnsubscribeUrl.">");
|
|
$mail->addHeaderField("List-Subscribe", "<".$siteurl.$asset->getSubscribeUrl.">");
|
|
$mail->addHeaderField("X-Subscribe-Web", "<".$siteurl.$asset->getSubscribeUrl.">");
|
|
$mail->addHeaderField("List-Archive", "<".$siteurl.$assets[0]->getUrl.">");
|
|
$mail->addHeaderField("X-Archives", "<".$siteurl.$assets[0]->getUrl.">");
|
|
if ( $opt->{listAddress} ) {
|
|
$mail->addHeaderField("List-Post", "<mailto:".$opt->{listAddress}.">");
|
|
}
|
|
else {
|
|
$mail->addHeaderField("List-Post", "No");
|
|
}
|
|
$mail->addHtml($opt->{content});
|
|
$mail->addFooter;
|
|
$mail->queue;
|
|
}
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 setSkipNotification ( )
|
|
|
|
Set a flag so that this asset does not send out notifications for this
|
|
revision.
|
|
|
|
=cut
|
|
|
|
sub setSkipNotification {
|
|
my $self = shift;
|
|
my $value = shift;
|
|
$value = defined $value ? $value : 1;
|
|
|
|
$self->update( {
|
|
skipNotification => $value,
|
|
} );
|
|
|
|
return;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 shouldSkipNotification ( )
|
|
|
|
Returns true if the asset should skip notifications.
|
|
|
|
=cut
|
|
|
|
sub shouldSkipNotification {
|
|
my $self = shift;
|
|
return $self->get( "skipNotification" ) ? 1 : 0;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 subscribe ( [userId] )
|
|
|
|
Subscribe a user to this asset. C<userId> is a userId to subscribe, defaults
|
|
to the current user.
|
|
|
|
=cut
|
|
|
|
sub subscribe {
|
|
my $self = shift;
|
|
my $userId = shift || $self->session->user->userId;
|
|
$self->getSubscriptionGroup->addUsers( [$userId] );
|
|
return;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 unsubscribe ( [userId] )
|
|
|
|
Unsubscribe a user from this asset. C<userId> is a userId to unsubscribe,
|
|
defaults to the current user.
|
|
|
|
=cut
|
|
|
|
sub unsubscribe {
|
|
my $self = shift;
|
|
my $userId = shift || $self->session->user->userId;
|
|
$self->getSubscriptionGroup->deleteUsers( [$userId] );
|
|
return;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 www_subscribe ( )
|
|
|
|
Subscribe the current user to this asset.
|
|
|
|
=cut
|
|
|
|
sub www_subscribe {
|
|
my $self = shift;
|
|
$self->subscribe if $self->canSubscribe;
|
|
return $self->www_view;
|
|
}
|
|
|
|
#----------------------------------------------------------------------------
|
|
|
|
=head2 www_unsubscribe ( )
|
|
|
|
Unsubscribe the current user from this asset.
|
|
|
|
=cut
|
|
|
|
sub www_unsubscribe {
|
|
my $self = shift;
|
|
$self->unsubscribe;
|
|
return $self->www_view;
|
|
}
|
|
|
|
1; # You can't handle the truth
|