288 lines
9.3 KiB
Perl
288 lines
9.3 KiB
Perl
|
|
sub getmail_fetch {
|
||
|
|
|
||
|
|
# $mail_psw = 'znMpCa6pikZF' ;
|
||
|
|
# $mail_host = 'pop.yandex.com' ;
|
||
|
|
# $mail_user = 'itv.k@re8it.com' ;
|
||
|
|
|
||
|
|
# $mail_psw = 'vf1VBE6AGuPE' ;
|
||
|
|
$mail_psw = $send_mail_psw ;
|
||
|
|
# $mail_host = 'envoy.aserv.co.za' ;
|
||
|
|
$mail_host = 'pop3.interactivetvafrica.com' ;
|
||
|
|
$mail_user = 'tickets@interactivetvafrica.com' ;
|
||
|
|
|
||
|
|
# $mail_psw = "Jat20161" ;
|
||
|
|
# $mail_host = "outlook.office365.com" ;
|
||
|
|
# $mail_user = "tickets\@aisport.africa" ;
|
||
|
|
|
||
|
|
use IO::Socket::SSL;
|
||
|
|
|
||
|
|
$socket = IO::Socket::SSL->new( PeerAddr => $mail_host,
|
||
|
|
PeerPort => 995,
|
||
|
|
SSL_verify_mode => SSL_VERIFY_NONE,
|
||
|
|
Proto => 'tcp') || die "No socket!";
|
||
|
|
|
||
|
|
$pop = new Mail::POP3Client( USER => $mail_user, PASSWORD => $mail_psw, HOST => $mail_host, USESSL => true, SOCKET => $socket ) || die $pop->Message();
|
||
|
|
# $pop = new Mail::POP3Client( USER => $mail_user, PASSWORD => $mail_psw, HOST => $mail_host, PORT => 995, AUTH_MODE => 'PASS', USESSL => true, SOCKET => $socket ) || die $pop->Message();
|
||
|
|
|
||
|
|
# # OR with SSL
|
||
|
|
# $pop = new Mail::POP3Client( USER => $mail_user,
|
||
|
|
# PASSWORD => $mail_psw,
|
||
|
|
# HOST => $mail_host,
|
||
|
|
# USESSL => true,
|
||
|
|
# ) || die $pop->Message();
|
||
|
|
|
||
|
|
#connect to POP3 sever
|
||
|
|
# my $pop = new Mail::POP3Client( HOST => $mail_host );
|
||
|
|
# $pop->User($mail_user);
|
||
|
|
# $pop->Pass($mail_psw);
|
||
|
|
# $pop->Connect() || die "Unable to connect to POP3 server: ".$pop->Message()."\n";
|
||
|
|
|
||
|
|
if ($debug) {
|
||
|
|
use Data::Dumper;
|
||
|
|
print Dumper(\$pop);
|
||
|
|
&common_debug ("get_mail : office_user = $mail_user") ;
|
||
|
|
}
|
||
|
|
|
||
|
|
$nummsgs = $pop->Count;
|
||
|
|
|
||
|
|
&common_debug ("get_mail : nummsgs [$nummsgs]") ;
|
||
|
|
|
||
|
|
for ($i = 1; $i <= $pop->Count(); $i++) {
|
||
|
|
|
||
|
|
# # sometimes the 'To' is like this : 'graham evens <12345+gevens-bookings@eccotours.co.za>'
|
||
|
|
# # sometimes the 'To' is like this : '12345+gevens-bookings@eccotours.co.za'
|
||
|
|
# # so we split it by '<' to just get the bit we want
|
||
|
|
# my @to_array = split (/\</, $mailcontent{'To'}) ;
|
||
|
|
|
||
|
|
$head = $pop->Head( $i ) ;
|
||
|
|
$head = &getmail_clean($head) ;
|
||
|
|
|
||
|
|
&common_debug ("get_mail : head [$head]") ;
|
||
|
|
|
||
|
|
%mailcontent = () ;
|
||
|
|
|
||
|
|
my $subject_auto_conf = '' ;
|
||
|
|
my $subject_auto_decline = '' ;
|
||
|
|
|
||
|
|
# if ($head =~ /[\d]+\++[\w]+-bookings@[\w\.\-]+\w+/) { # 18398+autoreq-bookings@ecco.co.za
|
||
|
|
# $to = $& ;
|
||
|
|
# }
|
||
|
|
# elsif ($head =~ /AUTO+\s+CONFIRMATION+\s:\s+[\d]+\s:\s+[\w]+-+[\w]+\s+\(+[\w]+\)/) { # If subject = AUTO CONFIRMATION : 123456 : hotelcode-room (789123)
|
||
|
|
# $subject_auto_conf = $& ;
|
||
|
|
# }
|
||
|
|
# else
|
||
|
|
# {
|
||
|
|
foreach ( $pop->Head( $i ) ) {
|
||
|
|
chomp;
|
||
|
|
/^(From|Subject|To|Cc):\s+/i;
|
||
|
|
my ($index,$value) = split(/:/);
|
||
|
|
$mailcontent{$index} = $value;
|
||
|
|
}
|
||
|
|
|
||
|
|
my @to_array = split (/\</, $mailcontent{'To'}) ;
|
||
|
|
$to = pop @to_array ; # get the last item in the array
|
||
|
|
$to =~ s/\>//g ;
|
||
|
|
# }
|
||
|
|
|
||
|
|
# $mailaccount = '' ;
|
||
|
|
# $junk = '' ;
|
||
|
|
|
||
|
|
&common_debug ("get_mail : to [$to]") ;
|
||
|
|
|
||
|
|
$uniqueid = $pop->Uidl($i);
|
||
|
|
$uniqueid =~ s/\s//g; # strip whitespace
|
||
|
|
|
||
|
|
$headandbody = $pop->HeadAndBody( $i ) ;
|
||
|
|
|
||
|
|
# &common_debug ("get_mail : uniqueid [$uniqueid] headandbody [$headandbody]") ;
|
||
|
|
&common_debug ("get_mail : uniqueid [$uniqueid]") ;
|
||
|
|
|
||
|
|
&getmail_mailparse ;
|
||
|
|
|
||
|
|
$pop->Delete( $i ) ; # temp comment out
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
$pop->Close();
|
||
|
|
|
||
|
|
} #------------------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
sub getmail_clean {
|
||
|
|
|
||
|
|
my ($item) = @_ ;
|
||
|
|
|
||
|
|
$item =~ s/\|/-/g; # remove any pipes
|
||
|
|
$item =~ s/\n//g; # remove any newlines
|
||
|
|
$item =~ s/\r//g; # remove any carriage returns
|
||
|
|
$item =~ s/\"//g; # remove " marks
|
||
|
|
$item =~ s/\'//g; # remove ' marks
|
||
|
|
|
||
|
|
return ($item) ;
|
||
|
|
|
||
|
|
} #------------------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
sub getmail_mailparse {
|
||
|
|
|
||
|
|
$parser = MIME::Parser->new;
|
||
|
|
|
||
|
|
### Keep parsed message bodies in core (default outputs to disk):
|
||
|
|
# $parser->output_to_core(1); # don't write attachments to disk
|
||
|
|
$parser->output_to_core('NONE') ; # or die "can't output_to_core: $!" ;
|
||
|
|
|
||
|
|
### Change how nameless message-component files are named:
|
||
|
|
$parser->output_prefix("msg") or die "can't output_prefix: $!" ;
|
||
|
|
|
||
|
|
&getmail_make_dir ;
|
||
|
|
|
||
|
|
binmode(STDOUT, ":utf8");
|
||
|
|
|
||
|
|
### Output each message body to the same directory:
|
||
|
|
# $parser->output_under($outputdir);
|
||
|
|
$parser->output_dir($outputdir) or die "can't output into $outputdir: $!" ;
|
||
|
|
|
||
|
|
# $entity->dump_skeleton; # for debugging
|
||
|
|
|
||
|
|
$entity = $parser->parse_data($headandbody) or die "can't parse_data $headandbody: $!" ;
|
||
|
|
|
||
|
|
&getmail_process_entity_header ;
|
||
|
|
&getmail_process_output_dir ;
|
||
|
|
|
||
|
|
} #------------------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
sub getmail_process_output_dir {
|
||
|
|
|
||
|
|
$i{unique_id} = $uniqueid ;
|
||
|
|
$i{date_time} = "$now_ccyy_mm_dd $now_hour:$now_min:$now_sec" ;
|
||
|
|
$i{client_id} = '0' ;
|
||
|
|
$i{staff_id} = '0' ;
|
||
|
|
$i{sent_date} = $mailparsedate ;
|
||
|
|
$i{doctype} = 'ticket' ;
|
||
|
|
$i{mailtype} = 'EMAILI' ;
|
||
|
|
$i{subject} = $mailparsesubject ;
|
||
|
|
$i{sent_from} = $mailparsefrom ;
|
||
|
|
$i{sent_to} = $to ;
|
||
|
|
$i{cc} = $mailcontent{'Cc'} ;
|
||
|
|
$i{bcc} = $mailcontent{'Bcc'} ;
|
||
|
|
$i{reply_to} = $mailparsereplyto ;
|
||
|
|
# $i{action_time} = ;
|
||
|
|
$i{completed} = '0' ;
|
||
|
|
|
||
|
|
&db_min_insert('tickets') ;
|
||
|
|
|
||
|
|
my @hash_split = split /\#\#/, $mailparsesubject ;
|
||
|
|
my @subj_uid = split / /, $hash_split[1] ;
|
||
|
|
my $suid = $subj_uid[0] ;
|
||
|
|
|
||
|
|
if ($suid && length($suid)>5) {
|
||
|
|
%i = () ;
|
||
|
|
$i{completed} = '0' ;
|
||
|
|
&db_min_upd('tickets',"suid='$suid' OR unique_id='$suid' OR suid='$uniqueid' OR unique_id='$uniqueid'") ;
|
||
|
|
}
|
||
|
|
|
||
|
|
} #------------------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
sub getmail_make_dir {
|
||
|
|
|
||
|
|
our $outputdir = "$mailpath/tickets/$uniqueid" ;
|
||
|
|
|
||
|
|
return if -d $outputdir ;
|
||
|
|
|
||
|
|
mkdir ($outputdir,0777) or die "mkdir $outputdir: $!" ;
|
||
|
|
chmod (0777, $outputdir) ;
|
||
|
|
|
||
|
|
} #------------------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
sub getmail_process_entity_header {
|
||
|
|
|
||
|
|
use Encode qw(decode);
|
||
|
|
|
||
|
|
$mailparsesubject = $entity->head->get('subject');
|
||
|
|
|
||
|
|
&common_debug ("getmail_process_entity_header : subject [$mailparsesubject]") ;
|
||
|
|
|
||
|
|
$mailparsesubject = decode("MIME-Header", $mailparsesubject) ;
|
||
|
|
|
||
|
|
&common_debug ("getmail_process_entity_header : subject [$mailparsesubject]") ;
|
||
|
|
|
||
|
|
$mailparsesubject =~ s/\|/-/g; # remove any pipes
|
||
|
|
$mailparsesubject =~ s/\n//g; # remove any newlines
|
||
|
|
$mailparsesubject =~ s/\r//g; # remove any carriage returns
|
||
|
|
$mailparsesubject =~ s/\'//g; # remove any apostrophes
|
||
|
|
|
||
|
|
$mailparsesubject =~ s/\/\///g; # remove the '//' from TLF chasers
|
||
|
|
$mailparsesubject =~ s/\\//g; # remove the '\' from TLF chasers
|
||
|
|
|
||
|
|
unless ($mailparsesubject) { $mailparsesubject = "(No Subject)" ; }
|
||
|
|
|
||
|
|
$mailparsefrom = $entity->head->get('from');
|
||
|
|
$mailparsefrom =~ s/\|/-/g; # remove any pipes
|
||
|
|
$mailparsefrom =~ s/\n//g; # remove any newlines
|
||
|
|
$mailparsefrom =~ s/\r//g; # remove any carriage returns
|
||
|
|
$mailparsefrom =~ s/\"//g; # remove " marks
|
||
|
|
$mailparsefrom =~ s/\'//g; # remove ' marks
|
||
|
|
|
||
|
|
$mailpamailparsefrom = decode("MIME-Header", $mailparsefrom) ;
|
||
|
|
|
||
|
|
$mailparsereplyto = $entity->head->get('Reply-To');
|
||
|
|
$mailparsereplyto =~ s/\|/-/g; # remove any pipes
|
||
|
|
$mailparsereplyto =~ s/\n//g; # remove any newlines
|
||
|
|
$mailparsereplyto =~ s/\r//g; # remove any carriage returns
|
||
|
|
$mailparsereplyto =~ s/\"//g; # remove " marks
|
||
|
|
$mailparsereplyto =~ s/\'//g; # remove ' marks
|
||
|
|
|
||
|
|
$mailparsedate = $entity->head->get('date');
|
||
|
|
|
||
|
|
my ($dayofweek, $day, $month, $ccyy, $time, $gmt) = split /\s/, $mailparsedate ;
|
||
|
|
|
||
|
|
$day = sprintf("%02d", ($day)) ;
|
||
|
|
|
||
|
|
$m{jan} = '01' ; $m{feb} = '02' ; $m{mar} = '03' ; $m{apr} = '04' ; $m{may} = '05' ; $m{jun} = '06' ; $m{jul} = '07' ; $m{aug} = '08' ; $m{sep} = '09' ; $m{oct} = '10' ; $m{nov} = '11' ; $m{dec} = '12' ;
|
||
|
|
|
||
|
|
my $hashkey = lc $month ;
|
||
|
|
# $mailparsedate = "$day." . $m{$hashkey} ."." . substr($ccyy,2,2) . " (" . substr($time,0,5) . ")" ; # 15.06.22 (12:49)
|
||
|
|
$mailparsedate = "$ccyy-$m{$hashkey}-$day " . substr($time,0,8) ; # 2022-06-21 12:49:35
|
||
|
|
|
||
|
|
chomp $mailparsesubject ;
|
||
|
|
chomp $mailparsedate ;
|
||
|
|
chomp $mailparsefrom ;
|
||
|
|
chomp $mailparsereplyto ;
|
||
|
|
|
||
|
|
unless ($mailparsereplyto) {
|
||
|
|
$mailparsereplyto = $mailparsefrom ;
|
||
|
|
}
|
||
|
|
|
||
|
|
&getmail_auto_reply ;
|
||
|
|
|
||
|
|
&common_debug ("getmail_process_entity_header : mailparsereplyto [$mailparsereplyto]") ;
|
||
|
|
|
||
|
|
} #------------------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
sub getmail_auto_reply {
|
||
|
|
|
||
|
|
my @hash_split = split /\#\#/, $mailparsesubject ;
|
||
|
|
my @subj_uid = split / /, $hash_split[1] ;
|
||
|
|
|
||
|
|
&common_debug ("getmail_auto_reply : subj_uid=[$subj_uid[0]]") ;
|
||
|
|
|
||
|
|
unless ($subj_uid[0] && length($subj_uid[0])>5) {
|
||
|
|
my $resubject = ($mailparsesubject =~ /Re:/iog) ? '' : 'Re: ' ;
|
||
|
|
my $resubject .= "$mailparsesubject ##$uniqueid##" ;
|
||
|
|
my $remsg = qq~Hello, thank you for contacting ITV.
|
||
|
|
|
||
|
|
Your ticket ID is $uniqueid.
|
||
|
|
|
||
|
|
One of our consultants will reply to you shortly to assist you with your query - typically within a few hours.
|
||
|
|
|
||
|
|
For after-hour emergencies please contact Technical Support on support\@aisport.africa or telephonically on (+27) 10 534 7011.
|
||
|
|
|
||
|
|
Best regards,
|
||
|
|
|
||
|
|
The ITV Africa Team~ ;
|
||
|
|
&common_debug ("getmail_auto_reply : to=[$mailparsefrom] subject=[$resubject]") ;
|
||
|
|
&common_send_mail($mailparsefrom,'','','','',"$remsg","$resubject") ;
|
||
|
|
}
|
||
|
|
|
||
|
|
} #------------------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
1;
|