#!/usr/bin/perl
$^W=1;
use strict;
use WWW::Mechanize();
#use URL::Encode(); #####
use Data::Dumper;
use Fcntl; # for O_CREAT, O_EXCL
use Scalar::Util qw(reftype);
use Email::MIME;
use Date::Manip;
no utf8;
$ENV{LC_ALL}='C';

# vi(1) se: tabstop=4

# basic initializatons:
my $max_msgs=50; # max messages to retrieve, negative for unlimited
my $max_retries=4; # max times we retry failed operation/URL
my $maxf=999; # maximum number of additional filename endings
my $retry_sleep=2; # seconds to delay before a retry
my $sp='(?:[\t\ ])'; # my limited "space" character(s)
my $isgraph='(?:[!-~])'; # my limited "isgraph" character(s)
# my limited "space" or "newline" character(s):
my $spnl='(?:[\t\n\r\ ])';
my $prog_name='um.att.com';
my $login_url="https://$prog_name/servlet/EmailServlet?Action=Home";
my $base_url="https://dal01.$prog_name"; # may update later
#my $settings_url=$base_url . '/servlet/AddressBookServlet?Action=SettingsIndex';
my $logout_url=$base_url . '/servlet/EmailServlet?Action=Logoff&Folder=INBOX&Lang=EN';
my $ascending_url=$base_url . '/servlet/EmailServlet?Action=ViewFolder&Lang=EN&Folder=INBOX%3a1&Sort=1&Ascend=true';
my $descending_url=$base_url . '/servlet/EmailServlet?Action=ViewFolder&Lang=EN&Folder=INBOX%3a1&Sort=1&Ascend=false';
my $download_url_base='/servlet/EmailServlet?Action=GetMessage&Lang=EN&Folder=INBOX%3a1&UID=';
my $delete_url_base='/servlet/EmailServlet?Action=DeleteMail&Lang=EN&Folder=INBOX%3a1&UID=';
# https://dal01.um.att.com/servlet/EmailServlet?Action=ReadMail&Lang=EN&Folder=INBOX%3a1&UID=2349 # goes to specific message page

my $default_dir=".$prog_name.d";
my $rc_basename="$default_dir/rc";
my $env_prefix=uc($prog_name);
$env_prefix =~ s/\./_/g;
$env_prefix =~ s/\z/_/; # UM_ATT_COM_

# will need HOME for determining default location and interpreting ~
exists($ENV{HOME}) or
	die "$prog_name: HOME not found in environment, aborting.\n";
defined($ENV{HOME}) and ($ENV{HOME} =~ m!\A/!) or
	die "$prog_name: In environment: HOME=$ENV{HOME}, " .
		"needs to be absolute path, aborting.\n";

# will need to determine these
my($directory,$password,$username);

# try rc file
my $rc_absolute="$ENV{HOME}/$rc_basename";
$rc_absolute =~ s!/{2,}!/!g;
if(open(RC,'<',$rc_absolute)){
	while(<RC>){
		chomp;
		s/^[ \t]+//;
		if(/\ADirectory=(.*)\z/is){
			$directory=$1;
		}elsif(/\APassword=(.*)\z/is){
			$password=$1;
		}elsif(/\AUserName=(.*)\z/is){
			$username=$1;
		};
	};
	close(RC) or die "$prog_name: error closing $rc_absolute: $!, aborting.\n";
};

# try environment (takes precedence)
$directory=$ENV{"${env_prefix}DIRECTORY"} if
	exists($ENV{"${env_prefix}DIRECTORY"}) and
	$ENV{"${env_prefix}DIRECTORY"} =~ /./s;
$password=$ENV{"${env_prefix}PASSWORD"} if
	exists($ENV{"${env_prefix}PASSWORD"}) and
	$ENV{"${env_prefix}PASSWORD"} =~ /./s;
$username=$ENV{"${env_prefix}USERNAME"} if
	exists($ENV{"${env_prefix}USERNAME"}) and
	$ENV{"${env_prefix}USERNAME"} =~ /./s;

