UnitedKnowledge/webgui_newsletter
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Adding link rewriting so that uri are complete.

Browse source
This commit is contained in:
Martin Kamerbeek 2010-05-07 11:49:54 +02:00
parent 39b27f39c4
commit c4115cc82a
1 changed files with 31 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

32
lib/WebGUI/Mailing/Email.pm
View file

@ -3,6 +3,8 @@ package WebGUI::Mailing::Email;
use strict;
use warnings;
use HTML::TreeBuilder;
use base 'WebGUI::Crud';
sub crud_definition {
@ -83,6 +85,32 @@ sub error {
return;
}
sub absolutifyURIs {
my $self = shift;
my $content = shift;
my $pageUrl = shift;
my $siteUrl = $self->session->url->getSiteURL;
my $tb = HTML::TreeBuilder->new;
my $root = $tb->parse( $content );
foreach my $link ( @{ $root->extract_links } ) {
my ($uri, $element, $attr, $tag) = @{ $link };
if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) {
my $new =
( $uri =~ m{ ^ / }xmsi ) # Is url absolute?
? $siteUrl . $uri
: $siteUrl . $pageUrl . '/' . $uri
;
# replace attribute
$element->attr( $attr, $new );
}
}
return $tb->as_HTML;
}
sub send {
my $self = shift;
@ -90,7 +118,9 @@ sub send {
#### TODO: Error checking
my $mailing = $self->getMailing;
my $body = $mailing->getAsset->processContentAsUser( $mailing->get('issueId'), $self->get('userId') );
my $asset = $mailing->getAsset;
my $content = $asset->processContentAsUser( $mailing->get('issueId'), $self->get('userId') );
my $body = $self->absolutifyURIs( $content, $asset->getUrl );
# Mail is a test mail but there is noone to send the result to
if ( $self->get( 'isTest' ) && !$self->get('recipientEmail') ) {