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

Don't absolutify # and mailto hrefs

Browse source
This commit is contained in:
Martin Kamerbeek 2010-11-24 10:32:00 +01:00
parent 4fdc8b1798
commit 80e1f1e0ea
1 changed files with 10 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -54,7 +54,7 @@ sub crud_definition {
},
);
$definition->{ properties } = {
$definition->{ properties } = {
%{ $definition->{ properties } || {} },
%properties,
};
@ -128,20 +128,19 @@ sub absolutifyURIs {
my $tb = HTML::TreeBuilder->new;
my $root = $tb->parse( $content );
foreach my $link ( @{ $root->extract_links } ) {
foreach my $link ( @{ $root->extract_links } ) {
my ($uri, $element, $attr, $tag) = @{ $link };
if ( $uri !~ m{ ^ [a-z]+:// }xmsi ) {
my $new =
if ( $uri !~ m{ ^ (?: [a-z]+:// | \# | mailto: ) }xmsi ) {
my $new =
( $uri =~ m{ ^ / }xmsi ) # Is url absolute?
? $siteUrl . $uri
: $siteUrl . $pageUrl . '/' . $uri
;
# replace attribute
$element->attr( $attr, $new );
}
}
}
return $tb->as_HTML;
}
@ -167,7 +166,7 @@ sub send {
#### TODO: Error checking
my $mailing = $self->getMailing;
unless ( $mailing ) {
$session->log->error( 'Cannot send because getMailing doesn\'t return one.' );
$session->log->error( 'Cannot send because getMailing doesn\'t return one.' );
return;
}
@ -193,7 +192,7 @@ sub send {
# Check bounce score
my $bounceScoreOk = WebGUI::Mailing::Bounce->new( $session )->bounceScoreOk( $to );
if ( !$self->get( 'isTest' ) && !$bounceScoreOk ) {
$self->update( {
$self->update( {
status => 'skipped',
sendDate => time,
errorMessage => "Bounce score for $to too high",
@ -228,14 +227,14 @@ sub send {
}
}
# And send it.
# And send it.
my $success = $mail->send;
if ( $success ne '1' ) {
$self->error( "Mail couldn't be sent by WebGUI::Mail::Send" );
}
else {
$self->update( {
$self->update( {
status => 'sent',
sendDate => time,
sentTo => $to,