# check the simpler first
defined($username)
or die(
	"$prog_name: failed to determine username,\n",
	"must be set in environment (${env_prefix}USERNAME=), or \n",
	"in file $rc_absolute (UserName=), aborting\n"
);
defined($password)
or die(
	"$prog_name: failed to determine password,\n",
	"must be set in environment (${env_prefix}PASSWORD=), or \n",
	"in file $rc_absolute (Password=), aborting\n"
);

# not specified or null, start with default
$directory=$default_dir if !defined($directory) || $directory eq '';
if($directory =~ m!\A~((?:/.*)?)\z!s){
	# $directory is ~ or starts with ~/, replace that ~ with HOME
	$directory="$ENV{HOME}$1";
};
if($directory !~ m!\A/!s and $directory ne ''){
	# not absolute nor null, prefix with HOME
	$directory="$ENV{HOME}/$directory"
};
# security check:
$directory !~ m!(?:\A|/)\.\.(?:/|\z)! or die (
	"$prog_name: .. directory component(s) found in directory=$directory,\n",
	"disallowing because of security, aborting\n",
	# We only check for .. to thwart simple subversion attempts or
	# accidents, we'll consider the rest user's responsibility
);
while($directory =~ m!(?:\A|/)\.(?:/|\z)!){
	# get rid of any . component directories
	$directory =~ s!/\A\./+!!g;
	$directory =~ s!/+\./+!/!g;
	$directory =~ s!/\+.\z!!g;
};
# normalize it:
$directory =~ s!/{2,}!/!g;
$directory =~ s!([^/])/+\z!$1!;
# at this point, $directory should be absolute, assert it:
$directory =~ m!\A/! or
	# no ending newline for more perl diagnostics:
	die("$prog_name: \$directory=$directory not absolute, aborting");

#print "\$username=$username, \$password=$password, \$directory=$directory, \$rc_absolute=$rc_absolute\n"; #####

# chdir to $directory, creating if/as necessary
if(!chdir($directory)){
	local $_;
	local @_=split(m!/!,$directory,-1);
	chdir('/') or die "$prog_name: chdir('/') failed: $!, aborting\n";
	#print('A',$#_+1,'>',join('/',@_),"<\n"); #####
	shift(@_); # shift out null before start of our absolute path
	#print('B',$#_+1,'>',join('/',@_),"<\n"); #####
	while(@_){
		$_=shift(@_);
		$_ ne '' or next; # skip nulls between // or after ending /
		chdir($_) and
			next;
		#print "failed chdir($_)\n"; #####
		mkdir($_) or
			die "$prog_name: mkdir($_) from $directory failed: $!, aborting\n";
		chdir($_) or
			die "$prog_name: chdir($_) from $directory failed: $!, aborting\n";
	};
};

# more things we'll generaly be needing:
my $mech;
my $url;
#my $status; #####

#sub page_diags{ #####
#	defined($mech) or return undef;
#	if(defined($mech->base())){
#		print('$mech->base()=',$mech->base(),"\n");
#	}else{
#		print('!defined($mech->base())',"\n");
#	};
#	if(defined($mech->title())){
#		print('$mech->title()=',$mech->title(),"\n");
#	}else{
#		print('!defined($mech->title())',"\n");
#	};
#	if(defined($mech->content())){
#		print('$mech->content()=',$mech->content(),"\n");
#	}else{
#		print('!defined($mech->content())',"\n");
#	};
#	print ('$mech->links()=...',"\n");
#	Dumper($mech->links());
#}; #####

#use strict;#####
#$^W=1;#####
#sub phref{ #####
#	return if !exists($_[0]);
#	print(
#		join(
#			"\n",
#			sort keys %{$_[0]},
#		),
#		"\n",
#	);
#};
#my %h=(key1 => {k1=>'v1',k2=>'v2'}, key2 => 'value2');#####
#my $hr=\%h;#####
#&phref($h{key1});#####

