Perl解析電子郵件，更改「From：」標題，向前發送

Question

我希望自己在說謊，但我花了好幾個月的時間試圖讓這個工作，我必須承認我的perl腳本技能失敗。我無法完成這項工作，需要幫​​助（我將非常感激）。

背景： 我正在使用第三方Listserv運行討論郵件列表。我想通過對電子郵件地址進行數據庫查找，然後將用戶名和公司代碼添加到「發件人」標題並將其發送，從而將傳入電子郵件的「發件人」標題更改爲我的域中的地址。

例如，Super Dave被更改爲David Smith（ABC - LON），然後列表成員將看到該標題，而不是他選擇的「From free text」。

我開發的腳本工作得很好......除了更復雜的電子郵件似乎讓它暈眩。現在腳本獲取電子郵件的文本版本，去除所有MIME部分和html位，並更改標題。如果它遇到一個新的電子郵件格式（並且我沒有編寫代碼行來處理），它會停止。我可以繼續修復每種類型的電子郵件，但我認爲這太過於誇張 - 我需要回到KISS方法。

注意：數據庫查找沒有問題。問題在於電子郵件正文終於到達列表服務器。

取而代之，我想保留原始電子郵件不變，但只需更改From標題。沒有其他的。有沒有辦法做到這一點？這是腳本的（顯着部分）。

什麼在後是一個更簡單的方法來搜索電子郵件的標題，將其更改爲另一個值，然後發送它。

想法？ 「什麼？是一種簡單的方法來搜索一些文件的From：頭， 將其更改爲另一個值，並把它的」：

$connect = DBI->connect($dsn, $user, $pw); 
open FH, ">mail.txt" or die "can't open mail.txt: $!"; 
while ($_ = <STDIN>) { 
print FH "$_"; 
} 
close(FH); 
$file_content = `cat 'mail.txt' | grep -m1 From |tail -n+1`; 
chomp($file_content); 
$from = `echo "$file_content"| sed -e "s/.*<//;s/>.*//"`; 
chomp($from); 
$subject=`cat mail.txt |grep -m1 Subject| sed -e "s/.*Subject: //"`; 
chomp($subject); 
system('./body.sh'); 
$encoded=`cat body.txt`; 

#Decode the mail and save output to dbody.txt. Still have header+body at this stage. 
$body=decode_qp($encoded); 
open FF, ">dbody.txt" or die $!; 
print FF $body; 
close FF; 
#If body still has headers, Look for first blank line, and delete all before - this is the body 
$bodycheck =`cat dbody.txt`; 
if ($bodycheck =~ /Message-Id/){ 
$bodyfinal= `sed '0,/^\$/d' dbody.txt`; 
} else { 
$bodyfinal =$bodycheck 
} 

#Save the output to bodyfinal.txt 
open FF, ">bodyfinal.txt" or die $!; 
print FF $bodyfinal; 
close FF; 

#THIS SECTION contains code to query the database with the original FROM email address 
#get username and domain and then change to lower case for the query 
$case_username = substr($from, 0, index($from, '@')); 
$m_username = lc($case_username); 
$case_domain = substr($from, index($from, '@')+1); 
$m_domain = lc($case_domain); 
#print "\n##############$m_username\@$m_domain#################\n"; 
$query = "select user_real_name, company_code, location_code from user where user_email='$m_username\@$m_domain'"; 
$query_handle = $connect->prepare($query); 
$query_handle->execute() or die $DBI::errstr; 
@result=$query_handle->fetchrow_array(); 
print "\n@result\n"; 
##Forward the mail 


sub sendEmail 
{ 
     my ($to, $from_sub, $subject, $message) = @_; 
     my $sendmail = '/usr/sbin/sendmail'; 
     open(MAIL, "|$sendmail -oi -t"); 
       print MAIL "From: $from_sub\n"; 
       print MAIL "To: $to\n"; 
       print MAIL "Subject: $subject\n\n"; 
       print MAIL "$message\n"; 
     close(MAIL); 
} 

{my $msg = MIME::Lite->new 
(
     Subject => "$subject", 
     From => "$result[0] ($result[1]/$codes[0]-$result[2])<listmail@>", 
     To  => 'opg@maillist.com', 
     Type => 'text/plain', 
     Encoding => '7bit', 
     Data => "From: $result[0]/$result[1]-$codes[0]/$result[2] \n________________________________________________ \n \n$bodyfinal \n" 
); 
$msg->send(); 
} 

Answer 1

要答案只有使用Tie::File;

給定一個名爲包含從this page的例子頭 '電子郵件' 文件，

#! /usr/bin/env perl 
use common::sense; 
use Tie::File; 

tie my @f, 'Tie::File', 'email' or die $!; 

for (@f) { 
    if (/^From:/) { 
    say "old: $_"; 
    s/(?<=^From:).*$/ A New Sender <anewsender\@ans.com>/; 
    say "new: $_"; 
    last 
    } 
} 

untie @f; 

輸出：

$ perl tie-ex 
old: From: Taylor Evans <example_from@dc.edu> 
new: From: A New Sender <anewsender@ans.com> 

$ grep ^From email 
From: A New Sender <anewsender@ans.com> 

心靈，還有各種錯。頭部不需要整齊排列在一條線上;可以有多個From：標題（例如，通過別人的腳本錯誤）;甚至可以在標題中沒有From：標題，然後在體內隨機選擇From：。垃圾郵件發送者做奇怪的事情。但是，如果您的原始代碼已經包含這些限制，並且您對它們滿意，那就試試這個。

同時，已經有很好的處理郵件的Perl模塊。看看電子郵件::模塊listed here。