Don't absolutify # and mailto hrefs

This commit is contained in:
Martin Kamerbeek 2010-11-24 10:32:00 +01:00
parent 4fdc8b1798
commit 80e1f1e0ea

View file

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