my @inbox_results=();
sub chk_inbox{
	# Check if apparenty (logged in) on main page
	# (requires login to access that page)
	# on page,
	# of total pages,
	# messages on this page,
	# total messages
	# returned array is true if we got that data and expected match,
	# returns empty array (false) if we didn't match
	$mech->content()
	=~
	m!
		<td(?: $sp+ [^>]* )?>
		Displaying $sp+ page $sp+ (\d+) $sp+ of $sp+
		(\d+): $sp+ \((\d+) $sp+ of $sp+ (\d+) $sp+ Total $sp+ Messages\)
		</td> $spnl*
		<td $sp+ align=right>On $sp+ this $sp+ page: $sp+ \d+ $sp+
		Messages, $sp+ \d+ $sp+ Urgent, $sp+ \d+ $sp+ Unread
		</td>
	!sx
	;
	if(defined($4)){
		my @a=($1,$2,$3,$4);
		@inbox_results=(@a);
		#####print("CHK_INBOX MATCHED $1 $2 $3 $4\n");
		#####print("CHK_INBOX WANTARRAY\n") if wantarray;
		#####print("CHK_INBOX NOT WANTARRAY\n") if !wantarray;
		return(@a) if wantarray; return 1;
	}else{
		@inbox_results=();
		#####print("CHK_INBOX NOT MATCHED\n");
		#####print("CHK_INBOX WANTARRAY\n") if wantarray;
		#####print("CHK_INBOX NOT WANTARRAY\n") if !wantarray;
		return() if wantarray; return undef;
	};
};

sub login{
	# (re)initialize login
	$url=$login_url;
	my $retries=$max_retries;
	while(1){
		$mech=WWW::Mechanize->new(strict_forms => 1);
		#####print('$mech->get($login_url)',"\n");
		$mech->get($url);
		#<input type=hidden name=Action value=Logon>
		#<input type=hidden name=Template value="">
		#<input type=hidden name=Page value="">
		#<input type=hidden name=Sort value=-1>
		#<input type=hidden name="Lang" value="EN">
		#<input type=hidden name="ReturnURL" value="">
		#<input type=hidden name="SkipErtLookup" value="false">
		#<input type=hidden name="SuggestedUserName" value="" disabled>
		#Action=Logon
		#Template=
		#Page=
		#Sort=-1
		#Lang=EN
		#ReturnURL=
		#SkipErtLookup=false
		#UserName=j25dKSAMGA_w3P52fk%40um.att.com
		#Password=
		#####print('$mech->submit_form()',"\n");
		$mech->submit_form(
			with_fields => {
				# if we include these fields we get readony errors:
				#Action => 'Logon',
				#Template => '',
				#Page => '',
				#Sort => '-1',
				#Lang => 'EN',
				#ReturnURL => '',
				#SkipErtLookup => 'false',
				# seems stufficient to just have these fields:
				UserName => $username,
				Password => $password,
			},
		);

		#####
		#use strict;
		#$^W=1;
		#sub chk_inbox{
		#	my $t=0;
		#	if($t){return (1,1,0,0) if wantarray; return 1;
		#	}else{return () if wantarray; return undef;};
		#};
		#my @a=&chk_inbox();
		#my $s=&chk_inbox();
		#if(@a){ print('@a is true: (',join(',',@a),")\n");
		#}else{ print("\@a is false\n"); };
		#if($s){ print "\$s is true: $s\n";
		#}else{ print "\$s is false: $s\n"; };
		#if(&chk_inbox()){ print('&chk_inbox() is true',"\n");
		#}else{ print('&chk_inbox() is false',"\n");};
		#####

		if(!&chk_inbox()){
			return undef if $retries-- <= 0;
			$retry_sleep > 0 && sleep($retry_sleep);
			next;
		};
		# At this point should be on main page, able to get message
		# information, follow links to download content, etc.
		# Possibly update $base_url and others:
		{
			local $_=$mech->base();
			if(defined($_)){
				m!\A([A-Za-z]+:/+[^/]+)/!;
				if(defined($1)){
					$base_url=$1;
					$_=$base_url;
					#$settings_url =~ s!\A[A-Za-z]+:/+[^/]+/!$_/!;
					$logout_url =~ s!\A[A-Za-z]+:/+[^/]+/!$_/!;
					$ascending_url =~ s!\A[A-Za-z]+:/+[^/]+/!$_/!;
					$descending_url =~ s!\A[A-Za-z]+:/+[^/]+/!$_/!;
				};
			};
		};
		return 1;
	};
};

