package DADA::App::MyMIMELiteHTML; 


use MIME::Lite::HTML;
@ISA = qw(MIME::Lite::HTML);

use Carp qw(croak carp); 


sub absUrl {
	
	my $str = shift; 
	my $base = shift; 
  # rt 19656 : unknown URI schemes cause rewrite to fail
	if($str =~ m/\[redirect\=(.*?)\]/){ 
		return $str; 
	}else { 
	
	  my $rep = eval { URI::WithBase->new($str, $base)->abs; };
	  return ($rep ? $rep : $str);
	}

}




#------------------------------------------------------------------------------
# include_css
#------------------------------------------------------------------------------
sub include_css(\%$$) {
  my ($self,$gabarit,$root)=@_;
  sub pattern_css {
    my ($self,$url,$milieu,$fin,$root)=@_;
    # if not stylesheet - rt19655
    if ($milieu!~/stylesheet/i && $fin!~/stylesheet/i) {
      return "<link".$milieu." href=\"$url\"".$fin.">";
    }
    # Don't store <LINK REL="SHORTCUT ICON"> tag. Tks to doggy@miniasp.com
    if ( $fin =~ m/shortcut/i || $milieu =~ m/shortcut/i ){ 
		return "<link" . $milieu . "href='". $url . "'" . $fin .">"; 
	}
    
	# Complete url
    my $ur = URI::URL->new($url, $root)->abs;
    print "Include CSS file $ur\n" if $self->{_DEBUG};
    my $res2 = $self->{_AGENT}->request(new HTTP::Request('GET' => $ur));
    
    if($res2->is_success()){ 
	
		print "Ok file downloaded\n" if $self->{_DEBUG};
	    return      '<style type="text/css">'."\n".
	      '<!--'."\n".$res2->content.
		"\n-->\n</style>\n";
	}
	else { 
	
		my $err = "Looking for css to include:, '" . $ur . "' was not successful - removing from message and ignoring"; 
		$self->set_err($err);
		carp $err; 
		
		return '<style type="text/css">';	
		
	}

  }
  $gabarit=~s/<link ([^<>]*?)
                href\s*=\s*"?([^\" ]*)"?([^>]*)>
    /$self->pattern_css($2,$1,$3,$root)/iegmx;

  print "Done CSS\n" if ($self->{_DEBUG});
  return $gabarit;
}


#------------------------------------------------------------------------------
# include_javascript
#------------------------------------------------------------------------------
sub include_javascript(\%$$) {
  my ($self,$gabarit,$root)=@_;
  sub pattern_js {
    my ($self,$url,$milieu,$fin,$root)=@_;
    my $ur = URI::URL->new($url, $root)->abs;
    print "Include Javascript file $ur\n" if $self->{_DEBUG};
    my $res2 = $self->{_AGENT}->request(new HTTP::Request('GET' => $ur));

	if($res2->is_success()){ 
		  my $content = $res2->content;
		    print "Ok file downloaded\n" if $self->{_DEBUG};
		    return "\n"."<!-- $ur -->\n".
		      '<script '.$milieu.$fin.">\n".
			'<!--'."\n".$content.
			  "\n-->\n</script>\n";
			
	}
	else { 
		
		my $err = "Looking for javascript to include:, '" . $ur . "' was not successful - removing from message and ignoring"; 
		$self->set_err($err);
		carp $err; 
		
		return '<script>'; 
		
	}
	
  }
  $gabarit=~s/<script([^>]*)src\s*=\s*"?([^\" ]*js)"?([^>]*)>
    /$self->pattern_js($2,$1,$3,$root)/iegmx;
  print "Done Javascript\n" if $self->{_DEBUG};
  return $gabarit;
}








1;

=pod

=head1 NAME

DADA::App::MyMIMELiteHTML

=head1 DESCRIPTION

This is a small small module that inherits almost everything from the CPAN, C<MIME::Lite::HTML> module, but
overrides the method, C<absUrl> so it may work well with Dada Mail's Clickthrough Tracker's redirect tags, which look like this: 

 [redirect=http://yahoo.com]

=head1 More Information

The inheritence is done exactly as outlined in C<perltoot> 

http://perldoc.perl.org/perltoot.html#Inheritance

C<MIME::Lite::HTML> can be found here: 

http://search.cpan.org/~alian/MIME-Lite-HTML/

Copyright (c) 1999-2008
Justin Simoni 
http://justinsimoni.com 
All rights reserved. 

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program 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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.




=cut
