|
# Here an extract of package MIME::Lite::HTML
package MIME::Lite::HTML;
# module MIME::Lite::HTML : Provide routine to transform a HTML page in
# a MIME::Lite mail
# Copyright 2001 A.Barbet alian@alianwebserver.com. All rights reserved.
# Revision 1.1 2002/02/07 15:58:35 bettini
# added scanner for perl
#
# Revision 1.12 2002/01/07 20:18:53 alian
# - Add replace links for frame & iframe
# - Correct incorrect parsing in include_css for <LINK REL="SHORTCUT ICON">
# tag. Tks to doggy@miniasp.com for idea and patch
#
# Revision 1.11 2001/12/13 22:42:33 alian
# - Correct a bug with relative anchor
#
# Revision 1.10 2001/11/07 10:52:43 alian
# - Add feature for get restricted url. Add LoginDetails parameter for that
# (tks to Leon.Halford@ing-barings.com for idea)
# - Change error in POD doc rfc2257 => rfc2557 (tks to
# justin.zaglio@morganstanley.com)
# - Correct warning when $url_html is undef
use LWP::UserAgent;
use HTML::LinkExtor;
use URI::URL;
use MIME::Lite;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
my $LOGINDETAILS;
#------------------------------------------------------------------------------
# redefine get_basic_credentials
#------------------------------------------------------------------------------
{
package RequestAgent;
use vars qw(@ISA);
@ISA = qw(LWP::UserAgent);
sub new
{
my $self = LWP::UserAgent::new(@_);
$self;
}
sub get_basic_credentials
{
my($self, $realm, $uri) = @_;
# Use parameter of MIME-Lite-HTML, key LoginDetails
if (defined $LOGINDETAILS) { return split(':', $LOGINDETAILS, 2); }
# Ask user on STDIN
elsif (-t)
{
my $netloc = $uri->host_port;
print "Enter username for $realm at $netloc: ";
my $user = <STDIN>;
chomp($user);
# 403 if no user given
return (undef, undef) unless length $user;
print "Password: ";
system("stty -echo");
my $password = <STDIN>;
system("stty echo");
print "\n"; # because we disabled echo
chomp($password);
return ($user, $password);
}
# Damm we got 403 with CGI (use param LoginDetails) ...
else { return (undef, undef) }
}
}
#------------------------------------------------------------------------------
# new
#------------------------------------------------------------------------------
sub new
{
my $class = shift;
my $self = {};
bless $self, $class;
my %param = @_;
# Agent name
$self->{_AGENT} = new RequestAgent;
$self->{_AGENT}->agent("MIME-Lite-HTML $VERSION");
$self->{_AGENT}->from('mime-lite-html@alianwebserver.com' );
# Set debug level
if ($param{'Debug'})
{
$self->{_DEBUG} = 1;
delete $param{'Debug'};
}
# Set Login information
if ($param{'LoginDetails'})
{
$LOGINDETAILS = $param{'LoginDetails'};
delete $param{'LoginDetails'};
}
# Set type of include to do
if ($param{'IncludeType'})
{
die "IncludeType must be in 'extern', 'cid' or 'location'\n" if
( ($param{'IncludeType'} ne 'extern') and
($param{'IncludeType'} ne 'cid') and
($param{'IncludeType'} ne 'location'));
$self->{_include} = $param{'IncludeType'};
delete $param{'IncludeType'};
}
# Defaut type: use a Content-Location field
else {$self->{_include}='location';}
## Added by Michalis@linuxmail.org to manipulate non-us mails
if ($param{'TextCharset'}) {
$self->{_textcharset}=$param{'TextCharset'};
delete $param{'TextCharset'};
}
else { $self->{_textcharset}='iso-8859-1'; }
if ($param{'HTMLCharset'}) {
$self->{_htmlcharset}=$param{'HTMLCharset'};
delete $param{'HTMLCharset'};
}
else { $self->{_htmlcharset}='iso-8859-1'; }
if ($param{'TextEncoding'}) {
$self->{_textencoding}=$param{'TextEncoding'};
delete $param{'TextEncoding'};
}
else { $self->{_textencoding}='7bit'; }
if ($param{'HTMLEncoding'}) {
$self->{_htmlencoding}=$param{'HTMLEncoding'};
delete $param{'HTMLEncoding'};
}
else { $self->{_htmlencoding}='quoted-printable'; }
## End. Default values remain as they were initially set.
## No need to change existing scripts if you send US-ASCII.
## If you DON't send us-ascii, you wouldn't be able to use
## MIME::Lite::HTML anyway :-)
# Set proxy to use to get file
if ($param{'Proxy'})
{
$self->{_AGENT}->proxy('http',$param{'Proxy'}) ;
print "Set proxy for http : ", $param{'Proxy'},"\n"
if ($self->{_DEBUG});
delete $param{'Proxy'};
}
# Set hash to use with template
if ($param{'HashTemplate'})
{
$param{'HashTemplate'} = ref($param{'HashTemplate'}) eq "HASH"
? $param{'HashTemplate'} : %{$param{'HashTemplate'}};
$self->{_HASH_TEMPLATE}= $param{'HashTemplate'};
delete $param{'HashTemplate'};
}
$self->{_param} = \%param;
# Ok I hope I known what I do ;-)
MIME::Lite->quiet(1);
return $self;
}
#------------------------------------------------------------------------------
# POD Documentation
#------------------------------------------------------------------------------
=head1 NAME
MIME::Lite::HTML - Provide routine to transform a HTML page in a MIME-Lite mail
=head1 SYNOPSIS
#!/usr/bin/perl -w
# A cgi program that do "Mail this page to a friend";
# Call this script like this :
# script.cgi?email=myfriend@isp.com&url=http://www.go.com
use strict;
use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;
use MIME::Lite::HTML;
my $mailHTML = new MIME::Lite::HTML
From => 'MIME-Lite@alianwebserver.com',
To => param('email'),
Subject => 'Your url: '.param('url');
my $MIMEmail = $mailHTML->parse(param('url'));
$MIMEmail->send; # or for win user : $mail->send_by_smtp('smtp.fai.com');
print header,"Mail envoye (", param('url'), " to ", param('email'),")<br>\n";
=head1 DESCRIPTION
This module is a Perl mail client interface for sending message that
support HTML format and build them for you..
This module provide routine to transform a HTML page in MIME::Lite mail.
So you need this module to use MIME-Lite-HTML possibilities
=head2 What's happen ?
The job done is:
=over
=item *
Get the file (LWP) if needed
=item *
Parse page to find include images (gif, jpg, flash)
=item *
Attach them to mail with adequat header if asked (default)
=item *
Include external CSS,Javascript file
=item *
Replace relative url with absolute one
=item *
Build the final MIME-Lite object with each part found
=back
=cut
|