sub chk_logout{
	# check if apparenty logged out
	return 1
	if
		$mech->content()
		=~
		m!
			[^A-Za-z] [Ss]igned\ out\ of\ AT&amp;T [^A-Za-z]
			|
			[^A-Za-z] SetPageTitle('Auto-Signout'); [^A-Za-z]
		!sx
	;
	return undef;
};

sub try_url_inbox{
	# try (possibly repeatedly) url and check that it gets us to main
	exists($_[0]) and $#_ == 0 and $_[0] =~ /./ or return undef;
	my $url=$_[0];
	my $retries=$max_retries;
	while(1){
		$mech->get($url);
		return 1 if &chk_inbox();
		return undef if $retries <= 0;
		&chk_logout() or
			# don't know our state, thus don't know how to proceed
			return undef;
		# logged out, try login
		TUI_LOGIN:
		while(1){
			if(!&login()){
				return undef if --$retries <= 0;
				$retry_sleep > 0 && sleep($retry_sleep);
				next;
			};
			# logged in
			while(1){
				$mech->get($ascending_url);
				&chk_inbox() and last;
				return undef if --$retries <= 0 or !&chk_logout();
				$retry_sleep > 0 && sleep($retry_sleep);
				next TUI_LOGIN;
			};
			# at $ascending_url
			return 1 if $url eq $ascending_url;
			while(1){
				$mech->get($url);
				return 1 if &chk_inbox();
				return undef if --$retries <= 0 or !&chk_logout();
				$retry_sleep > 0 && sleep($retry_sleep);
				next TUI_LOGIN;
			};
		};
	};
};

sub login_ascending{
	# try to get logged in and to ascending (oldest first) order
	#####print('try &login()',"\n");
	&login() or return undef; # &login() includes retry logic
	my $retries=$max_retries;
	# logged in
	while(1){
		$mech->get($ascending_url);
		&chk_inbox() and return 1;
		return undef if $retries-- <= 0 or !&chk_logout();
		# retry && &chk_logout()
		$retry_sleep > 0 && sleep($retry_sleep);
		&login() or return undef; # &login() includes retry logic
		next;
	};
};

&login_ascending() or die "$prog_name: failed to reach main page, aborting\n";

my ($UID,$Path,$Sender,$Date_Time,$Size,$Subject);

my $retries=$max_retries;
sub chk_inbox_msg{
	# reinit:
	$UID=undef;
	$Path=undef;
	$Sender=undef;
	$Date_Time=undef;
	$Size=undef;
	$Subject=undef;

	$mech->content()
	=~
	m!
		<[Tt][Rr] (?: $sp+ [^>]*)?> $spnl*

		<[Tt][Dd] (?: $sp+ [^>]*)?>
		<input\ TYPE="checkbox"\ NAME="UID"\ value="
		(\d+) # UID
		">
		</[Tt][Dd]> $spnl*

		<[Tt][Dd] (?: $sp+ [^>]*)?> $spnl*
		<(?i:A $sp+ HREF)="
		(
			/servlet/EmailServlet\?Action=ReadMail&Lang=EN&
			Folder=INBOX%3a1&UID=\1
		) # Path
		"> $spnl*
		(?:<(?i:img $sp+ src)=[^>]*> $spnl*)*
		</[Aa]> $spnl*
		</[Tt][Dd]> $spnl*

		(?:
			<[Tt][Dd] (?: $sp+ [^>]*)?> $spnl*
			(?:
				<(?i:img $sp+ src)=[^>]*> $spnl*
				|
				&nbsp; $spnl*
			)*
			</[Tt][Dd]> $spnl*
		)*

		<[Tt][Dd] (?: $sp+ [^>]*)?> $spnl*
		(?:<[Bb]>)? $spnl*
		([^\n\r<>]+?) # Sender
		$spnl*
		(?:</[Bb]>)? $spnl*
		</[Tt][Dd]> $spnl*

		<[Tt][Dd] (?: $sp+ [^>]*)?> $spnl*
		<(?i:A $sp+ href)="/servlet/EmailServlet\?Action=ReadMail&Lang=EN&
			Folder=INBOX%3a1&UID=\1"> $spnl*
		(?:<[Bb]>)? $spnl*
		((?:\d{2}/){2}\d{2}\ \d{1,2}:\d{2}[ap]m) # Date/Time
		$spnl*
		(?:</[Bb]>)? $spnl*
		</[Aa]>
		(?: &nbsp; | $spnl* )*
		</[Tt][Dd]> $spnl*

		<[Tt][Dd] (?: $sp+ [^>]*)?> $spnl*
		<(?i:A $sp+ href)="/servlet/EmailServlet\?Action=ReadMail&Lang=EN&
			Folder=INBOX%3a1&UID=\1"> $spnl*
		(?:<[Bb]>)? $spnl*
		(\d+&nbsp;[KM]) # Size
		$spnl*
		(?:</[Bb]>)? $spnl*
		</[Aa]>
		(?: &nbsp; | $spnl* )*
		</[Tt][Dd]> $spnl*

		<[Tt][Dd] (?: $sp+ [^>]*)?> $spnl*
		<(?i:A $sp+ href)="/servlet/EmailServlet\?Action=ReadMail&Lang=EN&
			Folder=INBOX%3a1&UID=\1"> $spnl*
		(?:<[Bb]>)? $spnl*
		([^\n\r<>]+?) # Subject
		$spnl*
		(?:</[Bb]>)? $spnl*
		</[Aa]>
		(?: &nbsp; | $spnl* )*
		</[Tt][Dd]> $spnl*

		</[Tt][Rr]>

	!sx;
	if(defined($6)){
		($UID,$Path,$Sender,$Date_Time,$Size,$Subject)
		=
		($1,$2,$3,$4,$5,$6);
		return 1;
	};
	return undef;
};

