Initial revision

16 files changed, 4443 insertions, 0 deletions

diff --git a/cpan/dist/MailTools/Mail/Address.pm b/cpan/dist/MailTools/Mail/Address.pm
new file mode 100644
index 00000000..74a6b580
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Address.pm
@@ -0,0 +1,424 @@
+# Mail::Address.pm
+#
+# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Mail::Address;
+use strict;
+
+use Carp;
+use vars qw($VERSION);
+use locale;
+
+$VERSION = "1.17";
+sub Version { $VERSION }
+
+#
+# given a comment, attempt to extract a person's name
+#
+
+sub _extract_name
+{
+    local $_ = shift || '';
+    
+    # trim whitespace
+    s/^\s+//;
+    s/\s+$//;
+    s/\s+/ /;
+
+    # Disregard numeric names (e.g. 123456.1234@compuserve.com)
+    return "" if /^[\d ]+$/;
+
+    # remove outermost parenthesis
+    s/^\(|\)$//g;
+
+    # remove outer quotation marks
+    s/^"|"$//g;
+
+    # remove embedded comments
+    s/\(.*\)//g;
+
+    # reverse "Last, First M." if applicable
+    s/^([^\s]+) ?, ?(.*)$/$2 $1/;
+    s/,.*//;
+
+    # Set the case of the name to first char upper rest lower
+    # Upcase first letter on name
+    s/\b(\w+)/\L\u$1/igo;
+
+    # Scottish names such as 'McLeod'
+    s/\bMc(\w)/Mc\u$1/igo;
+
+    # Irish names such as 'O'Malley, O'Reilly'
+    s/\bo'(\w)/O'\u$1/igo;
+
+    # Roman numerals, eg 'Level III Support'
+    s/\b(x*(ix)?v*(iv)?i*)\b/\U$1/igo; 
+
+    # some cleanup
+    s/\[[^\]]*\]//g;
+    s/(^[\s'"]+|[\s'"]+$)//g;
+    s/\s{2,}/ /g;
+
+    return $_;
+}
+
+sub _tokenise {
+ local($_) = join(',', @_);
+ my(@words,$snippet,$field);
+ 
+ s/\A\s+//;
+ s/[\r\n]+/ /g;
+
+ while ($_ ne '')
+  {
+   $field = '';
+   if( s/^\s*\(/(/ )    # (...)
+    {
+     my $depth = 0;
+
+     PAREN: while(s/^(\(([^\(\)\\]|\\.)*)//)
+      {
+       $field .= $1;
+       $depth++;
+       while(s/^(([^\(\)\\]|\\.)*\)\s*)//)
+        {
+         $field .= $1;
+         last PAREN unless --$depth;
+	 $field .= $1 if s/^(([^\(\)\\]|\\.)+)//;
+        }
+      }
+
+     carp "Unmatched () '$field' '$_'"
+        if $depth;
+
+     $field =~ s/\s+\Z//;
+     push(@words, $field);
+
+     next;
+    }
+
+      s/^("([^"\\]|\\.)*")\s*//       # "..."
+   || s/^(\[([^\]\\]|\\.)*\])\s*//    # [...]
+   || s/^([^\s\Q()<>\@,;:\\".[]\E]+)\s*//
+   || s/^([\Q()<>\@,;:\\".[]\E])\s*//
+     and do { push(@words, $1); next; };
+
+   croak "Unrecognised line: $_";
+  }
+
+ push(@words, ",");
+
+ \@words;
+}
+
+sub _find_next {
+ my $idx = shift;
+ my $tokens = shift;
+ my $len = shift;
+ while($idx < $len) {
+   my $c = $tokens->[$idx];
+   return $c if($c eq "," || $c eq "<");
+   $idx++;
+ }
+ return "";
+}
+
+sub _complete {
+ my $pkg = shift;
+ my $phrase = shift;
+ my $address = shift;
+ my $comment = shift;
+ my $o = undef;
+
+ if(@{$phrase} || @{$comment} || @{$address}) {
+  $o = $pkg->new(join(" ",@{$phrase}), 
+                 join("", @{$address}),
+                 join(" ",@{$comment}));
+  @{$phrase} = ();
+  @{$address} = ();
+  @{$comment} = ();
+ }
+
+ return $o;
+}
+
+
+sub new {
+ my $pkg = shift;
+ my $me = bless [@_], $pkg;
+ return $me;
+}
+
+
+sub parse {
+ my $pkg = shift;
+
+ local $_;
+
+ my @phrase  = ();
+ my @comment = ();
+ my @address = ();
+ my @objs    = ();
+ my $depth   = 0;
+ my $idx = 0;
+ my $tokens = _tokenise(grep { defined $_} @_);
+ my $len = scalar(@{$tokens});
+ my $next = _find_next($idx,$tokens,$len);
+
+ for( ; $idx < $len ; $idx++) {
+  $_ = $tokens->[$idx];
+
+  if(substr($_,0,1) eq "(") {
+   push(@comment,$_);
+  }
+  elsif($_ eq '<') {
+   $depth++;
+  }
+  elsif($_ eq '>') {
+   $depth-- if($depth);
+   unless($depth) {
+    my $o = _complete($pkg,\@phrase, \@address, \@comment);
+    push(@objs, $o) if(defined $o);
+    $depth = 0;
+    $next = _find_next($idx,$tokens,$len);
+   }
+  }
+  elsif($_ eq ',') {
+   warn "Unmatched '<>'" if($depth);
+   my $o = _complete($pkg,\@phrase, \@address, \@comment);
+   push(@objs, $o) if(defined $o);
+   $depth = 0;
+   $next = _find_next($idx+1,$tokens,$len);
+  }
+  elsif($depth) {
+   push(@address,$_);
+  }
+  elsif($next eq "<") {
+   push(@phrase,$_);
+  }
+  elsif($_ =~ /\A[\Q.\@:;\E]\Z/ || !scalar(@address) || $address[$#address] =~ /\A[\Q.\@:;\E]\Z/) {
+   push(@address,$_);
+  }
+  else {
+   warn "Unmatched '<>'" if($depth);
+   my $o = _complete($pkg,\@phrase, \@address, \@comment);
+   push(@objs, $o) if(defined $o);
+   $depth = 0;
+   push(@address,$_);
+  }
+ }
+ @objs;
+}
+
+sub set_or_get {
+ my $me = shift;
+ my $i = shift;
+ my $val = $me->[$i];
+
+ $me->[$i] = shift if(@_);
+
+ $val;
+}
+
+
+sub phrase  { set_or_get(shift,0,@_) }
+sub address { set_or_get(shift,1,@_) }
+sub comment { set_or_get(shift,2,@_) }
+
+
+sub format {
+ my @fmts = ();
+ my $me;
+
+ foreach $me (@_) {
+   my($phrase,$addr,$comment) = @{$me};
+   my @tmp = ();
+
+   if(defined $phrase && length($phrase)) {
+    push(@tmp, $phrase);
+    push(@tmp, "<" . $addr . ">") if(defined $addr && length($addr));
+   }
+   else {
+    push(@tmp, $addr) if(defined $addr && length($addr));
+   }
+   if(defined($comment) && $comment =~ /\S/) {
+    $comment =~ s/^\s*\(?/(/;
+    $comment =~ s/\)?\s*$/)/;
+   }
+   push(@tmp, $comment) if(defined $comment && length($comment));
+   push(@fmts, join(" ", @tmp)) if(scalar(@tmp));
+ }
+
+ return join(", ", @fmts);
+}
+
+
+sub name 
+{
+    my $me = shift;
+    my $phrase = $me->phrase;
+    my $addr = $me->address;
+    
+    $phrase = $me->comment unless(defined($phrase) && length($phrase));
+    
+    my $name = _extract_name($phrase);
+    
+    # first.last@domain address
+    if($name eq '' && $addr =~ /([^\%\.\@_]+([\._][^\%\.\@_]+)+)[\@\%]/o)
+    {
+	($name = $1) =~ s/[\._]+/ /go;
+	$name = _extract_name($name);
+    }
+    
+    if($name eq '' && $addr =~ m#/g=#oi)	
+    # X400 style address
+    {
+	my ($f) = $addr =~ m#g=([^/]*)#oi;
+	my ($l) = $addr =~ m#s=([^/]*)#io;
+	
+	$name = _extract_name($f . " " . $l);
+    }   
+       
+       return length($name) ? $name : undef;
+}
+
+
+sub host {
+ my $me = shift;
+ my $addr = $me->address;
+ my $i = rindex($addr,'@');
+
+ my $host = ($i >= 0) ? substr($addr,$i+1) : undef;
+
+ return $host;
+}
+
+
+sub user {
+ my $me = shift;
+ my $addr = $me->address;
+ my $i = index($addr,'@');
+
+ my $user = ($i >= 0) ? substr($addr,0,$i) : $addr;
+
+ return $user;
+}
+
+
+sub path {
+ return ();
+}
+
+
+sub canon {
+ my $me = shift;
+ return ($me->host, $me->user, $me->path);
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+Mail::Address - Parse mail addresses
+
+=head1 SYNOPSIS
+
+    use Mail::Address;
+    
+    my @addrs = Mail::Address->parse($line);
+    
+    foreach $addr (@addrs) {
+	print $addr->format,"\n";
+    }
+
+=head1 DESCRIPTION
+
+C<Mail::Address> extracts and manipulates RFC822 compilant email
+addresses. As well as being able to create C<Mail::Address> objects
+in the normal manner, C<Mail::Address> can extract addresses from
+the To and Cc lines found in an email message.
+
+=head1 CONSTRUCTORS
+
+=over 4
+
+=item new( PHRASE,  ADDRESS, [ COMMENT ])
+
+ Mail::Address->new("Perl5 Porters", "perl5-porters@africa.nicoh.com");
+
+Create a new C<Mail::Address> object which represents an address with the
+elements given. In a message these 3 elements would be seen like:
+
+ PHRASE <ADDRESS> (COMMENT)
+ ADDRESS (COMMENT)
+
+=item parse( LINE )
+
+ Mail::Address->parse($line);
+
+Parse the given line a return a list of extracted C<Mail::Address> objects.
+The line would normally be one taken from a To,Cc or Bcc line in a message
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item phrase ()
+
+Return the phrase part of the object.
+
+=item address ()
+
+Return the address part of the object.
+
+=item comment ()
+
+Return the comment part of the object
+
+=item format ()
+
+Return a string representing the address in a suitable form to be placed
+on a To,Cc or Bcc line of a message
+
+=item name ()
+
+Using the information contained within the object attempt to identify what
+the person or groups name is
+
+=item host ()
+
+Return the address excluding the user id and '@'
+
+=item user ()
+
+Return the address excluding the '@' and the mail domain
+
+=item path ()
+
+Unimplemented yet but should return the UUCP path for the message
+
+=item canon ()
+
+Unimplemented yet but should return the UUCP canon for the message
+
+=back
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-8 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
diff --git a/cpan/dist/MailTools/Mail/Cap.pm b/cpan/dist/MailTools/Mail/Cap.pm
new file mode 100644
index 00000000..3edac654
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Cap.pm
@@ -0,0 +1,338 @@
+#
+
+package Mail::Cap;
+use strict;
+
+use vars qw($VERSION $useCache);
+
+$VERSION = "1.07";
+sub Version { $VERSION; }
+
+=head1 NAME
+
+Mail::Cap - Parse mailcap files
+
+=head1 SYNOPSIS
+
+    my $mc = new Mail::Cap;
+
+    $desc = $mc->description('image/gif');
+
+    print "GIF desc: $desc\n";
+
+    $cmd = $mc->viewCmd('text/plain; charset=iso-8859-1', 'file.txt');
+
+=head1 DESCRIPTION
+
+Parse mailcap files as specified in RFC 1524 - I<A User Agent
+Configuration Mechanism For Multimedia Mail Format Information>.  In
+the description below C<$type> refers to the MIME type as specified in
+the I<Content-Type> header of mail or HTTP messages.  Examples of
+types are:
+
+  image/gif
+  text/html
+  text/plain; charset=iso-8859-1
+
+=cut
+
+$useCache = 1;  # don't evaluate tests every time
+
+my @path;
+
+if($^O eq "MacOS") {
+    @path = split(/,/, $ENV{MAILCAPS} ||
+	"$ENV{HOME}mailcap");
+} else {
+    @path = split(/:/, $ENV{MAILCAPS} ||
+	# this path is specified under RFC 1524 appendix A 
+	( defined($ENV{HOME})
+	  ? "$ENV{HOME}/.mailcap:/etc/mailcap:/usr/etc/mailcap:/usr/local/etc/mailcap"
+	  : "/etc/mailcap:/usr/etc/mailcap:/usr/local/etc/mailcap"));
+}
+
+
+=head1 METHODS
+
+=head2 new()
+
+  $mcap = new Mail::Cap;
+  $mcap = new Mail::Cap "/mydir/mailcap";
+
+Create and initialize a new Mail::Cap object.  If you give it an
+argument it will try to parse the specified file.  Without any
+arguments it will search for the mailcap file using the standard
+mailcap path, or the MAILCAPS environment variable if it is defined.
+
+=cut
+
+sub new
+{
+    my($class, $file) = @_;
+    unless (defined $file) {
+	for (@path) {
+	    if (-r $_) {
+		$file = $_;
+		last;
+	    }
+	}
+    }
+    my $self = bless {}, $class;
+    local *MAILCAP;
+    if (defined $file && open(MAILCAP, $file)) {
+	$self->{'_file'} = $file;
+      local($_);
+	while (<MAILCAP>) {
+	    next if /^\s*#/; # comment
+	    next if /^\s*$/; # blank line
+	    while (s/\\\s*$//) {  # continuation line
+		$_ .= <MAILCAP>;
+	    }
+	    chomp;
+	    s/\0//g;            # ensure no NULs in the line
+	    s/([^\\]);/$1\0/g;  # make field separator NUL
+	    my @parts = split(/\s*\0\s*/, $_);
+	    my $type = shift(@parts);
+	    $type .= "/*" unless $type =~ m,/,;
+	    my $view = shift(@parts);
+	    $view =~ s/\\;/;/g;
+	    my %field = ('view' => $view);
+	    for (@parts) {
+		my($key,$val) = split(/\s*=\s*/, $_, 2);
+		if (defined $val) {
+		    $val =~ s/\\;/;/g;
+		} else {
+		    $val = 1;
+		}
+		$field{$key} = $val;
+	    }
+	    if ($field{'test'}) {
+		my $test = $field{'test'};
+		unless ($test =~ /%/) {
+		    # No parameters in test, can perform it right away
+		    system $test;
+		    next if $?;
+		}
+	    }
+	    # record this entry
+	    unless (exists $self->{$type}) {
+		$self->{$type} = [];
+	    }
+	    push(@{$self->{$type}}, \%field);
+	}
+	close(MAILCAP);
+    } else {
+	# Set up default mailcap
+      $self->{'audio/*'} = [{'view' => "showaudio %s"}];
+      $self->{'image/*'} = [{'view' => "xv %s"}];
+      $self->{'message/rfc822'} = [{'view' => "xterm -e metamail %s"}];
+    }
+    $self;
+}
+
+=head2 view($type, $file)
+
+=head2 compose($type, $file)
+
+=head2 edit($type, $file)
+
+=head2 print($type, $file)
+
+These methods invoke a suitable progam presenting or manipulating the
+media object in the specified file.  They all return C<1> if a command
+was found, and C<0> otherwise.  You might test C<$?> for the outcome
+of the command.
+
+=cut
+
+sub view       { my $self = shift; $self->_run($self->viewCmd(@_));    }
+sub compose    { my $self = shift; $self->_run($self->composeCmd(@_)); }
+sub edit       { my $self = shift; $self->_run($self->editCmd(@_));    }
+sub print      { my $self = shift; $self->_run($self->printCmd(@_));   }
+
+=head2 viewCmd($type, $file)
+
+=head2 composeCmd($type, $file)
+
+=head2 editCmd($type, $file)
+
+=head2 printCmd($type, $file)
+
+These methods return a string that is suitable for feeding to system()
+in order to invoke a suitable progam presenting or manipulating the
+media object in the specified file.  It will return C<undef> if no
+suitable specification exists.
+
+=cut
+
+sub viewCmd    { shift->_createCommand('view', @_);    }
+sub composeCmd { shift->_createCommand('compose', @_); }
+sub editCmd    { shift->_createCommand('edit', @_);    }
+sub printCmd   { shift->_createCommand('print', @_);   }
+
+sub _createCommand
+{
+    my($self, $method, $type, $file) = @_;
+    my $entry = $self->getEntry($type, $file);
+    return undef unless $entry;
+    if (exists $entry->{$method}) {
+	return $self->expandPercentMacros($entry->{$method}, $type, $file);
+    } else {
+	return undef;
+    }
+}
+
+sub _run
+{
+    my($self, $cmd) = @_;
+    if (defined $cmd) {
+	system $cmd;
+	return 1;
+    }
+    0;
+}
+
+sub makeName
+{
+    my($self, $type, $basename) = @_;
+    my $template = $self->nametemplate($type);
+    return $basename unless $template;
+    $template =~ s/%s/$basename/g;
+    $template;
+}
+
+=head2 field($type, $field)
+
+Returns the specified field for the type.  Returns undef if no
+specification exsists.
+
+=cut
+
+sub field
+{
+    my($self, $type, $field) = @_;
+    my $entry = $self->getEntry($type);
+    $entry->{$field};
+}
+
+=head2 description($type)
+
+=head2 textualnewlines($type)
+
+=head2 x11_bitmap($type)
+
+=head2 nametemplate($type)
+
+These methods return the corresponding mailcap field for the type.
+These methods should be more convenient to use than the field() method
+for the same fields.
+
+=cut
+
+sub description     { shift->field(shift, 'description');     }
+sub textualnewlines { shift->field(shift, 'textualnewlines'); }
+sub x11_bitmap      { shift->field(shift, 'x11-bitmap');      }
+sub nametemplate    { shift->field(shift, 'nametemplate');    }
+
+sub getEntry
+{
+    my($self, $origtype, $file) = @_;
+
+    if ($useCache) {
+	if (exists $self->{'_cache'}{$origtype}) {
+	    return $self->{'_cache'}{$origtype};
+	}
+    }
+
+    my($fulltype, @params) = split(/\s*;\s*/, $origtype);
+    my($type, $subtype) = split(/\//, $fulltype, 2);
+    $subtype = "" unless defined $subtype;
+
+    my $entry;
+    for (@{$self->{"$type/$subtype"}}, @{$self->{"$type/*"}}) {
+	if (exists $_->{'test'}) {
+	    # must run test to see if it applies
+	    my $test = $self->expandPercentMacros($_->{'test'},
+						  $origtype, $file);
+	    system $test;
+	    next if $?;
+	}
+	$entry = { %$_ };  # make copy
+        last;
+    }
+    $self->{'_cache'}{$origtype} = $entry if $useCache;
+    $entry;
+}
+
+
+sub expandPercentMacros
+{
+    my($self,$text,$type,$file) = @_;
+    return $text unless defined $type;
+    $file = "" unless defined $file;
+    my($fulltype, @params) = split(/\s*;\s*/, $type);
+    my $subtype;
+    ($type, $subtype) = split(/\//, $fulltype, 2);
+    my %params;
+    for (@params) {
+	my($key,$val) = split(/\s*=\s*/, $_, 2);
+	$params{$key} = $val;
+    }
+    $text =~ s/\\%/\0/g;  # hide all escaped %'s
+    $text =~ s/%t/$fulltype/g;  # expand %t
+    $text =~ s/%s/$file/g;      # expand %s
+    {                           # expand %{field}
+	local($^W) = 0;  # avoid warnings when expanding %params
+	$text =~ s/%\{\s*(.*?)\s*\}/$params{$1}/g;
+    }
+    $text =~ s/\0/%/g;
+    $text;
+}
+
+# This following procedures can be useful for debugging purposes
+
+sub dumpEntry
+{
+    my($hash, $prefix) = @_;
+    $prefix = "" unless defined $prefix;
+    for (sort keys %$hash) {
+	print "$prefix$_ = $hash->{$_}\n";
+    }
+}
+
+sub dump
+{
+    my($self) = @_;
+    for (keys %$self) {
+	next if /^_/;
+	print "$_\n";
+	for (@{$self->{$_}}) {
+	    dumpEntry($_, "\t");
+	    print "\n";
+	}
+    }
+    if (exists $self->{'_cache'}) {
+	print "Cached types\n";
+	for (keys %{$self->{'_cache'}}) {
+	    print "\t$_\n";
+	}
+    }
+}
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Gisle Aas. All rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Gisle Aas <aas@oslonett.no> 
+
+Maintained by Graham Barr <gbarr@pobox.com>
+
+=cut
+
+
+1;
diff --git a/cpan/dist/MailTools/Mail/Field.pm b/cpan/dist/MailTools/Mail/Field.pm
new file mode 100644
index 00000000..0742a6f7
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Field.pm
@@ -0,0 +1,507 @@
+# Mail::Field.pm
+#
+# Copyright (c) 1995-2000 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Mail::Field;
+
+# $Id: //depot/MailTools/Mail/Field.pm#7 $
+
+use Carp;
+use strict;
+use vars qw($AUTOLOAD $VERSION);
+
+$VERSION = "1.08";
+
+unless(defined &UNIVERSAL::can) {
+    *UNIVERSAL::can = sub {
+	my($obj,$meth) = @_;
+	my $pkg = ref($obj) || $obj;
+	my @pkg = ($pkg);
+	my %done;
+	while(@pkg) {
+            $pkg = shift @pkg;
+            next if exists $done{$pkg};
+            $done{$pkg} = 1;
+
+	    no strict 'refs';
+
+            unshift @pkg,@{$pkg . "::ISA"}
+        	if(@{$pkg . "::ISA"});
+            return \&{$pkg . "::" . $meth}
+        	if defined(&{$pkg . "::" . $meth});
+	}
+	undef;
+    }
+}
+
+sub _header_pkg_name
+{
+ my($header) = lc shift;
+
+ $header =~ s/((\b|_)\w)/\U$1/gio;
+
+ if (length($header) > 8)
+  {
+   my @header = split /[-_]+/, $header;
+   my $chars = int((7 + @header) / @header) || 1;
+   $header = substr(join('', map { substr($_,0,$chars) } @header),0,8);
+  }
+ else
+  {
+   $header =~ s/[-_]+//go;
+  }
+
+ 'Mail::Field::' . $header;
+}
+
+##
+## Use the import method to load the sub-classes
+##
+
+sub _require_dir
+{
+ my($pkg,$dir,$dir_sep) = @_;
+
+ if(opendir(DIR,$dir))
+  {
+   my @inc =  ();
+   my $f;
+
+   foreach $f (readdir(DIR))
+    {
+     next
+	unless $f =~ /^([\w\-]+)/;
+
+     my $p = $1;
+     my $n = $dir . $dir_sep . $p;
+
+     if(-d $n )
+      {
+       _require_dir( $pkg . "::" . $f, $n, $dir_sep);
+      }
+     else
+      {
+       $p =~ s/-/_/go;
+       eval "require ${pkg}::$p"
+      }
+    }
+   closedir(DIR);
+  }
+}
+
+sub import
+{
+ my $pkg = shift;
+
+ if(@_)
+  {
+   local $_;
+   map { 
+        eval "require " . _header_pkg_name($_) || die $@;
+       } @_;
+  }
+ else
+  {
+   my($f,$dir,$dir_sep);
+   foreach $f (keys %INC)
+    {
+     if($f =~ /^Mail(\W)Field\W/i)
+      {
+       $dir_sep = $1;
+       $dir = ($INC{$f} =~ /(.*Mail\W+Field)/i)[0] . $dir_sep;
+       last;
+      }
+    }
+   _require_dir('Mail::Field', $dir, $dir_sep);
+  }
+}
+
+
+##
+## register a header class, this creates a new method in Mail::Field
+## which will call new on that class
+##
+
+sub register
+{
+ my $self = shift;
+ my $method = lc shift;
+ my $pkg = shift || ref($self) || $self;
+
+ $method =~ tr/-/_/;
+
+ $pkg = _header_pkg_name($method)
+	if($pkg eq "Mail::Field");
+
+ croak "Re-register of $method"
+	if Mail::Field->can($method);
+
+ no strict 'refs';
+ *{$method} = sub {
+	shift;
+	unless ($pkg->can('stringify')) {
+	    eval "require $pkg" || die $@;
+	}
+	$pkg->_build(@_);
+ };
+
+}
+
+##
+## the *real* constructor
+## if called with one argument then the `parse' method will be called
+## otherwise the `create' method is called
+##
+
+sub _build
+{
+ my $type = shift;
+ my $self = bless {}, $type;
+
+ @_ == 1 ? $self->parse(@_)
+	 : $self->create(@_);
+}
+
+sub new
+{
+ my $self  = shift; # ignored
+ my $field = lc shift;
+
+ $field =~ tr/-/_/;
+ 
+ $self->$field(@_);
+}
+
+##
+## A default create method. This allows us to do
+## $s = Mail::Field->new('Subject', Text => "joe");
+## $s = Mail::Field->new('Subject', "joe");
+##
+
+sub create
+{
+ my $self = shift;
+ my %arg = @_;
+
+ $self = bless {}, $self
+	unless ref($self);
+
+ %$self = ();
+
+ $self->set(\%arg);
+}
+
+##
+## A default create method. This allows us to do
+## $s = Mail::Field->new('Subject');
+##
+
+sub parse
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+
+ croak "$type: Cannot parse";
+}
+
+##
+## either get the text, or parse a new one
+##
+
+sub text
+{
+ my $self = shift;
+ @_ ? $self->parse(@_)
+    : $self->stringify;
+}
+
+##
+## Return the tag (in the correct case) for this item
+##
+
+sub tag
+{
+ my $self = shift;
+ my $tag = ref($self) || $self;
+
+ $tag =~ s/.*:://o;
+ $tag =~ s/_/-/og;
+ $tag =~ s/\b([a-z]+)/\L\u$1/gio;
+ $tag =~ s/\b([b-df-hj-np-tv-z]+)\b/\U$1/gio;
+
+ $tag;
+}
+
+##
+## a constructor
+## create a new object by extracting from a Mail::Header object
+##
+
+sub extract
+{
+ my $self = shift;
+
+ my $tag  = shift;
+ my $head = shift;
+
+ my $method = lc $tag;
+ $method =~ tr/-/_/;
+
+ my $text;
+
+ if(@_ == 0 && wantarray)
+  {
+   my @ret = ();
+
+   foreach $text ($head->get($tag))
+    {
+     chomp($text);
+
+     push(@ret, $self->$method($text));
+    }
+
+   return @ret;
+  }
+
+ my $idx  = shift || 0;
+
+ $text = $head->get($tag,$idx) or
+	return undef;
+
+ chomp($text);
+
+ $self->$method($text);
+}
+
+##
+## Autoload sub-classes, or, if the .pm file cannot be found, create a dummy
+## sub-class based on Mail::Field::Generic
+##
+
+sub AUTOLOAD
+{
+ my $method = $AUTOLOAD;
+
+ $method =~ s/.*:://o;
+
+ croak "Undefined subroutine &$AUTOLOAD called"
+	unless $method =~ /^[^A-Z\x00-\x1f\x80-\xff :]+$/o;
+
+ my $pkg = _header_pkg_name($method);
+
+ unless(eval "require " . $pkg)
+  {
+   my $tag = $method;
+
+   $tag =~ s/_/-/og;
+   $tag =~ s/\b([a-z]+)/\L\u$1/gio;
+   $tag =~ s/\b([b-df-hj-np-tv-z]+)\b/\U$1/gio;
+
+   no strict;
+
+   @{$pkg . "::ISA"} = qw(Mail::Field::Generic);
+   *{$pkg . "::tag"} = sub { $tag };
+  }
+
+  $pkg->register($method)
+	unless(Mail::Field->can($method));
+
+ goto &$AUTOLOAD;
+}
+
+##
+## prevent the calling of AUTOLOAD for DESTROY :-)
+##
+
+sub DESTROY {}
+
+##
+## A generic package for those not defined in thier own package. This is
+## fine for fields like Subject, X-Mailer etc. where the field holds only
+## a string of no particular importance/format.
+##
+
+package Mail::Field::Generic;
+
+use Carp;
+use vars qw(@ISA);
+
+@ISA = qw(Mail::Field);
+
+sub create
+{
+ my $self = shift;
+ my %arg = @_;
+ my $text = delete $arg{Text} || "";
+
+ croak "Unknown options " . join(",", keys %arg)
+	if %arg;
+
+ $self->{Text} = $text;
+
+ $self;
+}
+
+sub parse
+{
+ my $self = shift;
+
+ $self->{Text} = shift || "";
+ $self;
+}
+
+sub stringify
+{
+ my $self = shift;
+ $self->{Text};
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Mail::Field - Base class for manipulation of mail header fields
+
+=head1 SYNOPSIS
+
+    use Mail::Field;
+    
+    $field = Mail::Field->new('Subject', 'some subject text');
+    print $field->tag,": ",$field->stringify,"\n";
+
+    $field = Mail::Field->subject('some subject text');
+
+=head1 DESCRIPTION
+
+C<Mail::Field> is a base class for packages that create and manipulate
+fields from Email (and MIME) headers. Each different field will have its
+own sub-class, defining its own interface.
+
+This document describes the minimum interface that each sub-class should
+provide, and also guidlines on how the field specific interface should be
+defined. 
+
+=head1 CONSTRUCTOR
+
+Mail::Field, and it's sub-classes define several methods which return
+new objects. These can all be termed to be constructors.
+
+=over 4
+
+=item new ( TAG [, STRING | OPTIONS ] )
+
+The new constructor will create an object in the class which defines
+the field specified by the tag argument.
+
+After creation of the object :-
+
+If the tag argument is followed by a single string then the C<parse> method
+will be called with this string.
+
+If the tag argument is followed by more than one arguments then the C<create>
+method will be called with these arguments.
+
+=item extract ( TAG, HEAD [, INDEX ] )
+
+This constuctor takes as arguments the tag name, a C<Mail::Head> object
+and optionally an index.
+
+If the index argument is given then C<extract> will retrieve the given tag
+from the C<Mail::Head> object and create a new C<Mail::Field> based object.
+I<undef> will be returned in the field does not exist.
+
+If the index argument is not given the the result depends on the context
+in which C<extract> is called. If called in a scalar context the result
+will be as if C<extract> was called with an index value of zero. If called
+in an array context then all tags will be retrieved and a list of
+C<Mail::Field> objects will be returned.
+
+=item combine ( FIELD_LIST )
+
+This constructor takes as arguments a list of C<Mail::Field> objects, which
+should all be of the same sub-class, and creates a new object in that same
+class.
+
+This constructor is nor defined in C<Mail::Field> as there is no generic
+way to combine the various field types. Each sub-class should define
+its own combine constructor, if combining is possible/allowed.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item parse
+
+=item set
+
+=item tag
+
+=item stringify
+
+=back
+
+=head1 SUB-CLASS PACKAGE NAMES
+
+All sub-classes should be called Mail::Field::I<name> where I<name> is
+derived from the tag using these rules.
+
+=over 4
+
+=item *
+
+Consider a tag as being made up of elements separated by '-'
+
+=item *
+
+Convert all characters to lowercase except the first in each element, which
+should be uppercase.
+
+=item *
+
+I<name> is then created from these elements by using the first
+N characters from each element.
+
+=item *
+
+N is calculated by using the formula :-
+
+    int((7 + #elements) / #elements)
+
+=item *
+
+I<name> is then limited to a maximum of 8 characters, keeping the first 8
+characters
+
+=back
+
+For an example of this take a look at the definition of the 
+C<_header_pkg_name> subroutine in C<Mail::Field>
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 SEE ALSO
+
+L<MIME::*>s
+
+=head1 CREDITS
+
+Eryq <eryq@rhine.gsfc.nasa.gov> - for all the help in defining this package
+so that Mail::* and MIME::* can be integrated together.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-2000 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+
diff --git a/cpan/dist/MailTools/Mail/Field/AddrList.pm b/cpan/dist/MailTools/Mail/Field/AddrList.pm
new file mode 100644
index 00000000..fa6a0d5c
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Field/AddrList.pm
@@ -0,0 +1,107 @@
+package Mail::Field::AddrList;
+
+=head1 NAME 
+
+Mail::Field::AddrList - object representation of e-mail address lists
+
+=head1 DESCRIPTION
+
+I<Don't use this class directly!> Instead ask Mail::Field for new
+instances based on the field name!
+
+=head1 SYNOPSIS
+
+  use Mail::Field::AddrList;
+
+  $to = Mail::Field->new('To');
+  $from = Mail::Field->new('From', 'poe@daimi.aau.dk (Peter Orbaek)');
+  
+  $from->create('foo@bar.com' => 'Mr. Foo', poe => 'Peter');
+  $from->parse('foo@bar.com (Mr Foo), Peter Orbaek <poe>');
+
+  # make a RFC822 header string
+  print $from->stringify(),"\n";
+
+  # extract e-mail addresses and names
+  @addresses = $from->addresses();
+  @names = $from->names();
+
+  # adjoin a new address to the list
+  $from->set_address('foo@bar.com', 'Mr. Foo');
+
+=head1 NOTES
+
+Defines parsing and formatting according to RFC822, of the following fields:
+To, From, Cc, Reply-To and Sender.
+
+=head1 AUTHOR
+
+Peter Orbaek <poe@cit.dk> 26-Feb-97
+Modified by Graham Barr <gbarr@pobox.com>
+
+=cut
+
+use strict;
+use vars qw(@ISA $VERSION);
+use Mail::Field ();
+use Carp;
+use Mail::Address;
+
+@ISA = qw(Mail::Field);
+$VERSION = '1.0';
+
+# install header interpretation, see Mail::Field
+INIT: {
+    my $x = bless([]);
+
+    $x->register('To');
+    $x->register('From');
+    $x->register('Cc');
+    $x->register('Reply-To');
+    $x->register('Sender');
+}
+
+sub create {
+    my ($self, %arg) = @_;  # (email => name, email => realname,...)
+    my($e,$n);
+    $self->{AddrList} = {};
+
+    $self->{AddrList}{$e} = Mail::Address->new($n,$e)
+	while(($e,$n) = each %arg);
+
+    $self;
+}
+
+sub parse {
+    my ($self, $string) = @_;
+    my ($a,$email,$name);
+
+    foreach $a (Mail::Address->parse($string)) {
+	my $e = $a->address;
+	$self->{AddrList}{$e} = $a;
+    }
+    $self;
+}
+
+sub stringify {
+    my $self = shift;
+    my ($x, $email, $name);
+
+    join(", ", map { $_->format } values %{$self->{AddrList}});
+}
+
+sub addresses {
+    keys %{shift->{AddrList}};
+}
+
+sub names {
+    map { $_->name } values %{shift->{AddrList}};
+}
+
+sub set_address {
+    my ($self, $email, $name) = @_;
+    $self->{AddrList}{$email} = Mail::Address->new($name, $email);
+    $self;
+}
+
+1;
diff --git a/cpan/dist/MailTools/Mail/Field/Date.pm b/cpan/dist/MailTools/Mail/Field/Date.pm
new file mode 100644
index 00000000..61ea3e65
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Field/Date.pm
@@ -0,0 +1,80 @@
+# Mail::Field::Date
+#
+# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+# An example of a Mail::Field::* class
+
+package Mail::Field::Date;
+
+use strict;
+use Mail::Field ();
+use vars qw(@ISA $VERSION);
+use Date::Format qw(time2str);
+use Date::Parse qw(str2time);
+
+@ISA = qw(Mail::Field);
+$VERSION = do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+
+bless([])->register('Date');
+
+sub set
+{
+ my $self = shift;
+ my $arg = @_ == 1 ? shift : { @_ };
+ my $s;
+
+ foreach $s (qw(Time TimeStr))
+  {
+   if(exists $arg->{$s}) { $self->{$s} = $arg->{$s} }
+		    else { delete $self->{$s} }
+  }
+
+ $self;
+}
+
+sub parse
+{
+ my $self = shift;
+
+ delete $self->{Time};
+ $self->{TimeStr} = shift;
+ $self;
+}
+
+sub time
+{
+ my $self = shift;
+
+ if(@_)
+  {
+   delete $self->{TimeStr};
+   return $self->{Time} = shift;
+  }
+
+ return $self->{Time}
+	if exists $self->{Time};
+
+ $self->{Time} = str2time($self->{TimeStr});
+}
+
+sub stringify
+{
+ my $self = shift;
+
+ return $self->{TimeStr}
+	if exists $self->{TimeStr};
+
+ time2str("%a, %e %b %T %Y %z", $self->time);
+}
+
+sub reformat
+{
+ my $self = shift;
+ $self->time($self->time);
+ $self->stringify;
+}
+
+1;
+
diff --git a/cpan/dist/MailTools/Mail/Filter.pm b/cpan/dist/MailTools/Mail/Filter.pm
new file mode 100644
index 00000000..1101084a
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Filter.pm
@@ -0,0 +1,182 @@
+# Mail::Filter.pm
+#
+# Copyright (c) 1997 Graham Barr <gbarr@pobox.com>. All rights
+# reserved. This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Mail::Filter;
+
+use Carp;
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "1.01";
+
+sub new {
+    my $self = shift;
+    
+    bless {
+	filters => [ @_ ]
+    }, $self;
+}
+
+sub add {
+    my $self = shift;
+    push(@{$self->{'filters'}}, @_);
+}
+
+sub _filter {
+    my $self = shift;
+    my $mail = shift;
+    my $sub;
+
+    foreach $sub (@{$self->{'filters'}}) {
+	if(ref($sub) eq "CODE") {
+	    $mail = $sub->($self,$mail);
+	}
+	elsif(!ref($sub)) {
+	    $mail = $self->$sub($mail);
+	}
+	else {
+	   carp "Cannot call filter '$sub', ignored";
+	}
+	last unless ref($mail);
+    }
+    # the specification indicates that the result of operations on $mail 
+    # should be returned by this function
+    return $mail;
+}
+
+sub filter {
+    my $self = shift;
+    my $obj = shift;
+    
+    if($obj->isa('Mail::Folder')) {
+	$self->{'folder'} = $obj;
+	my $m;
+	foreach $m ($obj->message_list) {
+	    my $mail = $obj->get_message($m) || next;
+	    $self->{'msgnum'} = $m;
+	    _filter($self,$mail);
+	}
+	delete $self->{'folder'};
+	delete $self->{'msgnum'};
+    }
+    elsif($obj->isa('Mail::Internet')) {
+	return _filter($self,$obj);
+    }
+    else {
+	carp "Cannot process '$obj'";
+	return undef;
+    }
+}
+
+sub folder {
+    my $self = shift;
+    exists $self->{'folder'}
+	? $self->{'folder'}
+	: undef;
+}
+
+sub msgnum {
+    my $self = shift;
+    exists $self->{'msgnum'}
+	? $self->{'msgnum'}
+	: undef;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Mail::Filter - Filter mail through multiple subroutines
+
+=head1 SYNOPSIS
+
+    use Mail::Filter;
+    
+    $filter = new Mail::Filter( \&filter1, \&filter2 );
+    
+    $mail = new Mail::Internet( [<>] );
+    $mail = $filter->filter($mail);
+    
+    $folder = new Mail::Folder( .... );
+    $filter->filter($folder);
+
+=head1 DESCRIPTION
+
+C<Mail::Filter> provides an interface to filtering Email through multiple
+subroutines.
+
+C<Mail::Filter> filters mail by calling each filter subroutine in turn. Each
+filter subroutine is called with two arguments, the first is the filter
+object and the second is the mail or folder object being filtered.
+
+The result from each filter sub is passed to the next filter as the mail
+object. If a filter subroutine returns undef, then C<Mail::Filter> will abort
+and return immediately.
+
+The function returns the result from the last subroutine to operate on the 
+mail object.  
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ FILTER [, ... ]])
+
+Create a new C<Mail::Filter> object with the given filter subroutines. Each
+filter may be either a code reference or the name of a method to call
+on the <Mail::Filter> object.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item add ( FILTER [, FILTER ...] )
+
+Add the given filters to the end of the fliter list.
+
+=item filter ( MAIL-OBJECT | MAIL-FOLDER )
+
+If the first argument is a C<Mail::Internet> object, then this object will
+be passed through the filter list. If the first argument is a C<Mail::Folder>
+object, then each message in turn will be passed through the filter list.
+
+=item folder
+
+If the C<filter> method is called with a C<Mail::Folder> object, then the
+filter subroutines may call this method to obtain the folder object that is
+being processed.
+
+=item msgnum
+
+If the C<filter> method is called with a C<Mail::Folder> object, then the
+filter subroutines may call this method to obtain the message number
+of the message that is being processed.
+
+=back
+
+=head1 SEE ALSO
+
+L<Mail::Internet>
+L<Mail::Folder>
+
+=head1 AUTHOR
+
+Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1997 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+
diff --git a/cpan/dist/MailTools/Mail/Header.pm b/cpan/dist/MailTools/Mail/Header.pm
new file mode 100644
index 00000000..e4fd8af6
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Header.pm
@@ -0,0 +1,1022 @@
+# Mail::Header.pm
+#
+# Copyright (c) 1995-7 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+#
+# The internals of this package are implemented in terms of a list of lines
+# and a hash indexed by the tags. The hash contains a list of references to
+# the actual SV's in the list. We therefore do our upmost to preserve this.
+# anyone who delves into these structures deserve all they get.
+#
+
+package Mail::Header;
+
+require 5.002;
+
+use strict;
+use Carp;
+use vars qw($VERSION $FIELD_NAME);
+
+$VERSION = "1.19";
+
+my $MAIL_FROM = 'KEEP';
+my %HDR_LENGTHS = ();
+
+#
+# Pattern to match a RFC822 Field name ( Extract from RFC #822)
+#
+#     field       =  field-name ":" [ field-body ] CRLF
+#
+#     field-name  =  1*<any CHAR, excluding CTLs, SPACE, and ":">
+#
+#     CHAR        =  <any ASCII character>        ; (  0-177,  0.-127.)
+#     CTL         =  <any ASCII control           ; (  0- 37,  0.- 31.)
+#		      character and DEL>          ; (    177,     127.)
+# I have included the trailing ':' in the field-name
+#
+$FIELD_NAME = '[^\x00-\x1f\x7f-\xff :]+:';
+
+##
+## Private functions
+##
+
+sub _error { warn @_; return (wantarray ? () : undef) }
+
+# tidy up internal hash table and list
+
+sub _tidy_header
+{
+ my $me = shift;
+ my($ref,$key);
+ my $i;
+ my $d = 0;
+
+ for($i = 0 ; $i < scalar(@{$me->{'mail_hdr_list'}}) ; $i++)
+  {
+   unless(defined $me->{'mail_hdr_list'}[$i])
+    {
+     splice(@{$me->{'mail_hdr_list'}},$i,1);
+     $d++;
+     $i--;
+    }
+  }
+
+ if($d)
+  {
+   local $_;
+   my @del = ();
+
+   while(($key,$ref) = each %{$me->{'mail_hdr_hash'}} )
+    {
+     push(@del, $key)
+	unless @$ref = grep { ref($_) && defined $$_ } @$ref;
+    }
+
+   map { delete $me->{'mail_hdr_hash'}{$_} } @del;
+  }
+}
+
+# fold the line to the given length
+
+my %STRUCTURE;
+@STRUCTURE{ map { lc } qw{
+  To Cc Bcc From Date Reply-To Sender
+  Resent-Date Resent-From Resent-Sender Resent-To Return-Path
+  list-help list-post list-unsubscribe Mailing-List
+  Received References Message-ID In-Reply-To
+  Content-Length Content-Type
+  Delivered-To
+  Lines
+  MIME-Version
+  Precedence
+  Status
+}} = ();
+
+sub _fold_line
+{
+ my($ln,$maxlen) = @_;
+
+ $maxlen = 20
+    if($maxlen < 20);
+
+ my $max = int($maxlen - 5);         # 4 for leading spcs + 1 for [\,\;]
+ my $min = int($maxlen * 4 / 5) - 4;
+ my $ml = $maxlen;
+
+ $_[0] =~ s/\s*[\r\n]+\s*/ /og; # Compress any white space around a newline
+ $_[0] =~ s/\s*\Z/\n/so;        # End line with a EOLN
+
+ return if $_[0] =~ /^From\s/io;
+
+ if(length($_[0]) > $ml)
+  {
+   if ($_[0] =~ /^([-\w]+)/ and exists $STRUCTURE{ lc $1 } )
+    {
+     #Split the line up
+     # first bias towards splitting at a , or a ; >4/5 along the line
+     # next split a whitespace
+     # else we are looking at a single word and probably don't want to split
+     my $x = "";
+
+     $x .= "$1\n    "
+	while($_[0] =~ s/^\s*(
+			   [^"]{$min,$max}?[\,\;]
+			  |[^"]{1,$max}\s
+			  |[^\s"]*(?:"[^"]*"[^\s"]*)+\s
+			  |[^\s"]+\s
+			  )
+			//x);
+     $x .= $_[0];
+     $_[0] = $x;
+     $_[0] =~ s/(\A\s+|[\t ]+\Z)//sog;
+     $_[0] =~ s/\s+\n/\n/sog;
+    }
+   else
+    {
+      my $dif = $max-$min;
+
+      $_[0] =~ s/(?:^|\G)
+		(?:
+		  (.{$min,$max})\s+
+		 |(.{$min,$max})
+		)
+                /$+\n    /xg;
+    }
+  }
+
+ $_[0] =~ s/\A(\S+)\n\s*(?=\S)/$1 /so; 
+}
+
+# attempt to change the case of a tag to that required by RFC822. That
+# being all characters are lowercase except the first of each word. Also
+# if the word is an `acronym' then all characters are uppercase. We decide
+# a word is an acronym if it does not contain a vowel.
+
+sub _tag_case
+{
+ my $tag = shift;
+
+ $tag =~ s/:\Z//o;
+
+ # Change the case of the tag
+ # eq Message-Id
+ $tag =~ s/\b([a-z]+)/\L\u$1/gio;
+ $tag =~ s/\b([b-df-hj-np-tv-z]+|MIME)\b/\U$1/gio
+	if $tag =~ /-/;
+
+ $tag;
+}
+
+# format a complete line
+#  ensure line starts with the given tag
+#  ensure tag is correct case
+#  change the 'From ' tag as required
+#  fold the line
+
+sub _fmt_line
+{
+ my $me = shift;
+ my $tag = shift;
+ my $line = shift;
+ my $modify = shift || $me->{'mail_hdr_modify'};
+ my $ctag = undef;
+
+ ($tag) = $line =~ /\A($FIELD_NAME|From )/oi
+    unless(defined $tag);
+
+ if($tag =~ /\AFrom /io && $me->{'mail_hdr_mail_from'} ne 'KEEP')
+  {
+   if ($me->{'mail_hdr_mail_from'} eq 'COERCE')
+    {
+     $line =~ s/^From /Mail-From: /o;
+     $tag = "Mail-From:";
+    }
+   elsif ($me->{'mail_hdr_mail_from'} eq 'IGNORE')
+    {
+     return ();
+    }
+   elsif ($me->{'mail_hdr_mail_from'} eq 'ERROR')
+    {
+     return _error "unadorned 'From ' ignored: <$line>"
+    }
+  }
+
+ if(defined $tag)
+  {
+   $tag = _tag_case($ctag = $tag);
+
+   $ctag = $tag
+   	if($modify);
+
+   $ctag =~ s/([^ :])\Z/$1:/o if defined $ctag;
+  }
+
+ croak( "Bad RFC822 field name '$tag'\n")
+   unless(defined $ctag && $ctag =~ /\A($FIELD_NAME|From )/oi);
+
+ # Ensure the line starts with tag
+ if(defined($ctag) && ($modify || $line !~ /\A\Q$ctag\E/i))
+  {
+   my $xtag;
+   ($xtag = $ctag) =~ s/\s*\Z//o;
+   $line =~ s/\A(\Q$ctag\E)?\s*/$xtag /i;
+  }
+
+ my $maxlen = $me->{'mail_hdr_lengths'}{$tag}
+		|| $HDR_LENGTHS{$tag}
+		|| $me->fold_length;
+
+ _fold_line($line,$maxlen)
+    if $modify && defined $maxlen;
+
+ $line =~ s/\n*\Z/\n/so;
+
+ ($tag, $line);
+}
+
+sub _insert
+{
+ my($me,$tag,$line,$where) = @_;
+
+ if($where < 0)
+  {
+   $where = scalar(@{$me->{'mail_hdr_list'}}) + $where + 1;
+
+   $where = 0
+	if($where < 0);
+  }
+ elsif($where >= scalar(@{$me->{'mail_hdr_list'}}))
+  {
+   $where = scalar(@{$me->{'mail_hdr_list'}});
+  }
+
+ my $atend = $where == scalar(@{$me->{'mail_hdr_list'}});
+
+ splice(@{$me->{'mail_hdr_list'}},$where,0,$line);
+
+ $me->{'mail_hdr_hash'}{$tag} ||= [];
+ my $ref = \${$me->{'mail_hdr_list'}}[$where];
+
+ if(scalar($me->{'mail_hdr_hash'}{$tag}) && $where)
+  {
+   if($atend)
+    {
+     push(@{$me->{'mail_hdr_hash'}{$tag}}, $ref);
+    }
+   else
+    {
+     my($ln,$i,$ref);
+     $i = 0;
+     foreach $ln (@{$me->{'mail_hdr_list'}})
+      {
+       my $r = \$ln;
+       last if($r == $ref);
+       $i++ if($r == $me->{'mail_hdr_hash'}{$tag}[$i]);
+      }
+     splice(@{$me->{'mail_hdr_hash'}{$tag}},$i,0,$ref);
+    }
+  }
+ else
+  {
+   unshift(@{$me->{'mail_hdr_hash'}{$tag}}, $ref);
+  }
+}
+
+##
+## Constructor
+##
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my $arg = @_ % 2 ? shift : undef;
+ my %arg = @_;
+
+ $arg{Modify} = delete $arg{Reformat} unless exists $arg{Modify};
+
+ my %hash = (
+	mail_hdr_list     => [],
+	mail_hdr_hash     => {},
+	mail_hdr_modify   => delete $arg{Modify} || 0,
+	mail_hdr_foldlen  => 79,
+	mail_hdr_lengths  => {}
+	);
+
+ my $me = bless \%hash, $type;
+
+ $me->mail_from( uc($arg{'MailFrom'} || $MAIL_FROM) );
+
+ $me->fold_length($arg{FoldLength})
+    if exists $arg{FoldLength};
+
+ if(ref $arg)
+  {
+   if(ref($arg) eq 'ARRAY')
+    {
+     $me->extract([ @{$arg} ]);
+    }
+   elsif(defined fileno($arg))
+    {
+     $me->read($arg);
+    }
+  }
+
+ $me;
+}
+
+sub modify
+{
+ my $me = shift;
+ my $old = $me->{'mail_hdr_modify'};
+
+ $me->{'mail_hdr_modify'} = 0 + shift
+	if @_;
+
+ $old;
+}
+
+sub mail_from
+{
+ my $me = shift;
+ my $choice = uc(shift);
+
+ $choice =~ /^(IGNORE|ERROR|COERCE|KEEP)$/ 
+	or die "bad Mail-From choice: '$choice'";
+
+ if(ref($me))
+  {
+   $me->{'mail_hdr_mail_from'} = $choice;
+  }
+ else
+  {
+   $MAIL_FROM = $choice;
+  }
+
+ $me;
+}
+
+sub fold
+{
+ my $me = shift;
+ my $maxlen = shift;
+ my($tag,$list,$ln);
+
+ while(($tag,$list) = each %{$me->{'mail_hdr_hash'}})
+  {
+   my $len = $maxlen
+		|| $me->{'mail_hdr_lengths'}{$tag}
+		|| $HDR_LENGTHS{$tag}
+		|| $me->fold_length;
+
+   foreach $ln (@$list)
+    {
+     _fold_line($$ln,$len)
+        if defined $ln;
+    }
+  }
+
+ $me;
+}
+
+sub unfold
+{
+ my $me = shift;
+ my($tag,$list,$ln);
+
+ if(@_)
+  {
+   $tag = _tag_case(shift);
+   return $me unless exists $me->{'mail_hdr_hash'}{$tag};
+   $list = $me->{'mail_hdr_hash'}{$tag};
+   foreach $ln (@$list)
+    {
+     $$ln =~ s/\r?\n\s+/ /sog
+	if defined $ln && defined $$ln;
+    }
+  }
+ else
+  {
+   while(($tag,$list) = each %{$me->{'mail_hdr_hash'}})
+    {
+     foreach $ln (@$list)
+      {
+       $$ln =~ s/\r?\n\s+/ /sog
+	if defined $ln && defined $$ln;
+      }
+    }
+  }
+ $me;
+}
+
+sub extract
+{
+ my $me = shift;
+ my $arr = shift;
+ my $line;
+
+ $me->empty;
+
+ while(scalar(@{$arr}) && $arr->[0] =~ /\A($FIELD_NAME|From )/o)
+  {
+   my $tag = $1;
+
+   $line = shift @{$arr};
+   $line .= shift @{$arr}
+       while(scalar(@{$arr}) && $arr->[0] =~ /\A[ \t]+/o);
+
+   ($tag,$line) = _fmt_line($me,$tag,$line);
+
+   _insert($me,$tag,$line,-1)
+      if defined $line;
+  }
+
+ shift @{$arr}
+  if(scalar(@{$arr}) && $arr->[0] =~ /\A\s*\Z/o);
+
+ $me;
+}
+
+sub read
+{
+ my $me = shift;
+ my $fd = shift;
+
+ $me->empty;
+
+ my $line = undef;
+ my $ln = "";
+ my $tag = undef;
+
+ while(1)
+  {
+   $ln = <$fd>;
+
+   if(defined $ln && defined $line && $ln =~ /\A[ \t]+/o)
+    {
+     $line .= $ln;
+     next;
+    }
+
+   if(defined $line)
+    {
+     ($tag,$line) = _fmt_line($me,$tag,$line);
+      _insert($me,$tag,$line,-1)
+	if defined $line;
+    }
+
+   last
+     unless(defined $ln && $ln =~ /\A($FIELD_NAME|From )/o);
+
+   $tag  = $1;
+   $line = $ln;
+  }
+
+ $me;
+}
+
+sub empty
+{
+ my $me = shift;
+
+ $me->{'mail_hdr_list'} = [];
+ $me->{'mail_hdr_hash'} = {};
+
+ $me;
+}
+
+sub header
+{
+ my $me = shift;
+
+ $me->extract(@_)
+	if(@_);
+
+ $me->fold
+    if $me->{'mail_hdr_modify'};
+
+ # Must protect ourself against corruption as the hash contains refs to the
+ # SV's in the list, if the user modifies this list we are really screwed :-
+
+ [ @{$me->{'mail_hdr_list'}} ];
+}
+
+# Return/set headers by hash reference.  This can probably be
+# optimized. I didn't want to mess much around with the internal
+# implementation as for now...
+# -- Tobias Brox <tobix@cpan.org>
+
+sub header_hashref {
+ my $me = shift;
+ my $hashref = shift;
+
+ # Extract the input data
+ for my $hdrkey (keys %$hashref) {
+   for (ref $hashref->{$hdrkey} 
+	? @{$hashref->{$hdrkey}} 
+	: $hashref->{$hdrkey}) {
+     $me->add($hdrkey, $_);
+   }
+ }
+
+ $me->fold
+    if $me->{'mail_hdr_modify'};
+
+ # Build a hash
+ my $hash={ map { $_ => [ $me->get($_) ] } keys %{$me->{'mail_hdr_hash'}} }; 
+
+ return $hash;
+}
+
+sub add
+{
+ my $me = shift;
+ my($tag,$text,$where) = @_;
+ my $line;
+ ($tag,$line) = _fmt_line($me,$tag,$text);
+
+ # Must have a tag and text to add
+ return undef
+	unless(defined $tag && defined $line);
+
+ $where = -1
+	unless defined $where;
+
+ _insert($me,$tag,$line,$where);
+
+ $line =~ /^\S+\s(.*)/os;
+ return $1;
+}
+
+sub replace
+{
+ my $me = shift;
+ my $idx = 0;
+ my($tag,$line);
+
+ $idx = pop @_
+    if(@_ % 2);
+
+TAG:
+ while(@_)
+  {
+   ($tag,$line) = _fmt_line($me,splice(@_,0,2));
+
+   return undef
+        unless(defined $tag && defined $line);
+
+   if(exists $me->{'mail_hdr_hash'}{$tag} &&
+      defined $me->{'mail_hdr_hash'}{$tag}[$idx])
+    {
+     ${$me->{'mail_hdr_hash'}{$tag}[$idx]} = $line;
+    }
+   else
+    {
+     _insert($me,$tag,$line,-1);
+    }
+  }
+
+ $line =~ /^\S+\s*(.*)/os;
+ return $1;
+}
+
+sub combine
+{
+ my $me  = shift;
+ my $tag = _tag_case(shift);
+ my $with = shift || ' ';
+ my $line;
+
+ return _error "unadorned 'From ' ignored"
+	if($tag =~ /^From /io && $me->{'mail_hdr_mail_from'} ne 'KEEP');
+
+ return undef
+    unless exists $me->{'mail_hdr_hash'}{$tag};
+
+ if(scalar(@{$me->{'mail_hdr_hash'}{$tag}}) > 1)
+  {
+   my @lines = $me->get($tag);
+
+   chomp(@lines);
+
+   map { $$_ = undef } @{$me->{'mail_hdr_hash'}{$tag}};
+
+   $line = ${$me->{'mail_hdr_hash'}{$tag}[0]} = 
+        (_fmt_line($me,$tag, join($with,@lines),1))[1];
+
+   _tidy_header($me);
+  }
+ else
+  {
+   return $me->{'mail_hdr_hash'}{$tag}[0];
+  }
+
+ return $line;		# post-match
+}
+
+sub get
+{
+ my $me = shift;
+ my $tag = _tag_case(shift);
+ my $idx = shift;
+
+ return wantarray ? () : undef
+    unless exists $me->{'mail_hdr_hash'}{$tag};
+
+ my $l = length($tag);
+ $l += 1 unless $tag =~ / \Z/o;
+
+ $idx = 0
+    unless defined $idx || wantarray;
+
+ if(defined $idx)
+  { 
+   return defined $me->{'mail_hdr_hash'}{$tag}[$idx]
+        ?  eval { # why won't do work here ??
+	       my $tmp = substr(${$me->{'mail_hdr_hash'}{$tag}[$idx]}, $l);
+	      $tmp =~ s/^\s+//;
+	      $tmp;
+	  }
+        : undef;
+  }
+
+ return  map {
+		my $tmp = substr($$_,$l);
+		$tmp =~ s/^\s+//;
+		$tmp
+	     } @{$me->{'mail_hdr_hash'}{$tag}};
+}
+
+sub count
+{
+ my $me = shift;
+ my $tag = _tag_case(shift);
+
+ exists $me->{'mail_hdr_hash'}{$tag}
+	? scalar(@{$me->{'mail_hdr_hash'}{$tag}})
+	: 0;
+}
+
+sub exists
+{
+ carp "Depriciated use of Mail::Header::exists, use count" if $^W;
+ count(@_);
+}
+
+sub delete
+{
+ my $me  = shift;
+ my $tag = _tag_case(shift);
+ my $idx = shift;
+ my @val = ();
+
+ if(defined $me->{'mail_hdr_hash'}{$tag})
+  {
+   my $l = length($tag);
+   $l += 2 unless $tag =~ / \Z/o;
+
+   if(defined $idx)
+    {
+     if(defined $me->{'mail_hdr_hash'}{$tag}[$idx])
+      {
+       push(@val, substr(${$me->{'mail_hdr_hash'}{$tag}[$idx]},$l));
+       undef ${$me->{'mail_hdr_hash'}{$tag}[$idx]};
+      }
+    }
+   else
+    {
+     local $_;
+     @val = map {
+                 my $x = substr($$_,$l);
+                 undef $$_;
+                 $x
+                } @{$me->{'mail_hdr_hash'}{$tag}};
+    }
+
+   _tidy_header($me);
+  }
+
+ return @val;
+}
+
+sub print
+{
+ my $me = shift;
+ my $fd = shift || \*STDOUT;
+ my $ln;
+
+ foreach $ln (@{$me->{'mail_hdr_list'}})
+  {
+   next
+    unless defined $ln;
+   print $fd $ln or
+    return 0;
+  }
+
+ 1;
+}
+
+sub as_string
+{
+ my $me = shift;
+
+ join('', grep { defined } @{$me->{'mail_hdr_list'}});
+}
+
+sub fold_length
+{
+ my $me  = shift;
+ my $old;
+
+ if(@_ == 2)
+  {
+   my($tag,$len) = @_;
+
+   my $hash = ref($me) ? $me->{'mail_hdr_lengths'} : \%HDR_LENGTHS;
+
+   $tag = _tag_case($tag);
+
+   $old = $hash->{$tag} || undef;
+   $hash->{$tag} = $len > 20 ? $len : 20;
+  }
+ else
+  {
+   my $len = shift;
+
+   $old = $me->{'mail_hdr_foldlen'};
+
+   if(defined $len)
+    {
+     $me->{'mail_hdr_foldlen'} = $len > 20 ? $len : 20;
+     $me->fold;
+    }
+  }
+
+ $old;
+}
+
+sub tags
+{
+ my $me = shift;
+
+ keys %{$me->{'mail_hdr_hash'}};
+}
+
+sub dup
+{
+ my $me = shift;
+ my $type = ref($me) || croak "Cannot dup without an object";
+ my $dup = new $type;
+
+ %$dup = %$me;
+ $dup->empty;
+
+ $dup->{'mail_hdr_list'} = [ @{$me->{'mail_hdr_list'}} ];
+
+ my $ln;
+ foreach $ln ( @{$dup->{'mail_hdr_list'}} )
+  {
+   my $tag = _tag_case(($ln =~ /\A($FIELD_NAME|From )/oi)[0]);
+
+   $dup->{'mail_hdr_hash'}{$tag} ||= [];
+   push(@{$dup->{'mail_hdr_hash'}{$tag}}, \$ln);
+  }
+
+ $dup;
+}
+
+sub cleanup
+{
+ my $me = shift;
+ my $d = 0;
+ my $key;
+
+ foreach $key (@_ ? @_ : keys %{$me->{'mail_hdr_hash'}})
+  {
+   my $arr = $me->{'mail_hdr_hash'}{$key};
+   my $ref;
+   foreach $ref (@$arr)
+    {
+     unless($$ref =~ /\A\S+\s+\S/soi)
+      {
+       $$ref = undef;
+       $d++;
+      }
+    }
+  }
+
+ _tidy_header($me)
+	if $d;
+
+ $me;  
+}
+
+1; # keep require happy
+
+
+=head1 NAME
+
+Mail::Header - manipulate mail RFC822 compliant headers
+
+=head1 SYNOPSIS
+
+    use Mail::Header;
+    
+    $head = new Mail::Header;
+    $head = new Mail::Header \*STDIN;
+    $head = new Mail::Header [<>], Modify => 0;
+
+=head1 DESCRIPTION
+
+This package provides a class object which can be used for reading, creating,
+manipulating and writing RFC822 compliant headers.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ ARG ], [ OPTIONS ] )
+
+C<ARG> may be either a file descriptor (reference to a GLOB)
+or a reference to an array. If given the new object will be
+initialized with headers either from the array of read from 
+the file descriptor.
+
+C<OPTIONS> is a list of options given in the form of key-value
+pairs, just like a hash table. Valid options are
+
+=over 8
+
+=item B<Modify>
+
+If this value is I<true> then the headers will be re-formatted,
+otherwise the format of the header lines will remain unchanged.
+
+=item B<MailFrom>
+
+This option specifies what to do when a header in the form `From '
+is encountered. Valid values are C<IGNORE> - ignore and discard the header,
+C<ERROR> - invoke an error (call die), C<COERCE> - rename them as Mail-From
+and C<KEEP> - keep them.
+
+=item B<FoldLength>
+
+The default length of line to be used when folding header lines
+
+=back
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item modify ( [ VALUE ] )
+
+If C<VALUE> is I<false> then C<Mail::Header> will not do any automatic
+reformatting of the headers, other than to ensure that the line
+starts with the tags given.
+
+=item mail_from ( OPTION )
+
+C<OPTION> specifies what to do when a C<`From '> line is encountered.
+Valid values are C<IGNORE> - ignore and discard the header,
+C<ERROR> - invoke an error (call die), C<COERCE> - rename them as Mail-From
+and C<KEEP> - keep them.
+
+=item fold ( [ LENGTH ] )
+
+Fold the header. If C<LENGTH> is not given then C<Mail::Header> uses the
+following rules to determine what length to fold a line.
+
+The fold length for the tag that is begin processed
+
+The default fold length for the tag that is being processed
+
+The default fold length for the object
+
+=item extract ( ARRAY_REF )
+
+Extract a header from the given array. C<extract> B<will modify> this array.
+Returns the object that the method was called on.
+
+=item read ( FD )
+
+Read a header from the given file descriptor.
+
+=item empty ()
+
+Empty the C<Mail::Header> object of all lines.
+
+=item header ( [ ARRAY_REF ] )
+
+C<header> does multiple operations. First it will extract a header from
+the array, if given. It will the reformat the header, if reformatting
+is permitted, and finally return a reference to an array which
+contains the header in a printable form.
+
+=item header_hashref ( [ HASH_REF ] )
+
+As C<header>, but it will eventually set headers from a hash
+reference, and it will return the headers as a hash reference.
+
+The values in the hash might either be a scalar or an array reference,
+as an example:
+
+    $hashref->{From}='Tobias Brox <tobix@cpan.org>';
+    $hashref->{To}=['you@somewhere', 'me@localhost'];
+
+=item add ( TAG, LINE [, INDEX ] )
+
+Add a new line to the header. If C<TAG> is I<undef> the the tag will be
+extracted from the beginning of the given line. If C<INDEX> is given
+the new line will be inserted into the header at the given point, otherwise
+the new line will be appended to the end of the header.
+
+=item replace ( TAG, LINE [, INDEX ] )
+
+Replace a line in the header.  If C<TAG> is I<undef> the the tag will be
+extracted from the beginning of the given line. If C<INDEX> is given
+the new line will replace the Nth instance of that tag, otherwise the
+first instance of the tag is replaced. If the tag does not appear in the
+header then a new line will be appended to the header.
+
+=item combine ( TAG [, WITH ] )
+
+Combine all instances of C<TAG> into one. The lines will be
+joined togther with C<WITH>, or a single space if not given. The new
+item will be positioned in the header where the first instance was, all
+other instances of <TAG> will be removed.
+
+=item get ( TAG [, INDEX ] )
+
+Get the text form a line. If C<INDEX> is given then the text of the Nth
+instance will be returned. If it is not given the return value depends on the
+context in which C<get> was called. In an array context a list of all the
+text from all the instances of C<TAG> will be returned. In a scalar context
+the text for the first instance will be returned.
+
+=item delete ( TAG [, INDEX ] )
+
+Delete a tag from the header. If C<INDEX> id given then the Nth instance
+of the tag will be removed. If C<INDEX> is not given all instances
+of tag will be removed.
+
+=item count ( TAG )
+
+Returns the number of times the given atg appears in the header
+
+=item print ( [ FD ] )
+
+Print the header to the given file descriptor, or C<STDOUT> if no
+file descriptor is given.
+
+=item as_string ()
+
+Returns the header as a single string.
+
+=item fold_length ( [ TAG ], [ LENGTH ] )
+
+Set the default fold length for all tags or just one. With no arguments
+the default fold length is returned. With two arguments it sets the fold
+length for the given tag and returns the previous value. If only C<LENGTH>
+is given it sets the default fold length for the current object.
+
+In the two argument form C<fold_length> may be called as a static method,
+setting default fold lengths for tags that will be used by B<all>
+C<Mail::Header> objects. See the C<fold> method for
+a description on how C<Mail::Header> uses these values.
+
+=item tags ()
+
+Retruns an array of all the tags that exist in the header. Each tag will
+only appear in the list once. The order of the tags is not specified.
+
+=item dup ()
+
+Create a duplicate of the current object.
+
+=item cleanup ()
+
+Remove any header line that, other than the tag, only contains whitespace
+
+=item unfold ( [ TAG ] )
+
+Unfold all instances of the given tag so that they do not spread across
+multiple lines. IF C<TAG> is not given then all lines are unfolded.
+
+=back
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-7 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
diff --git a/cpan/dist/MailTools/Mail/Internet.pm b/cpan/dist/MailTools/Mail/Internet.pm
new file mode 100644
index 00000000..57c0e962
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Internet.pm
@@ -0,0 +1,953 @@
+# Mail::Internet.pm
+#
+# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights
+# reserved. This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+#
+
+package Mail::Internet;
+use strict;
+
+require 5.002;
+
+use Carp;
+use AutoLoader;
+use Mail::Header;
+use vars qw($VERSION);
+
+BEGIN {
+    $VERSION = "1.33";
+    *AUTOLOAD = \&AutoLoader::AUTOLOAD;
+
+    unless(defined &UNIVERSAL::isa) {
+	*UNIVERSAL::isa = sub {
+	    my($obj,$type) = @_;
+	    my $pkg = ref($obj) || $obj;
+	    my @pkg = ($pkg);
+	    my %done;
+	    while(@pkg) {
+        	$pkg = shift @pkg;
+		return 1 if $pkg eq $type;
+        	next if exists $done{$pkg};
+        	$done{$pkg} = 1;
+
+		no strict 'refs';
+
+        	unshift @pkg,@{$pkg . "::ISA"}
+        	    if(@{$pkg . "::ISA"});
+	    }
+	    undef;
+	}
+    }
+}
+
+
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my $arg = @_ % 2 ? shift : undef;
+ my %arg = @_;
+
+ my $me = bless {}, $type;
+
+ $me->{'mail_inet_head'} = $arg{Header} if exists $arg{Header};
+ $me->{'mail_inet_body'} = $arg{Body} if exists $arg{Body};
+
+ $me->head->fold_length(delete $arg{FoldLength} || 79); # Default fold length
+ $me->head->mail_from($arg{MailFrom}) if exists $arg{MailFrom};
+ $me->head->modify(exists $arg{Modify} ? $arg{Modify} : 1);
+
+ if(defined $arg)
+  {
+   if(ref($arg) eq 'ARRAY')
+    {
+     $me->header($arg) unless exists $arg{Header};
+     $me->body($arg) unless exists $arg{Body};
+    }
+   elsif(defined fileno($arg))
+    {
+     $me->read_header($arg) unless exists $arg{Header};
+     $me->read_body($arg) unless exists $arg{Body};
+    }
+  }
+
+ return $me;
+}
+
+sub read
+{
+ my $me = shift;
+
+ $me->read_header(@_);
+ $me->read_body(@_);
+}
+
+sub read_body
+{
+ my($me,$fd) = @_;
+
+ $me->body( [ <$fd> ] );
+}
+
+
+sub extract
+{
+ my $me = shift;
+ my $arg = shift;
+
+ $me->head->extract($arg);
+ $me->body($arg);
+}
+
+
+sub body
+{
+ my $me = shift;
+ my $body = $me->{'mail_inet_body'} ||= [];
+
+ if(@_)
+  {
+   my $new = shift;
+   $me->{'mail_inet_body'} = ref($new) eq 'ARRAY' ? $new : [ $new ];
+  }
+
+ return $body;
+}
+
+sub header { shift->head->header(@_) }
+sub fold { shift->head->fold(@_) }
+sub fold_length { shift->head->fold_length(@_) }
+sub combine { shift->head->combine(@_) }
+sub print_header { shift->{'mail_inet_head'}->print(@_) }
+sub head { shift->{'mail_inet_head'} ||= new Mail::Header }
+
+sub read_header
+{
+ my $me = shift;
+ my $head = $me->head;
+ $head->read(@_);
+ $head->header();
+}
+
+sub clean_header
+{
+ carp "clean_header depreciated, use ->header" if $^W;
+ shift->header();
+}
+
+sub tidy_headers
+{
+ carp "tidy_headers no longer required" if $^W;
+}
+
+
+sub add
+{
+ my $me = shift;
+ my $head = $me->head;
+ my $ret;
+ while(@_)
+  {
+   my ($tag,$line) = splice(@_,0,2);
+
+   $ret = $head->add($tag,$line,-1) or
+	return undef;
+  }
+
+ $ret;
+}
+
+sub replace
+{
+ my $me = shift;
+ my $head = $me->head;
+ my $ret;
+
+ while(@_)
+  {
+   my ($tag,$line) = splice(@_,0,2);
+
+   $ret = $head->replace($tag,$line,0) or
+	return undef;
+  }
+
+ $ret;
+}
+
+sub get
+{
+ my $me = shift;
+ my $head = $me->head;
+ my @ret = ();
+ my $tag;
+
+ foreach $tag (@_)
+  {
+   last
+	if push(@ret, $head->get($tag)) && !wantarray;
+  }
+
+ wantarray ? @ret : shift @ret;
+}
+
+sub delete
+{
+ my $me = shift;
+ my $head = $me->head;
+ my @ret = ();
+ my $tag;
+
+ foreach $tag (@_)
+  {
+   push(@ret, $head->delete($tag));
+  }
+
+ @ret;
+}
+
+sub dup
+{
+ my $me = shift;
+ my $type = ref($me);
+ my $dup = $type->new;
+
+ $dup->{'mail_inet_body'} = [@{$me->body}]
+	if exists $me->{'mail_inet_body'};
+
+ $dup->{'mail_inet_head'} = $me->{'mail_inet_head'}->dup
+	if exists $me->{'mail_inet_head'};
+
+ $dup;
+}
+
+sub empty
+{
+ my $me = shift;
+
+ %{*$me} = ();
+
+ 1;
+}
+
+sub print_body
+{
+ my $me = shift;
+ my $fd = shift || \*STDOUT;
+ my $ln;
+
+ foreach $ln (@{$me->body})
+  {
+   print $fd $ln or
+	return 0;
+  }
+
+ 1;
+}
+
+sub print
+{
+ my $me = shift;
+ my $fd = shift || \*STDOUT;
+
+ $me->print_header($fd)
+    and print $fd "\n"
+    and $me->print_body($fd);
+}
+
+sub as_string
+{
+ my $me = shift;
+
+ $me->head->as_string . "\n" . join '', @{ $me->body };
+}
+
+sub as_mbox_string
+{
+ my $me = shift->dup;
+ my $escaped = shift;
+
+ $me->head->delete('Content-Length');
+ $me->escape_from unless $escaped;
+ $me->as_string . "\n";
+}
+
+sub remove_sig
+{
+ my $me = shift;
+ my $nlines = shift || 10;
+
+ my $body = $me->body;
+ my($line,$i);
+
+ $line = scalar(@{$body});
+ return unless($line);
+
+ while($i++ < $nlines && $line--)
+  {
+   if($body->[$line] =~ /\A--\040?[\r\n]+/)
+    {
+     splice(@{$body},$line,$i);
+     last;
+    }
+  }
+}
+
+sub tidy_body
+{
+ my $me = shift;
+
+ my $body = $me->body;
+ my $line;
+
+ if(scalar(@{$body}))
+  {
+   shift @$body
+        while(scalar(@{$body}) && $body->[0] =~ /\A\s*\Z/);
+   pop @$body
+        while(scalar(@{$body}) && $body->[-1] =~ /\A\s*\Z/);
+  }
+
+ return $body;
+}
+
+sub DESTROY {}
+
+# Auto loaded methods go after __END__
+__END__
+
+sub reply;
+
+
+use Mail::Address;
+
+ sub reply
+{
+ my $me = shift;
+ my %arg = @_;
+ my $pkg = ref $me;
+ my @reply = ();
+
+ local *MAILHDR;
+ if(open(MAILHDR,"$ENV{HOME}/.mailhdr")) 
+  {
+   # User has defined a mail header template
+   @reply = <MAILHDR>;
+   close(MAILHDR);
+  }
+
+ my $reply = $pkg->new(\@reply);
+
+ my($to,$cc,$name,$body,$id);
+
+ # The Subject line
+
+ my $subject = $me->get('Subject') || "";
+
+ $subject = "Re: " . $subject if($subject =~ /\S+/ && $subject !~ /Re:/i);
+
+ $reply->replace('Subject',$subject);
+
+ # Locate who we are sending to
+ $to = $me->get('Reply-To')
+       || $me->get('From')
+       || $me->get('Return-Path')
+       || "";
+
+ # Mail::Address->parse returns a list of refs to a 2 element array
+ my $sender = (Mail::Address->parse($to))[0];
+
+ $name = $sender->name;
+ $id = $sender->address;
+
+ unless(defined $name)
+  {
+   my $fr = $me->get('From');
+
+   $fr = (Mail::Address->parse($fr))[0] if(defined $fr);
+   $name = $fr->name if(defined $fr);
+  }
+
+ my $indent = $arg{Indent} || ">";
+
+ if($indent =~ /%/) 
+  {
+   my %hash = ( '%' => '%');
+   my @name = grep(do { length > 0 }, split(/[\n\s]+/,$name || ""));
+   my @tmp;
+
+   @name = "" unless(@name);
+
+   $hash{f} = $name[0];
+   $hash{F} = $#name ? substr($hash{f},0,1) : $hash{f};
+
+   $hash{l} = $#name ? $name[$#name] : "";
+   $hash{L} = substr($hash{l},0,1) || "";
+
+   $hash{n} = $name || "";
+   $hash{I} = join("",grep($_ = substr($_,0,1), @tmp = @name));
+
+   $indent =~ s/%(.)/defined $hash{$1} ? $hash{$1} : $1/eg;
+  }
+
+ $reply->replace('To', $id);
+
+ # Find addresses not to include
+ my %nocc = ();
+ my $mailaddresses = $ENV{MAILADDRESSES} || "";
+ my $addr;
+
+ $nocc{lc $id} = 1;
+
+ foreach $addr (Mail::Address->parse($reply->get('Bcc'),$mailaddresses)) 
+  {
+   my $lc = lc $addr->address;
+   $nocc{$lc} = 1;
+  }
+
+ if($arg{ReplyAll} || 0)
+  {
+   # Who shall we copy this to
+   my %cc = ();
+
+   foreach $addr (Mail::Address->parse($me->get('To'),$me->get('Cc'))) 
+    {
+     my $lc = lc $addr->address;
+     $cc{$lc} = $addr->format unless(defined $nocc{$lc});
+    }
+   $cc = join(', ',values %cc);
+
+   $reply->replace('Cc', $cc);
+  }
+
+ # References
+ my $refs = $me->get('References') || "";
+ my $mid = $me->get('Message-Id');
+
+ $refs .= " " . $mid if(defined $mid);
+ $reply->replace('References',$refs);
+
+ # In-Reply-To
+ my $date = $me->get('Date');
+ my $inreply = "";
+
+ if(defined $mid)
+  {
+   $inreply  = $mid;
+   $inreply .= " from " . $name if(defined $name);
+   $inreply .= " on " . $date if(defined $date);
+  }
+ elsif(defined $name)
+  {
+   $inreply = $name . "'s message";
+   $inreply .= "of " . $date if(defined $date);
+  }
+
+ $reply->replace('In-Reply-To', $inreply);
+
+ # Quote the body
+ $body  = $reply->body;
+
+ @$body = @{$me->body};		# copy body
+ $reply->remove_sig;		# remove signature, if any
+ $reply->tidy_body;		# tidy up
+ map { s/\A/$indent/ } @$body;	# indent
+
+ # Add references
+ unshift @{$body}, (defined $name ? $name . " " : "") . "<$id> writes:\n";
+
+ if(defined $arg{Keep} && 'ARRAY' eq ref($arg{Keep})) 
+  {
+   # Copy lines from the original
+   my $keep;
+
+   foreach $keep (@{$arg{Keep}}) 
+    {
+     my $ln = $me->get($keep);
+     $reply->replace($keep,$ln) if(defined $ln);
+    }
+  }
+
+ if(defined $arg{Exclude} && 'ARRAY' eq ref($arg{Exclude}))
+  {
+   # Exclude lines
+   $reply->delete(@{$arg{Exclude}});
+  }
+
+ # remove empty header lins
+ $reply->head->cleanup;
+
+ $reply;
+}
+
+sub add_signature
+{
+ my $me = shift;
+ carp "add_signature depriciated, use ->sign" if $^W;
+ $me->sign(File => shift || "$ENV{HOME}/.signature");
+}
+
+sub sign
+{
+ my $me = shift;
+ my %arg = @_;
+ my $sig;
+ my @sig;
+
+ if($sig = delete $arg{File})
+  {
+   local *SIG;
+
+   if(open(SIG,$sig))
+    {
+     local $_;
+     while(<SIG>) { last unless /\A(--)?\s*\Z/; }
+
+     @sig = ($_,<SIG>,"\n");
+
+     close(SIG);
+    }
+  }
+ elsif($sig = delete $arg{Signature})
+  {
+   @sig = ref($sig) ? @$sig : split(/\n/, $sig);
+  }
+
+ if(@sig)
+  {
+   $me->remove_sig;
+   map(s/\n?\Z/\n/,@sig);
+   push(@{$me->body}, "-- \n",@sig);
+  }
+}
+
+sub _prephdr {
+
+    use Mail::Util;
+
+    my $hdr = shift;
+
+    $hdr->delete('From '); # Just in case :-)
+
+    # An original message should not have any Received lines
+
+    $hdr->delete('Received');
+
+    $hdr->replace('X-Mailer', "Perl5 Mail::Internet v" . $Mail::Internet::VERSION);
+
+    my $name = eval { local $SIG{__DIE__}; (getpwuid($>))[6] } || $ENV{NAME} || "";
+
+    while($name =~ s/\([^\(\)]*\)//) { 1; }
+
+    if($name =~ /[^\w\s]/) {
+	$name =~ s/"/\"/g;
+	$name = '"' . $name . '"';
+    }
+
+    my $from = sprintf "%s <%s>", $name, Mail::Util::mailaddress();
+    $from =~ s/\s{2,}/ /g;
+
+    my $tag;
+
+    foreach $tag (qw(From Sender)) {
+	$hdr->add($tag,$from)
+	    unless($hdr->get($tag));
+    }
+}
+
+sub smtpsend;
+
+use Carp;
+use Mail::Util qw(mailaddress);
+use Mail::Address;
+use Net::Domain qw(hostname);
+use Net::SMTP;
+use strict;
+
+ sub smtpsend 
+{
+    my $src  = shift;
+    my %opt = @_;
+    my $host = $opt{Host};
+    my $noquit = 0;
+    my $smtp;
+    my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
+
+    push(@hello, 'Port', $opt{'Port'})
+	if exists $opt{'Port'};
+
+    push(@hello, 'Debug', $opt{'Debug'})
+	if exists $opt{'Debug'};
+
+    unless(defined($host)) {
+	local $SIG{__DIE__};
+	my @hosts = qw(mailhost localhost);
+	unshift(@hosts, split(/:/, $ENV{SMTPHOSTS})) if(defined $ENV{SMTPHOSTS});
+
+	foreach $host (@hosts) {
+	    $smtp = eval { Net::SMTP->new($host, @hello) };
+	    last if(defined $smtp);
+	}
+    }
+    elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
+	$smtp = $host;
+	$noquit = 1;
+    }
+    else {
+	local $SIG{__DIE__};
+	$smtp = eval { Net::SMTP->new($host, @hello) };
+    }
+
+    return ()
+	unless(defined $smtp);
+
+    my $hdr = $src->head->dup;
+
+    _prephdr($hdr);
+
+    # Who is it to
+
+    my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
+    @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
+	unless @rcpt;
+    my @addr = map($_->address, Mail::Address->parse(@rcpt));
+
+    return ()
+	unless(@addr);
+
+    $hdr->delete('Bcc'); # Remove blind Cc's
+
+    # Send it
+
+    my $ok = $smtp->mail( mailaddress() ) &&
+		$smtp->to(@addr) &&
+		$smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
+
+    $smtp->quit
+	unless $noquit;
+
+    $ok ? @addr : ();
+}
+
+sub send;
+
+use Mail::Mailer;
+use strict;
+
+ sub send 
+{
+    my ($src, $type, @args) = @_;
+
+    my $hdr = $src->head->dup;
+
+    _prephdr($hdr);
+
+    my $headers = $hdr->header_hashref;
+
+    # Actually send it
+    my $mailer = Mail::Mailer->new($type, @args);
+    $mailer->open($headers);
+    $src->print_body($mailer);
+    $mailer->close();
+}
+
+sub nntppost;
+
+use Mail::Util qw(mailaddress);
+use Net::NNTP;
+use strict;
+
+ sub nntppost
+{
+    my $mail = shift;
+    my %opt = @_;
+
+    my $groups = $mail->get('Newsgroups') || "";
+    my @groups = split(/[\s,]+/,$groups);
+
+    return ()
+	unless @groups;
+
+    my $hdr = $mail->head->dup;
+
+    _prephdr($hdr);
+
+    # Remove these incase the NNTP host decides to mail as well as me
+    $hdr->delete(qw(To Cc Bcc)); 
+
+    my $news;
+    my $noquit = 0;
+    my $host = $opt{Host};
+
+    if(ref($host) && UNIVERSAL::isa($host,'Net::NNTP')) {
+	$news = $host;
+	$noquit = 1;
+    }
+    else {
+	my @opt = ();
+
+	push(@opt, $opt{'Host'});
+
+	push(@opt, 'Port', $opt{'Port'})
+	    if exists $opt{'Port'};
+
+	push(@opt, 'Debug', $opt{'Debug'})
+	    if exists $opt{'Debug'};
+
+	$news = new Net::NNTP(@opt)
+	    or return ();
+    }
+
+    $news->post(@{$hdr->header},"\n",@{$mail->body});
+
+    my $code = $news->code;
+
+    $news->quit
+	unless $noquit;
+
+    return 240 == $code ? @groups : ();
+}
+
+sub escape_from
+{
+ my $me = shift;
+
+ my $body = $me->body;
+ local $_;
+
+ scalar grep { s/\A(>*From) />$1 /o } @$body;
+}
+
+sub unescape_from
+{
+ my $me = shift;
+
+ my $body = $me->body;
+ local $_;
+
+ scalar grep { s/\A>(>*From) /$1 /o } @$body;
+}
+
+1; # keep require happy
+
+
+
+=head1 NAME
+
+Mail::Internet - manipulate Internet format (RFC 822) mail messages
+
+=head1 SYNOPSIS
+
+    use Mail::Internet;
+
+=head1 DESCRIPTION
+
+This package provides a class object which can be used for reading, creating,
+manipulating and writing a message with RFC822 compliant headers.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item new ( [ ARG ], [ OPTIONS ] )
+
+C<ARG> is optiona and may be either a file descriptor (reference to a GLOB)
+or a reference to an array. If given the new object will be
+initialized with headers and body either from the array of read from 
+the file descriptor.
+
+C<OPTIONS> is a list of options given in the form of key-value
+pairs, just like a hash table. Valid options are
+
+=over 8
+
+=item B<Header>
+
+The value of this option should be a C<Mail::Header> object. If given then
+C<Mail::Internet> will not attempt to read a mail header from C<ARG>, if
+it was specified.
+
+=item B<Body>
+
+The value of this option should be a reference to an array which contains
+the lines for the body of the message. Each line should be terminated with
+C<\n> (LF). If Body is given then C<Mail::Internet> will not attempt to
+read the body from C<ARG> (even if it is specified).
+
+=back
+
+The Mail::Header options C<Modify>, C<MailFrom> and C<FoldLength> may
+also be given.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item body ()
+
+Returns the body of the message. This is a reference to an array.
+Each entry in the array represents a single line in the message.
+
+=item print_header ( [ FILEHANDLE ] )
+
+=item print_body ( [ FILEHANDLE ] )
+
+=item print ( [ FILEHANDLE ] )
+
+Print the header, body or whole message to file descriptor I<FILEHANDLE>.
+I<$fd> should be a reference to a GLOB. If I<FILEHANDLE> is not given the
+output will be sent to STDOUT.
+
+    $mail->print( \*STDOUT );  # Print message to STDOUT
+
+=item as_string ()
+
+Returns the message as a single string.
+
+=item as_mbox_string ( [ ALREADY_ESCAPED ] )
+
+Returns the message as a string in mbox format.  C<ALREADY_ESCAPED>, if
+given and true, indicates that ->escape_from has already been called on
+this object.
+
+=item head ()
+
+Returns the C<Mail::Header> object which holds the headers for the current
+message
+
+=back
+
+=head1 UTILITY METHODS
+
+The following methods are more a utility type than a manipulation
+type of method.
+
+=over 4
+
+=item remove_sig ( [ NLINES ] )
+
+Attempts to remove a users signature from the body of a message. It does this 
+by looking for a line equal to C<'-- '> within the last C<NLINES> of the
+message. If found then that line and all lines after it will be removed. If
+C<NLINES> is not given a default value of 10 will be used. This would be of
+most use in auto-reply scripts.
+
+=item tidy_body ()
+
+Removes all leading and trailing lines from the body that only contain
+white spaces.
+
+=item reply ()
+
+Create a new object with header initialised for a reply to the current 
+object. And the body will be a copy of the current message indented.
+
+=item add_signature ( [ FILE ] )
+
+Append a signature to the message. C<FILE> is a file which contains
+the signature, if not given then the file "$ENV{HOME}/.signature"
+will be checked for.
+
+=item send ( [ type [ args.. ]] )
+
+Send a Mail::Internet message using Mail::Mailer.  Type and args are
+passed on to C<Mail::Mailer>
+
+=item smtpsend ( [ OPTIONS ] )
+
+Send a Mail::Internet message via SMTP, requires Net::SMTP
+
+The return value will be a list of email addresses that the message was sent
+to. If the message was not sent the list will be empty.
+
+Options are passed as key-value pairs. Current options are
+
+=over 4
+
+=item Host
+
+Name of the SMTP server to connect to, or a Net::SMTP object to use
+
+If C<Host> is not given then the SMTP host is found by attempting
+connections first to hosts specified in C<$ENV{SMTPHOSTS}>, a colon
+separated list, then C<mailhost> and C<localhost>.
+
+=item To
+
+=item Cc
+
+=item Bcc
+
+Send the email to the given addresses, each can be either a string or
+a reference to a list of email addresses. If none of C<To>, <Cc> or C<Bcc>
+are given then the addresses are extracted from the message being sent.
+
+=item Hello
+
+Send a HELO (or EHLO) command to the server with the given name.
+
+=item Port
+
+Port number to connect to on remote host
+
+=item Debug
+
+Debug value to pass to Net::SMPT, see <Net::SMTP>
+
+=back
+
+=item nntppost ( [ OPTIONS ] )
+
+Post an article via NNTP, requires Net::NNTP.
+
+Options are passed as key-value pairs. Current options are
+
+=over 4
+
+=item Host
+
+Name of NNTP server to connect to, or a Net::NNTP object to use.
+
+=item Port
+
+Port number to connect to on remote host
+
+=item Debug
+
+Debug value to pass to Net::NNTP, see <Net::NNTP>
+
+=back
+
+=item escape_from ()
+
+It can cause problems with some applications if a message contains a line
+starting with C<`From '>, in particular when attempting to split a folder.
+This method inserts a leading C<`>'> on anyline that matches the regular
+expression C</^>*From/>
+
+=item unescape_from ()
+
+This method will remove the escaping added by escape_from
+
+=back
+
+=head1 SEE ALSO
+
+L<Mail::Header>
+L<Mail::Address>
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-7 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+
diff --git a/cpan/dist/MailTools/Mail/Mailer.pm b/cpan/dist/MailTools/Mail/Mailer.pm
new file mode 100644
index 00000000..ec21b26f
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Mailer.pm
@@ -0,0 +1,332 @@
+#
+
+package Mail::Mailer;
+
+=head1 NAME
+
+Mail::Mailer - Simple interface to electronic mailing mechanisms 
+
+=head1 SYNOPSIS
+
+    use Mail::Mailer;
+    use Mail::Mailer qw(mail);
+
+    $mailer = new Mail::Mailer;
+
+    $mailer = new Mail::Mailer $type, @args;
+
+    $mailer->open(\%headers);
+
+    print $mailer $body;
+
+    $mailer->close;
+
+
+=head1 DESCRIPTION
+
+Sends mail using any of the built-in methods.  You can alter the
+behaviour of a method by passing C<$command> to the C<new> method.
+
+=over 4
+
+=item C<mail>
+
+Use the Unix system C<mail> program to deliver the mail.  C<$command>
+is the path to C<mail>.  Mail::Mailer will search for C<mailx>, C<Mail>
+and C<mail> (in this order).
+
+=item C<sendmail>
+
+Use the C<sendmail> program to deliver the mail.  C<$command> is the
+path to C<sendmail>.
+
+=item C<smtp>
+
+Use the C<smtp> protocol via Net::SMTP to deliver the mail. The server
+to use can be specified in C<@args> with
+
+    $mailer = new Mail::Mailer 'smtp', Server => $server;
+
+=item C<test>
+
+Used for debugging, this calls C</bin/echo> to display the data.  No
+mail is ever sent.  C<$command> is ignored.
+
+=back
+
+C<Mail::Mailer> will search for executables in the above order. The
+default mailer will be the first one found.
+
+=head2 ARGUMENTS
+
+C<new> can optionally be given a C<$command> and C<$type>.  C<$type>
+is one C<sendmail>, C<mail>, ... given above.  The meaning of
+C<$command> depends on C<$type>.
+
+C<open> is given a reference to a hash.  The hash consists of key and
+value pairs, the key being the name of the header field (eg, C<To>),
+and the value being the corresponding contents of the header field.
+The value can either be a scalar (eg, C<gnat@frii.com>) or a reference
+to an array of scalars (C<eg, ['gnat@frii.com', 'Tim.Bunce@ig.co.uk']>).
+
+=head1 TO DO
+
+Assist formatting of fields in ...::rfc822:send_headers to ensure
+valid in the face of newlines and longlines etc.
+
+Secure all forms of send_headers() against hacker attack and invalid
+contents. Especially "\n~..." in ...::mail::send_headers.
+
+=head1 ENVIRONMENT VARIABLES
+
+=over 4
+
+=item PERL_MAILERS
+
+Augments/override the build in choice for binary used to send out
+our mail messages.
+
+Format:
+
+    "type1:mailbinary1;mailbinary2;...:type2:mailbinaryX;...:..."
+
+Example: assume you want you use private sendmail binary instead
+of mailx, one could set C<PERL_MAILERS> to:
+
+    "mail:/does/not/exists:sendmail:$HOME/test/bin/sendmail"
+
+=back
+
+=head1 SEE ALSO
+
+Mail::Send
+
+=head1 AUTHORS
+
+Maintained by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+
+Original code written by Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>,
+with a kick start from Graham Barr E<lt>F<gbarr@pobox.com>E<gt>. With
+contributions by Gerard Hickey E<lt>F<hickey@ctron.com>E<gt> Small fix
+and documentation by Nathan Torkington E<lt>F<gnat@frii.com>E<gt>.
+
+For support please contact comp.lang.perl.misc or Graham Barr
+E<lt>F<gbarr@pobox.com>E<gt>
+
+=cut
+
+use Carp;
+use IO::Handle;
+use vars qw(@ISA $VERSION $MailerBinary $MailerType %Mailers @Mailers);
+use Config;
+use strict;
+
+$VERSION = "1.21"; # $Id: //depot/MailTools/Mail/Mailer.pm#13 $
+
+sub Version { $VERSION }
+
+@ISA = qw(IO::Handle);
+
+# Suggested binaries for types?  Should this be handled in the object class?
+@Mailers = (
+
+    # Body on stdin with tilde escapes
+    'mail'	=> 	'mail',
+
+    # Headers-blank-Body all on stdin
+    'sendmail'  =>      '/usr/lib/sendmail;/usr/sbin/sendmail;/usr/ucblib/sendmail',
+
+    'smtp'	=> 	undef,
+    'test'	=> 	'test'
+);
+
+# There are several flavours of mail, which do we have ????
+
+{
+    my $cmd = is_exe('mailx;Mail;mail');
+    my $osname = $Config{'osname'};
+
+    if($osname =~ /(?:dgux)|(?:solaris)/io) {
+	$cmd .= " -~";
+    }
+    elsif($osname =~ /(?:linux)|(?:bsdos)|(?:freebsd)/io) {
+	$cmd .= " -I";
+    }
+    push @Mailers, 'mail', $cmd;
+}
+
+push(@Mailers, split(/:/,$ENV{PERL_MAILERS})) if $ENV{PERL_MAILERS};
+
+%Mailers = @Mailers;
+
+$MailerBinary = undef;
+
+# does this really need to be done? or should a default mailer be specfied?
+
+if($^O eq 'MacOS' || $^O eq 'VMS' || $^O eq 'MSWin32') {
+    $MailerType = 'smtp';
+    $MailerBinary = $Mailers{$MailerType};
+}
+else {
+    my $i;
+    for($i = 0 ; $i < @Mailers ; $i += 2) {
+	$MailerType = $Mailers[$i];
+	my $binary;
+	if($binary = is_exe($Mailers{$MailerType})) {
+	    $MailerBinary = $binary;
+	    last;
+	}
+    }
+}
+
+sub import {
+    shift;
+
+    if(@_) {
+	my $type = shift;
+	my $exe = shift || $Mailers{$type};
+
+        carp "Cannot locate '$exe'"
+            unless is_exe($exe);
+
+        $MailerType = $type;
+        $Mailers{$MailerType} = $exe;
+    }
+}
+
+sub to_array {
+    my($self, $thing) = @_;
+    if (ref($thing)) {
+	return @$thing;
+    } else {
+	return ($thing);
+    }
+}
+
+sub is_exe {
+    my $exe = shift;
+    my $cmd;
+
+    foreach $cmd (split /;/, $exe) {
+	$cmd =~ s/^\s+//;
+
+	# remove any options
+	my $name = ($cmd =~ /^(\S+)/)[0];
+
+	# check for absolute or relative path
+	return ($cmd)
+	    if (-x $name and ! -d $name and $name =~ m:/:);
+
+	if (defined $ENV{PATH}) {
+	    my $dir;
+	    foreach $dir (split(/:/, $ENV{PATH})) {
+		return "$dir/$cmd"
+		    if (-x "$dir/$name" && ! -d "$dir/$name");
+	    }
+	}
+    }
+    0;
+}
+
+sub new {
+    my($class, $type, @args) = @_;
+
+    $type = $MailerType unless $type;
+    croak "Mailer '$type' not known, please specify correct type"
+	unless $type;
+
+    my $exe = $Mailers{$type};
+
+    if(defined($exe)) {
+	$exe = is_exe ($exe) if defined $type;
+
+	$exe  = $MailerBinary  unless $exe;
+	croak "No mailer type specified (and no default available), thus can not find executable program."
+	    unless $exe;
+    }
+
+    $class = "Mail::Mailer::$type";
+    eval "require $class" or die $@;
+    my $glob = $class->SUPER::new; # local($glob) = gensym;	# Make glob for FileHandle and attributes
+
+    %{*$glob} = (Exe 	=> $exe,
+		 Args	=> [ @args ]
+		);
+    
+    $glob; # bless $glob, $class;
+}
+
+
+sub open {
+    my($self, $hdrs) = @_;
+    my $exe = *$self->{Exe}; # || Carp::croak "$self->open: bad exe";
+    my $args = *$self->{Args};
+    _cleanup_hdrs($hdrs);
+    my @to = $self->who_to($hdrs);
+    
+    $self->close;	# just in case;
+
+    # Fork and start a mailer
+    (defined($exe) && open($self,"|-"))
+	|| $self->exec($exe, $args, \@to)
+	|| die $!;
+
+    # Set the headers
+    $self->set_headers($hdrs);
+
+    # return self (a FileHandle) ready to accept the body
+    $self;
+}
+
+
+sub _cleanup_hdrs {
+  my $hdrs = shift;
+  my $h;
+  foreach $h (values %$hdrs) {
+    foreach (ref($h) ? @{$h} : $h) {
+      s/\n//;
+    }
+  }
+}
+
+
+sub exec {
+    my($self, $exe, $args, $to) = @_;
+    # Fork and exec the mailer (no shell involved to avoid risks)
+    my @exe = split(/\s+/,$exe);
+
+    exec(@exe, @$args, @$to);
+}
+
+sub can_cc { 1 }	# overridden in subclass for mailer that can't
+
+sub who_to {
+    my($self, $hdrs) = @_;
+    my @to = $self->to_array($hdrs->{To});
+    if (!$self->can_cc) {  # Can't cc/bcc so add them to @to
+	push(@to, $self->to_array($hdrs->{Cc})) if $hdrs->{Cc};
+	push(@to, $self->to_array($hdrs->{Bcc})) if $hdrs->{Bcc};
+    }
+    @to;
+}
+
+sub epilogue {
+    # This could send a .signature, also see ::smtp subclass
+}
+
+sub close {
+    my($self, @to) = @_;
+    if (fileno($self)) {
+	$self->epilogue;
+	close($self)
+    }
+}
+
+
+sub DESTROY {
+    my $self = shift;
+    $self->close;
+}
+
+1;
+
diff --git a/cpan/dist/MailTools/Mail/Mailer/mail.pm b/cpan/dist/MailTools/Mail/Mailer/mail.pm
new file mode 100644
index 00000000..0eb3595b
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Mailer/mail.pm
@@ -0,0 +1,27 @@
+package Mail::Mailer::mail;
+use vars qw(@ISA);
+@ISA = qw(Mail::Mailer);
+
+my %hdrs = qw(Cc ~c Bcc ~b Subject ~s);
+
+sub set_headers {
+    my $self = shift;
+    my $hdrs = shift;
+    my($k,$v);
+
+    while(($k,$v) = each %hdrs) {
+	print $self join(" ",$v, $self->to_array($hdrs->{$k})), "\n"
+		if defined $hdrs->{$k};
+    }
+}
+
+sub exec {
+    # These fail in FCGI under 5.6 due to 5.6 adding an OPEN to the
+    # tie interface and FCGI not having one.
+    eval {
+	open(STDOUT,">/dev/null"); # this is not portable !!!!
+	open(STDERR,">/dev/null"); # this is not portable !!!!
+    };
+    shift->SUPER::exec(@_);
+}
+1;
diff --git a/cpan/dist/MailTools/Mail/Mailer/rfc822.pm b/cpan/dist/MailTools/Mail/Mailer/rfc822.pm
new file mode 100644
index 00000000..dcb0dbca
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Mailer/rfc822.pm
@@ -0,0 +1,16 @@
+package Mail::Mailer::rfc822;
+use vars qw(@ISA);
+@ISA = qw(Mail::Mailer);
+
+sub set_headers {
+    my $self = shift;
+    my $hdrs = shift;
+    local($\)="";
+    foreach(keys %$hdrs) {
+	next unless m/^[A-Z]/;
+	print $self "$_: ", join(",", $self->to_array($hdrs->{$_})), "\n";
+    }
+    print $self "\n";	# terminate headers
+}
+
+1;
diff --git a/cpan/dist/MailTools/Mail/Mailer/sendmail.pm b/cpan/dist/MailTools/Mail/Mailer/sendmail.pm
new file mode 100644
index 00000000..ea67d7e0
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Mailer/sendmail.pm
@@ -0,0 +1,17 @@
+package Mail::Mailer::sendmail;
+use vars qw(@ISA);
+require Mail::Mailer::rfc822;
+@ISA = qw(Mail::Mailer::rfc822);
+
+
+sub exec {
+    my($self, $exe, $args, $to) = @_;
+    # Fork and exec the mailer (no shell involved to avoid risks)
+
+    # We should always use a -t on sendmail so that Cc: and Bcc: work
+    #  Rumor: some sendmails may ignore or break with -t (AIX?)
+    # Chopped out the @$to arguments, because -t means
+    # they are sent in the body, and postfix complains if they
+    # are also given on comand line.
+    exec( $exe, '-t', @$args );
+}
diff --git a/cpan/dist/MailTools/Mail/Mailer/smtp.pm b/cpan/dist/MailTools/Mail/Mailer/smtp.pm
new file mode 100644
index 00000000..6db78fa4
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Mailer/smtp.pm
@@ -0,0 +1,75 @@
+package Mail::Mailer::smtp;
+use vars qw(@ISA);
+use Net::SMTP;
+use Mail::Util qw(mailaddress);
+
+require Mail::Mailer::rfc822;
+@ISA = qw(Mail::Mailer::rfc822);
+
+sub can_cc { 0 }
+
+sub exec {
+    my($self, $exe, $args, $to) = @_;
+    my %opt = @$args;
+    my $host = $opt{'Server'} || undef;
+    # for Net::SMTP we do not really exec
+    my $smtp = Net::SMTP->new($host, Debug => 0)
+	or return undef;
+
+    ${*$self}{'sock'} = $smtp;
+
+    $smtp->mail(mailaddress());
+    my $u;
+    foreach $u (@$to) {
+	$smtp->to($u);
+    }
+    $smtp->data;
+    untie(*$self) if tied *$self;
+    tie *$self, 'Mail::Mailer::smtp::pipe',$self;
+    $self;
+}
+
+sub set_headers {
+    my($self,$hdrs) = @_;
+    $self->SUPER::set_headers({
+	From => "<" . mailaddress() . ">",
+	%$hdrs,
+	'X-Mailer' => "Mail::Mailer[v$Mail::Mailer::VERSION] Net::SMTP[v$Net::SMTP::VERSION]"
+    })
+}
+
+sub epilogue {
+    my $self = shift;
+    my $sock = ${*$self}{'sock'};
+    $sock->dataend;
+    $sock->quit;
+    delete ${*$self}{'sock'};
+    untie(*$self);
+}
+
+sub close {
+    my($self, @to) = @_;
+    my $sock = ${*$self}{'sock'};
+    if ($sock && fileno($sock)) {
+        $self->epilogue;
+	close($sock);
+    }
+}
+
+package Mail::Mailer::smtp::pipe;
+
+sub TIEHANDLE {
+    my $pkg = shift;
+    my $self = shift;
+    my $sock = ${*$self}{'sock'};
+    return bless \$sock;
+}
+
+sub PRINT {
+    my $self = shift;
+    my $sock = $$self;
+    $sock->datasend( @_ );
+}
+
+
+1;
diff --git a/cpan/dist/MailTools/Mail/Mailer/test.pm b/cpan/dist/MailTools/Mail/Mailer/test.pm
new file mode 100644
index 00000000..062a2b72
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Mailer/test.pm
@@ -0,0 +1,13 @@
+package Mail::Mailer::test;
+use vars qw(@ISA);
+require Mail::Mailer::rfc822;
+@ISA = qw(Mail::Mailer::rfc822);
+
+sub can_cc { 0 }
+
+sub exec {
+    my($self, $exe, $args, $to) = @_;
+    exec('sh', '-c', "echo to: " . join(" ",@{$to}) . "; cat");
+}
+
+1;
diff --git a/cpan/dist/MailTools/Mail/Send.pm b/cpan/dist/MailTools/Mail/Send.pm
new file mode 100644
index 00000000..a1d2231c
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Send.pm
@@ -0,0 +1,110 @@
+
+package Mail::Send;
+
+# $Id: //depot/MailTools/Mail/Send.pm#6 $
+
+use strict;
+use Carp;
+use vars qw($VERSION);
+require Mail::Mailer;
+
+$VERSION = "1.09";
+
+sub Version { $VERSION }
+
+sub new {
+    my $pkg = shift;
+    my %attr = @_;
+    my($key, $value);
+    my $me = bless {}, $pkg;
+    while( ($key, $value) = each %attr ) {
+	$key = lc($key);
+	$me->$key($value);
+    }
+    $me;
+}
+
+sub set {
+    my($me, $hdr, @values) = @_;
+    $me->{$hdr} = [ @values ] if @values;
+    @{$me->{$hdr} || []};	# return new (or original) values
+}
+
+sub add {
+    my($me, $hdr, @values) = @_;
+    $me->{$hdr} = [] unless $me->{$hdr};
+    push(@{$me->{$hdr}}, @values);
+}
+
+sub delete {
+    my($me, $hdr) = @_;
+    delete $me->{$hdr};
+}
+
+sub to		{ my $me=shift; $me->set('To', @_); }
+sub cc		{ my $me=shift; $me->set('Cc', @_); }
+sub bcc		{ my $me=shift; $me->set('Bcc', @_); }
+sub subject	{ my $me=shift; $me->set('Subject', join (' ', @_)); }
+
+
+sub open {
+    my $me = shift;
+    Mail::Mailer->new(@_)->open($me);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Mail::Send - Simple electronic mail interface
+
+=head1 SYNOPSIS
+
+    require Mail::Send;
+
+    $msg = new Mail::Send;
+
+    $msg = new Mail::Send Subject=>'example subject', To=>'timbo';
+
+    $msg->to('user@host');
+    $msg->subject('example subject');
+    $msg->cc('user@host');
+    $msg->bcc('someone@else');
+
+    $msg->set($header, @values);
+    $msg->add($header, @values);
+    $msg->delete($header);
+
+    # Launch mailer and set headers. The filehandle returned
+    # by open() is an instance of the Mail::Mailer class.
+
+    $fh = $msg->open;
+
+    print $fh "Body of message";
+
+    $fh->close;         # complete the message and send it
+
+    $fh->cancel;        # not yet implemented
+
+=head1 DESCRIPTION
+
+=head1 SEE ALSO
+
+Mail::Mailer
+
+=head1 AUTHORS
+
+Maintained by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+
+Original code written by Tim Bunce E<lt>F<Tim.Bunce@ig.co.uk>E<gt>,
+with a kick start from Graham Barr E<lt>F<gbarr@pobox.com>E<gt>. With
+contributions by Gerard Hickey E<lt>F<hickey@ctron.com>E<gt>
+
+For support please contact comp.lang.perl.misc or Graham Barr
+E<lt>F<gbarr@pobox.com>E<gt>
+
+=cut
+
+
diff --git a/cpan/dist/MailTools/Mail/Util.pm b/cpan/dist/MailTools/Mail/Util.pm
new file mode 100644
index 00000000..e0c2a344
--- /dev/null
+++ b/cpan/dist/MailTools/Mail/Util.pm
@@ -0,0 +1,240 @@
+# Mail::Util.pm
+#
+# Copyright (c) 1995-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Mail::Util;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT_OK);
+use AutoLoader ();
+use Exporter ();
+
+BEGIN {
+    require 5.000;
+
+    $VERSION = "1.16";
+
+    *AUTOLOAD = \&AutoLoader::AUTOLOAD;
+    @ISA = qw(Exporter);
+
+    @EXPORT_OK = qw(read_mbox maildomain mailaddress);
+}
+
+1;
+
+sub Version { $VERSION }
+
+=head1 NAME
+
+Mail::Util - mail utility functions
+
+=head1 SYNOPSIS
+
+use Mail::Util qw( ... );
+
+=head1 DESCRIPTION
+
+This package provides several mail related utility functions. Any function
+required must by explicitly listed on the use line to be exported into
+the calling package.
+
+=head2 read_mbox( $file )
+
+Read C<$file>, a binmail mailbox file, and return a list of  references.
+Each reference is a reference to an array containg one message.
+
+=head2 maildomain()
+
+Attempt to determine the current uers mail domain string via the following
+methods
+
+ Look for a sendmail.cf file and extract DH parameter
+ Look for a smail config file and usr the first host defined in hostname(s)
+ Try an SMTP connect (if Net::SMTP exists) first to mailhost then localhost
+ Use value from Net::Domain::domainname (if Net::Domain exists)
+
+=head2 mailaddress()
+
+Return a guess at the current users mail address. The user can force
+the return value by setting C<$ENV{MAILADDRESS}>
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-8 Graham Barr. All rights reserved. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+
+__END__
+
+sub read_mbox {
+    my $file  = shift;
+    my @mail  = ();
+    my $mail  = [];
+    my $blank = 1;
+    local *FH;
+    local $_;
+
+    open(FH,"< $file") or
+	do {
+	    require Carp;
+	    Carp::croak("cannot open '$file': $!\n");
+	};
+
+    while(<FH>) {
+	if($blank && /\AFrom .*\d{4}/) {
+	    push(@mail, $mail) if scalar(@{$mail});
+	    $mail = [ $_ ];
+	    $blank = 0;
+	}
+	else {
+	    $blank = m#\A\Z#o ? 1 : 0;
+	    push(@{$mail}, $_);
+	}
+    }
+
+    push(@mail, $mail) if scalar(@{$mail});
+
+    close(FH);
+
+    return wantarray ? @mail : \@mail;
+}
+
+
+sub maildomain {
+
+    ##
+    ## return imediately if already found
+    ##
+
+    return $domain
+	if(defined $domain);
+
+    ##
+    ## Try sendmail config file if exists
+    ##
+
+    local *CF;
+    local $_;
+    my @sendmailcf = qw(/etc
+			/etc/sendmail
+			/etc/ucblib
+			/etc/mail
+			/usr/lib
+			/var/adm/sendmail);
+
+    my $config = (grep(-r, map("$_/sendmail.cf", @sendmailcf)))[0];
+
+    if(defined $config && open(CF,$config)) {
+	my %var;
+	while(<CF>) {
+	    if(/\AD([a-zA-Z])([\w.]+)/) {
+		my($v,$arg) = ($1,$2);
+		$arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$' . $1/eg;
+		$var{$v} = $arg;
+	    }
+	}
+	close(CF);
+	$domain = $var{'j'} if defined $var{'j'};
+	$domain = $var{'M'} if defined $var{'M'};
+	return $domain
+	    if(defined $domain);
+    }
+
+    ##
+    ## Try smail config file if exists
+    ##
+
+    if(open(CF,"/usr/lib/smail/config")) {
+	while(<CF>) {
+	    if(/\A\s*hostnames?\s*=\s*(\S+)/) {
+		$domain = (split(/:/,$1))[0];
+		last;
+	    }
+	}
+	close(CF);
+
+	return $domain
+	    if(defined $domain);
+    }
+
+    ##
+    ## Try a SMTP connection to 'mailhost'
+    ##
+
+    if(eval { require Net::SMTP }) {
+	my $host;
+
+	foreach $host (qw(mailhost localhost)) {
+	    my $smtp = eval { Net::SMTP->new($host) };
+
+	    if(defined $smtp) {
+		$domain = $smtp->domain;
+		$smtp->quit;
+		last;
+	    }
+	}
+    }
+
+    ##
+    ## Use internet(DNS) domain name, if it can be found
+    ##
+
+    unless(defined $domain) {
+	if(eval { require Net::Domain } ) {
+	    $domain = Net::Domain::domainname();
+	}
+    }
+
+    $domain = "localhost"
+	unless(defined $domain);
+
+    return $domain;
+}
+
+
+sub mailaddress {
+
+    ##
+    ## Return imediately if already found
+    ##
+
+    return $mailaddress
+	if(defined $mailaddress);
+
+    ##
+    ## Get user name from environment
+    ##
+
+    $mailaddress = $ENV{MAILADDRESS};
+
+    unless ($mailaddress || $^O ne 'MacOS') {
+	require Mac::InternetConfig;
+	Mac::InternetConfig->import();
+
+	$mailaddress = $InternetConfig{kICEmail()};
+    }
+
+    $mailaddress ||= $ENV{USER} ||
+                     $ENV{LOGNAME} ||
+                     eval { (getpwuid($>))[6] } ||
+                     "postmaster";
+
+    ##
+    ## Add domain if it does not exist
+    ##
+
+    $mailaddress .= '@' . maildomain()
+	unless($mailaddress =~ /\@/);
+
+    $mailaddress =~ s/(^.*<|>.*$)//g;
+
+    $mailaddress;
+}