parsing - Perl to parse email, change "From:" header, send onwards -

i wish lying, i've spent several months trying work , have admit defeat on perl scripting skills. i'm @ loss make work , need (for wil grateful).

the background: running discussion email list using third party listserv. want change "from" header on incoming emails address @ domain, doing database lookup email address, , adding users name , company code header, , sending on.

for example, super dave , changed david smith (abc - lon) , , list members see header instead of whatever has chosen "from free text".

the script have developed works ... except more complex emails seem stun it. right script takes text version of email, strips out mime parts , html bits, , changes header. if encounters email format thats new (and havent written code line handle), stops. continue fixing each type of email coming in, think thats overkill - need kiss method.

note: database lookup without issue. problem in way email body arrives @ listserver.

instead of this, want leave original email untouched, change header. nothing else. there way that? here (the salient part of) script.

what im after simpler method search email header, change value, , send on.

thoughts?

$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 |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 mail , save output dbody.txt. still have header+body @ stage. $body=decode_qp($encoded); open ff, ">dbody.txt" or die $!; print ff $body; close ff; #if body still has headers, first blank line, , delete before - body $bodycheck =`cat dbody.txt`; if ($bodycheck =~ /message-id/ ){ $bodyfinal= `sed '0,/^\$/d' dbody.txt`; } else { $bodyfinal =$bodycheck }  #save output bodyfinal.txt open ff, ">bodyfinal.txt" or die $!; print ff $bodyfinal; close ff;  #this section contains code query database original email address #get username , domain , change lower case 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 user 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 mail   sub sendemail  {         ($to, $from_sub, $subject, $message) = @_;         $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",            => "$result[0] ($result[1]/$codes[0]-$result[2])<listmail@>",              => '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(); } 

to answer "what simple method search file from: header, change value, , send on?": use tie::file;

given file named 'email' contains example headers this page,

#! /usr/bin/env perl use common::sense; use tie::file;  tie @f, 'tie::file', 'email' or die $!;  (@f) {   if (/^from:/) {     "old: $_";     s/(?<=^from:).*$/ new sender <anewsender\@ans.com>/;     "new: $_";     last   } }  untie @f; 

output:

$ perl tie-ex  old: from: taylor evans <example_from@dc.edu> new: from: new sender <anewsender@ans.com>  $ grep ^from email from: new sender <anewsender@ans.com> 

mind, there's kinds of wrong this. headers don't need neatly on 1 line; there can more 1 from: header (by else's scripting error, instance); there can no from: header in headers , from: randomly in body. spammers strange things. if original code contains these limitations , you're happy enough them, try this.

meanwhile, there great perl modules handle mail. take through email:: modules listed here.