sub logout{
	my $retries=$max_retries;
	&chk_logout() and return 1; # already logged out
	$mech->get($logout_url);
	&chk_logout() and return 1;
	while($retries-- > 0){
		$retry_sleep > 0 && sleep($retry_sleep);
		$mech->get($logout_url);
		&chk_logout() and return 1;
	};
	return undef;
};

sub labort{
	# logout and abort, optionally give reason
	my $reason='';
	$reason=$_[0] if exists($_[0]);
	$reason.=', ' if $reason ne '';
	if(&logout()){
		die "$prog_name: ${reason}aborting\n";
	}else{
		warn "$prog_name: ${reason}aborting\n";
		die "$prog_name: logout failed, aborting\n";
	};
};

sub myflush{
	defined($_[0]) or return undef;
	my $oldfh=select($_[0]); # change default output/fd to $_[0]
	$|=1; # set $_[0] to autoflush
	select($oldfh); # restore default output/fd
};

sub mtouch{

	# Touch just the mtime on open file, arguments:
	# 0: time
	# 1: reference to open file handle (or file name).
	$#_==1 && defined($_[0]) && $_[0] =~ /\d+/ && defined($_[1])
		or return undef;

	my $atime=(stat($_[1]))[8]; # save atime to preserve it
	defined($atime) or return undef;

	# need flush before touch to avoid later flush resetting mtime
	&myflush($_[1]);

	utime($atime,$_[0],$_[1])==1 and return 1;
	return undef;
};

sub eopen{
	# Exclusive open.
	# Required first argument is initial part of file name.
	# Optional second argument is extension to add on end of that.
	# Optional third argument is positive integer, it gives maximum
	# number of additional filenames to try where open fails because
	# file exists.  For subsequent attempts, filename will be
	# initial part plus .(N) plus extension, where N starts at 1
	# and increments on each attempt to maximum of third argument.
	# returns (FH, name),
	# where FH is scalar ref to opened file handle, name is name of file
	# opened.
	# In case of error(s), returns (undef, name) where name was the
	# (last) name attempted
	# or undef for other errors (e.g. usage errors or other open
	# failures)
	0 <= $#_ && $#_ <= 2 or return undef;
	my ($base,$ext,$max)=@_[0..2];
	defined($ext) or $ext='';
	"$base$ext" ne '' or return undef;
	defined($max) or $max=0;
	my $n=0;
	$max =~ /\A\d+\z/ or return undef;
	$max+=0;
	"$base$ext" !~ m!\0! or return undef;
	my $extra='';
	my $fh;
	do{
		sysopen($fh,"$base$extra$ext", O_WRONLY|O_CREAT|O_EXCL) and
			return($fh,"$base$extra$ext");
		$!{EEXIST} && $n++ < $max or return(undef,"$base$extra$ext");
		$extra=" ($n)";
	}until(0);
};

