#!/usr/bin/perl -w

use strict;
#use Net::SMTP;
use Net::SMTP_auth;
use Net::SMTP::Multipart;

my (
    $smtp_server_addr,
    $username,
    $password,
    $fromAddress,
    $ccAddress,
    $toAddress,
    $bccAddress,
        );

$smtp_server_addr = 'smtp.1and1.com';    # port 25 or 587
$username = 'userid@mydomain.com';
$password = '1234xyz';
$fromAddress = $username;

$toAddress = 'friend@yourdomain.com';
$ccAddress = 'other@yourdomain.com';
#$bccAddress = 'bcc_id@yourdomain.com';

my @body = (
    "hello and how are you now?\n",
    "this is the second line of the message.\n",
);
my $fnameA = 'C:\\a_perl\\testcode\\pmail2.pl';
my $fnameB = 'C:/a_perl/testcode/mbrown.doc';

my $smtp
  = Net::SMTP::Multipart->new($smtp_server_addr, Timeout => 30, Debug => 1)
    or print $@;

$smtp->auth('LOGIN', $username, $password);
$smtp->Header(
            To   => $toAddress,
            Cc   => $ccAddress,
            Bcc  => $bccAddress,
            Subj => "Multipart Mail Demo2",
            From => $fromAddress,
                );

$smtp->Text( @body );
$smtp->FileAttach( $fnameA, $fnameB );
$smtp->End();

##</code><code>##

# @(#) Multipart.pm - <DESCRIPTION>
#
# Author:
#      Dave Roberts
#      Modified April 11, 2007 by ff
#        to use Net::SMTP_auth instead of Net::SMTP
#        to use Basename of file for 'name' (instead of the complete path)
#        added hooks for passing 'Cc' and 'Bcc' addresses
#        added: $self->datasend("From: $arg{From}\n"); # for recipient's benefit
#
# Synopsis:
#      Multipart.pm
#
# Version
#      $Source: D:/src/perl/Net/SMTP/RCS/Multipart.pm $
#      $Revision: 1.5 $
#      $State: Exp $
#
# Description:
#      <FULL DESCRIPTION>
#
#******************************************************************************
package Net::SMTP::Multipart;

use strict;
use vars qw($VERSION @ISA);
use Carp;
use MIME::Base64;
#use Net::SMTP;                                 # ff commented out April 11, 2007
use Net::SMTP_auth;                             # ff added April 11, 2007
use File::Basename;                             # ff added April 11, 2007


#@ISA = qw(Net::SMTP);                          # ff commented out April 11, 2007
@ISA = qw(Net::SMTP_auth);                      # ff added April 11, 2007

our($b);

our $VERSION = sprintf("%d.%d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);


sub new {
    my $c          = shift;         # What class are we constructing?
    my $classname  = ref($c) || $c;
    my $self       = $classname->SUPER::new(@_);
    $self->_init(@_) if defined ($self);
    return $self;                   # And give it back
}

sub _init {
    my $self = shift;
    # Create arbitrary boundary text
    my ($i,$n,@chrs);
    $b = "";
    foreach $n (48..57,65..90,97..122) { $chrs[$i++] = chr($n);}
    foreach $n (0..20) {$b .= $chrs[rand($i)];}
}

sub Header {
    my $self = shift;
    my %arg  = @_;
  	carp 'Net::SMTP::Multipart:Header: must be called with a To value' unless $arg{To};
  	carp 'Net::SMTP::Multipart:Header: must be called with a Subj value' unless $arg{Subj};
  	carp 'Net::SMTP::Multipart:Header: must be called with a From value' unless $arg{From};
  	$self->mail($arg{From});  # Sender Mail Address
    $self->to($arg{To});    # Recpient Mail Address

    if ( exists $arg{Cc} and defined $arg{Cc} ) {   # ff added April 11, 2007
      $self->cc($arg{Cc});                          # ff added April 11, 2007
    }                                               # ff added April 11, 2007
    if ( exists $arg{Bcc} and defined $arg{Bcc} ) { # ff added April 11, 2007
      $self->bcc($arg{Bcc});                        # ff added April 11, 2007
    }                                               # ff added April 11, 2007

    $self->data();
    $self->datasend("To: $arg{To}\n");

    if ( exists $arg{Cc} and defined $arg{Cc} ) {   # ff added April 11, 2007
      $self->datasend("Cc: $arg{Cc}\n");            # ff added April 11, 2007
    }                                               # ff added April 11, 2007

    $self->datasend("From: $arg{From}\n");          # ff added April 11, 2007
    $self->datasend("Subject: $arg{Subj}\n");
    $self->datasend("MIME-Version: 1.0\n");
    $self->datasend(sprintf "Content-Type: multipart/mixed; BOUNDARY=\"%s\"\n",$b);
}

sub Text {
    my $self = shift;
    $self->datasend(sprintf"\n--%s\n",$b);
    $self->datasend("Content-Type: text/plain\n");
    foreach my $text (@_) {
      $self->datasend($text);
    }
    $self->datasend("\n\n");
}

sub FileAttach {
    my $self = shift;
    foreach my $file (@_) {
	  unless (-f $file) {
        carp 'Net::SMTP::Multipart:FileAttach: unable to find file $file';
        next;
      }
      my($bytesread,$buffer,$data,$total);
      open(FH,"$file") || carp "Net::SMTP::Multipart:FileAttach: failed to open $file\n";
      binmode(FH);
      while ( ($bytesread=sysread(FH,$buffer, 1024))==1024 ){
        $total += $bytesread;
        # 500K Limit on Upload Images to prevent buffer overflow
        #if (($total/1024) > 500){
        #  printf "TooBig %s\n",$total/1024;
        #  $toobig = 1;
        #  last;
        #}
        $data .= $buffer;
      }
      if ($bytesread) {
        $data .= $buffer;
        $total += $bytesread ;
      }
      #print "File Size: $total bytes\n";
      close FH;

      my $basename = basename($file);                   # ff added April 11, 2007

      if ($data){
        $self->datasend("--$b\n");
        #$self->datasend("Content-Type: ; name=\"$file\"\n");   # ff commented out April 11, 2007
        $self->datasend("Content-Type: ; name=\"$basename\"\n");    # ff added April 11, 2007
        $self->datasend("Content-Transfer-Encoding: base64\n");
        $self->datasend("Content-Disposition: attachment; =filename=\"$file\"\n\n");
        $self->datasend(encode_base64($data));
        $self->datasend("--$b\n");
      }
    }
}



sub End {
    my $self = shift;
    $self->datasend(sprintf"\n--%s--\n",$b);                 # send boundary end message
    foreach my $epl (@_) {
      $self->datasend("$epl");                               # send epilogue text
    }
    $self->datasend("\n");                                   # send final carriage return
    $self->dataend();                                        # close the message
    return $self->quit();                                    # quit and return the status
}


sub mail {
    my $self = shift;
    $self->SUPER::mail(@_);
}

sub to {
    my $self = shift;
    $self->SUPER::to(@_);
}

sub data {
    my $self = shift;
    $self->SUPER::data(@_);
}

sub datasend {
    my $self = shift;
    #printf "datasend: %s\n",@_;
    $self->SUPER::datasend(@_);
}
sub dataend {
    my $self = shift;
    $self->SUPER::dataend();
}

sub quit {
    my $self = shift;
    $self->SUPER::quit(@_);
}




1;