home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / reply.al < prev    next >
Encoding:
Text File  |  2004-03-29  |  3.7 KB  |  173 lines
  1. # NOTE: Derived from blib\lib\Mail/Internet.pm.
  2. # Changes made here will be lost when autosplit is run again.
  3. # See AutoSplit.pm.
  4. package Mail::Internet;
  5.  
  6. #line 320 "blib\lib\Mail/Internet.pm (autosplit into blib\lib\auto\Mail\Internet\reply.al)"
  7. sub reply;
  8.  
  9.  
  10. use Mail::Address;
  11.  
  12.  sub reply
  13. {
  14.  my $me = shift;
  15.  my %arg = @_;
  16.  my $pkg = ref $me;
  17.  my @reply = ();
  18.  
  19.  local *MAILHDR;
  20.  if(open(MAILHDR,"$ENV{HOME}/.mailhdr")) 
  21.   {
  22.    # User has defined a mail header template
  23.    @reply = <MAILHDR>;
  24.    close(MAILHDR);
  25.   }
  26.  
  27.  my $reply = $pkg->new(\@reply);
  28.  
  29.  my($to,$cc,$name,$body,$id);
  30.  
  31.  # The Subject line
  32.  
  33.  my $subject = $me->get('Subject') || "";
  34.  
  35.  $subject = "Re: " . $subject if($subject =~ /\S+/ && $subject !~ /Re:/i);
  36.  
  37.  $reply->replace('Subject',$subject);
  38.  
  39.  # Locate who we are sending to
  40.  $to = $me->get('Reply-To')
  41.        || $me->get('From')
  42.        || $me->get('Return-Path')
  43.        || "";
  44.  
  45.  # Mail::Address->parse returns a list of refs to a 2 element array
  46.  my $sender = (Mail::Address->parse($to))[0];
  47.  
  48.  $name = $sender->name;
  49.  $id = $sender->address;
  50.  
  51.  unless(defined $name)
  52.   {
  53.    my $fr = $me->get('From');
  54.  
  55.    $fr = (Mail::Address->parse($fr))[0] if(defined $fr);
  56.    $name = $fr->name if(defined $fr);
  57.   }
  58.  
  59.  my $indent = $arg{Indent} || ">";
  60.  
  61.  if($indent =~ /%/) 
  62.   {
  63.    my %hash = ( '%' => '%');
  64.    my @name = grep(do { length > 0 }, split(/[\n\s]+/,$name || ""));
  65.    my @tmp;
  66.  
  67.    @name = "" unless(@name);
  68.  
  69.    $hash{f} = $name[0];
  70.    $hash{F} = $#name ? substr($hash{f},0,1) : $hash{f};
  71.  
  72.    $hash{l} = $#name ? $name[$#name] : "";
  73.    $hash{L} = substr($hash{l},0,1) || "";
  74.  
  75.    $hash{n} = $name || "";
  76.    $hash{I} = join("",grep($_ = substr($_,0,1), @tmp = @name));
  77.  
  78.    $indent =~ s/%(.)/defined $hash{$1} ? $hash{$1} : $1/eg;
  79.   }
  80.  
  81.  $reply->replace('To', $id);
  82.  
  83.  # Find addresses not to include
  84.  my %nocc = ();
  85.  my $mailaddresses = $ENV{MAILADDRESSES} || "";
  86.  my $addr;
  87.  
  88.  $nocc{lc $id} = 1;
  89.  
  90.  foreach $addr (Mail::Address->parse($reply->get('Bcc'),$mailaddresses)) 
  91.   {
  92.    my $lc = lc $addr->address;
  93.    $nocc{$lc} = 1;
  94.   }
  95.  
  96.  if($arg{ReplyAll} || 0)
  97.   {
  98.    # Who shall we copy this to
  99.    my %cc = ();
  100.  
  101.    foreach $addr (Mail::Address->parse($me->get('To'),$me->get('Cc'))) 
  102.     {
  103.      my $lc = lc $addr->address;
  104.      $cc{$lc} = $addr->format unless(defined $nocc{$lc});
  105.     }
  106.    $cc = join(', ',values %cc);
  107.  
  108.    $reply->replace('Cc', $cc);
  109.   }
  110.  
  111.  # References
  112.  my $refs = $me->get('References') || "";
  113.  my $mid = $me->get('Message-Id');
  114.  
  115.  $refs .= " " . $mid if(defined $mid);
  116.  $reply->replace('References',$refs);
  117.  
  118.  # In-Reply-To
  119.  my $date = $me->get('Date');
  120.  my $inreply = "";
  121.  
  122.  if(defined $mid)
  123.   {
  124.    $inreply  = $mid;
  125.    $inreply .= " from " . $name if(defined $name);
  126.    $inreply .= " on " . $date if(defined $date);
  127.   }
  128.  elsif(defined $name)
  129.   {
  130.    $inreply = $name . "'s message";
  131.    $inreply .= "of " . $date if(defined $date);
  132.   }
  133.  
  134.  $reply->replace('In-Reply-To', $inreply);
  135.  
  136.  # Quote the body
  137.  $body  = $reply->body;
  138.  
  139.  @$body = @{$me->body};        # copy body
  140.  $reply->remove_sig;        # remove signature, if any
  141.  $reply->tidy_body;        # tidy up
  142.  map { s/\A/$indent/ } @$body;    # indent
  143.  
  144.  # Add references
  145.  unshift @{$body}, (defined $name ? $name . " " : "") . "<$id> writes:\n";
  146.  
  147.  if(defined $arg{Keep} && 'ARRAY' eq ref($arg{Keep})) 
  148.   {
  149.    # Copy lines from the original
  150.    my $keep;
  151.  
  152.    foreach $keep (@{$arg{Keep}}) 
  153.     {
  154.      my $ln = $me->get($keep);
  155.      $reply->replace($keep,$ln) if(defined $ln);
  156.     }
  157.   }
  158.  
  159.  if(defined $arg{Exclude} && 'ARRAY' eq ref($arg{Exclude}))
  160.   {
  161.    # Exclude lines
  162.    $reply->delete(@{$arg{Exclude}});
  163.   }
  164.  
  165.  # remove empty header lins
  166.  $reply->head->cleanup;
  167.  
  168.  $reply;
  169. }
  170.  
  171. # end of Mail::Internet::reply
  172. 1;
  173.