sub assertf(){
	# 1st argument scalar ref to file handle, or undef if failed to open
	return 1 if defined($_[0]);
	# 2nd argument last filename attempted, or undef for some errors
	&labort("failed to open $_[1]") if defined($_[1]);
	# 3rd argument first filename attempted
	&labort("failed to open $_[2]") if defined($_[2]);
	&labort('failed to open file');
};

#sub myreftype(){
#	# $ref, identifying string, recursion level(s)?
#	0 <= $#_ && $#_ <=2 or return undef;
#	my ($ref,$string,$recurse)=@_[0..2];
#	defined($string) or $string='?';
#	if(!defined($ref)){
#		print("$string is !defined\n");
#		return;
#	};
#	defined($recurse) or $recurse=0;
#	my $reftype=reftype($ref);
#	if(!defined($reftype)){
#		print "reftype($string) is !defined\n";
#		return;
#	}elsif($reftype eq 'ARRAY'){
#		print "reftype($string) is ARRAY\n";
#		if($recurse != 0){
#			--$recurse if $recurse > 0;
#			for(@{$ref}){
#				#&myreftype(${$ref}[$_],"\${\@{$string}}[$_]",$recurse);
#				&myreftype($ref->[$_],"$string\->[$_]",$recurse);
#			};
#		};
#	}elsif($reftype eq 'HASH'){
#		print "reftype($string) is HASH\n";
#		if($recurse != 0){
#			--$recurse if $recurse > 0;
#			for(sort keys %{$ref}){
#				#&myreftype(${$ref}{$_},"\${\%{$string}}{$_}",$recurse);
#				#&myreftype($ref->{$_},"$string->{$_}",$recurse);
#				&myreftype($ref->{$_},"$string\->{$_}",$recurse);
#			};
#		};
#	}else{
#		print "reftype($string) is defined and not ARRAY and not HASH\n";
#	};
#	return;
#};

# handle messages 'till done or failure
my $retries=$max_retries;
my $download_url;
my %b=();
while(1){
	@inbox_results=&chk_inbox();
	#####print('@inbox_results=(',join(',',@inbox_results),")\n");
	if(!@inbox_results){
		#####print("\@inbox_results is False\n");
		$retries <= 0 or
		!&chk_logout() or
		labort("failed to reach inbox");
		&login_ascending() or
		labort("failed to reach inbox");
	};
	#####print("\@inbox_results is True\n");
	# inbox ascending
	if(!&chk_inbox_msg()){
		if(join(' ',@inbox_results) eq '1 1 0 0'){
			print "$prog_name: Inbox is empty.  Exiting\n";
			exit(0) if &logout();
			die "$prog_name: &logout() failed, aborting\n";
		};
		print "$prog_name: no more (matching) messages?  Exiting\n"; #####
		defined($mech->content()) and
			#####
		print('$mech->content()=',$mech->content(),"\n");
		&logout() and exit(1);
		die "$prog_name: logout failed, aborting\n";
	};
	# have $UID, $Path, etc., try download
	$download_url=$url= $base_url . $download_url_base . $UID;
	if($max_msgs!=0){
		--$max_msgs if $max_msgs > 0;
	}else{
		# $max_msgs==0
		print "reached \$max_messages, exiting ...\n";
		exit(0) if &logout();
		die "$prog_name: &logout() failed, aborting\n";
	};
	$mech->get($url);
	#####
	#print "\$UID=$UID\n";
	#print "\$Path=$Path\n";
	#print "\$Sender=$Sender\n";
	#print "\$Date_Time=$Date_Time\n";
	#print "\$Size=$Size\n";
	#print "\$Subject=$Subject\n";
	#####print('$mech->response()=',Dumper($mech->response()),"\n") if(defined($mech->response()));
	#####print('$mech->content()=',Dumper($mech->content()),"\n") if(defined($mech->content()));
	my $parsed=Email::MIME->new($mech->content());
	defined($parsed) or &labort('missing download content');

	# Return-path:
	{
		local $_=$parsed->header('Return-path');
		defined($_) or
			&labort('missing Return-path: on mail');
	};

	# Date:
	my $Date=$parsed->header('Date');
	defined($Date) or
		&labort('missing Date: on mail');
	#print "\$Date=$Date\n"; #####
	$ENV{TZ}='GMT0';
	my $tz = new Date::Manip::TZ;
	my $zone = $tz->zone('GMT0');
	defined($zone) or &labort('failed to find time zone GMT0');
	my $date=new Date::Manip::Date;
	my $err = $date->parse($Date);
	!$err or &labort("failed to parse Date: $Date");
	$err = $date->convert($zone);
	!$err or &labort("failed to convert to timezone GMT0");
	my $isodate=$date->printf('%Y-%m-%dT%H:%M:%SZ');
	#print "\$isodate=$isodate\n" if defined($isodate); #####
	my $mtime=$date->printf('%s');
	#print "\$mtime=$mtime\n" if defined($mtime); #####
	# &mtouch($mtime,$fh) or &labort("failed to touch mtime on \$fh");

	# From:
	my $From=$parsed->header('From');
	defined($From) or
		&labort('missing From: on mail');
	#print "\$From=$From\n"; #####

	# Subject:
	my $subject=$parsed->header('Subject');
	defined($subject) or
		&labort('missing Subject: on mail');
	#print "\$subject=$subject\n"; #####

	my $file_base="$isodate.$subject.$From";
	# make it a legal filename with no directory components:
	$file_base =~ s!/!%2f!g;
	$file_base =~ s!\000!%00!g;

	# Let's save full raw email
	my($fh,$file_name)=&eopen($file_base,'.eml',$maxf); # try to open
	&assertf($fh,$file_name,$file_base.'.eml'); # assert opened

	#####my $raw_xz;
	#####use IO::Compress::Xz qw(xz $XzError) ; 
	#####use strict; $^W=1;$a='b';$b='c';print "${$a}\n";
	#my $status = xz \$raw =>
	#	$fh [ 'Preset' => 9, 'Extreme' => 1, ];
	#if(!$status){
	#	unlink($file_name) or
	#		warn("$prog_name: failed to remove $file_name\n");
	#	&labort("xz failed: $XzError\n");
	#};
	#if(!print $fh ($raw_xz)){
	#	warn "$prog_name: error writing $file_name: $!\n";
	#	unlink($file_name) or
	#	warn "$prog_name: failed to remove $file_name\n";
	#	&labort();
	#};
	#####

	if(!print $fh ($mech->content())){
		warn "$prog_name: error writing $file_name: $!\n";
		unlink($file_name) or
		warn "$prog_name: failed to remove $file_name\n";
		&labort();
	};
	if(!&mtouch($mtime,$fh)){
		warn "$prog_name: failed to set mtime on $file_name\n";
		unlink($file_name) or
		warn "$prog_name: failed to remove $file_name\n";
		&labort();
	}
	if(!close($fh)){
		warn "$prog_name: error closing $file_name: $!\n";
		unlink($file_name) or
		warn "$prog_name: failed to remove $file_name\n";
		&labort();
	};

	#####
	#use Scalar::Util qw(reftype);
	#&myreftype($parsed,'$parsed',-1);
	#for(sort keys %{$parsed}){
	#	#print("\${\$parsed}{$_}=${$parsed}{$_}\n");
	#	my $reftype=reftype(${$parsed}{$_});
	#	if(defined($reftype)){
	#		print(
	#			"reftype(\${\$parsed}{$_})=",
	#			reftype(${$parsed}{$_}),
	#			"\n",
	#		);
	#	}else{
	#		print("reftype(\${\$parsed}{$_})=!defined\n");
	#	};
	#};
	#####

	#${$parsed}{parts}=ARRAY(0x562df53e02e0)
	#${$parsed}{ct}=HASH(0x562df6526c60)
	#${$parsed}{body}=SCALAR(0x562df52b7b90)
	#${$parsed}{body_raw}=------

	#$^W=1;
	#use strict;
	#my %hash=('key' => 'value',);
	#my @array=(0,1,2);
	#my $scalar='scalar';
	#my $href=\%hash;
	#my $aref=\@array;
	#my $sref=\$scalar;
	#print('%hash=',%hash,"\n");
	#print('@array=',@array,"\n");
	#print('$scalar=',$scalar,"\n");
	#print('$href=',$href,"\n");
	#print('$aref=',$aref,"\n");
	#print('$sref=',$sref,"\n");

	#%{$parsed}
	#%{$parsed} ct
	#%{$parsed} header
	#%{$parsed} parts
	#####use Data::Dumper;print ('$parsed=',Dumper($parsed));
	#use Data::Dumper;print ('($parsed->parts)[0]=',Dumper(($parsed->parts)[0])); #####
	#use Data::Dumper;print ('($parsed->parts)[1]=',Dumper(($parsed->parts)[1])); #####
	#use Data::Dumper;print ('($parsed->parts)[2]=',Dumper(($parsed->parts)[2])); #####

	%b=();
	$parsed->walk_parts(sub {
		my ($part) = @_;
		return if $part->subparts;
		if(
			$part->content_type eq
			'text/plain; charset=utf-8; name=text.txt'
			&&
			$part->header('Content-Disposition') eq
			'attachment; filename=text.txt'
		){
			!exists($b{txt}) or &labort('multiple text/plain parts');
			$b{txt}=$part->body;
			# <CR><LF> to \n and trip empty lines:
			$b{txt} =~ s!(?:\r*\n)+!\n!g;
		}elsif(
			$part->content_type eq
			'text/html; charset=utf-8; name=text.html'
			&&
			$part->header('Content-Disposition') eq
			'attachment; filename=text.html'
		){
			!exists($b{html}) or &labort('multiple text/html parts');
			$b{html}=$part->body;
		}elsif(
			$part->content_type eq 'audio/wav'
			&&
			$part->header('Content-Disposition') eq
			'inline; filename=message.wav'
		){
			!exists($b{wav}) or &labort('multiple audio/wav parts');
			$b{wav}=$part->body;
		}else{
			&labort(
				'unknown part: $part->content_type=' .
				$part->content_type .
				q(, $part->header('Content-Disposition')=) .
				$part->header('Content-Disposition') .
				"\n"
			);
		};
	});
	for(qw(txt html wav)){
		$_ eq 'html'
		# html may be missing from voicemail messages where no
		# transcript could be created from .wav (no (recocognizable)
		# words on audio)
		or exists($b{$_}) or &labort("missing $_ part");
	};

	# save each part
	for(qw(txt html wav)){
		exists($b{$_}) or next;
		# txt may be empty from voicemail messages where no
		# transcript could be created from .wav (no (recocognizable)
		# words on audio)
		next if $_ eq 'txt' and length($b{$_})==0;
		my $e=".$_";
		my($fh,$file_name)=&eopen($file_base,$e,$maxf); # try to open
		&assertf($fh,$file_name,$file_base.$e); # assert opened
		if(!print $fh ($b{$_})){
			warn "$prog_name: error writing $file_name: $!\n";
			unlink($file_name) or
			warn "$prog_name: failed to remove $file_name\n";
			&labort();
		};
		if(!&mtouch($mtime,$fh)){
			warn "$prog_name: failed to set mtime on $file_name\n";
			unlink($file_name) or
			warn "$prog_name: failed to remove $file_name\n";
			&labort();
		}
		if(!close($fh)){
			warn "$prog_name: error closing $file_name: $!\n";
			unlink($file_name) or
			warn "$prog_name: failed to remove $file_name\n";
			&labort();
		};
	};

	# got parts fine, can delete this one
	#print('Delete:',$base_url.$delete_url_base.$UID,"\n"); sleep(10);#####
	$mech->get($base_url.$delete_url_base.$UID);

	##### ... next ...
	#####exit(0) if &logout();
	#####die "$prog_name: &logout() failed, aborting\n";
};