#!/usr/bin/perl -w

# Description: a small script to save attached files from emails (and do something)
# Author: Lilia <nursery at s8.xrea.com>
# License: Perl License
# Revision: 1.0.0.20051102
# Date: 2005-11-02 16:16:16 +09:00

use MIME::Parser;  # see http://search.cpan.org/perldoc?MIME%3A%3AParser
use Fcntl qw(:DEFAULT :flock);
use File::Compare;  # optional

use vars qw($Win32API_loaded);
BEGIN { # for Win32; see http://search.cpan.org/perldoc?Win32API%3A%3AFile%3A%3ATime
	$Win32API_loaded = 0;
	if($^O =~ /Win32/i) {
		eval q{ use Win32API::File::Time qw(:win);  1; }
			and $Win32API_loaded++;
	}
}

use strict;
use constant TIME       => time;
use constant EXCLUDE    => 1;
use constant COMPILED   => 1;

our($Script_Dir) = $0 =~ m#^(.*?)[/\\ ]*[^/\\ ]+$#;
$Script_Dir =~ s#\\#/#g;

# config
our $Cfg = {
	Store_Dir   => "$Script_Dir",  # directory to store files
	Temp_Dir    => "$Script_Dir/tmp",  # directory for output temp files
	File_RE     => [ qr/.+\.jpe?g$/i, 0, COMPILED ],  # regex, EXCLUDE (-> !/pat/ ) or 0, COMPILED (<- qr/pat/ ) or 0 (<- 'pat' )
	Max_Parts   => 20,  # limits the number of MIME parts to be parsed; if set to -1, then no maximum limit is enforced
	Rmdir_Temp  => 1,  # rmdir empty Temp_Dir at the end
#	Pre_Proc    => sub {},  # do something before &process
#	Post_Proc   => sub { system qq`perl "$Script_Dir/change_fileinfo.perl"` },  # do something after &process
	Touch       => sub ($) { # touch each of the files; see a simpler func in this script: _touch()
		my $file_path = shift or return;
		my $r = 0;

		use Image::Info qw(image_info);  # to change file info based on Exif data; see http://search.cpan.org/perldoc?Image%3A%3AInfo
		use Time::Local;

		my($file_name) = $file_path =~ m#([^/\\]+)$#;
		my $orig_time = 0;
		my $info = image_info($file_path);
		if($info->{DateTimeOriginal}) {
			$orig_time = date2time($info->{DateTimeOriginal});
		} elsif($file_name =~ /(\d\d)-(\d\d?)-(\d\d?)_(\d\d)-(\d\d)-?(\d\d)?/) { # an example (based on the file name)
			$orig_time = date2time(sprintf('%04d:%02d:%02d %02d:%02d:%02d', ($1 < 70 ? $1 +2000 : $1 +1900), $2, $3, $4, $5, ($6 ? $6 : 0)));
		}
		if($orig_time) {
			if($Win32API_loaded && defined &SetFileTime) {
				SetFileTime($file_path, TIME, $orig_time, $orig_time) and $r++;
			} else {
				utime(TIME, $orig_time, $file_path) and $r++;
			}
		}
		$r;  # return true or false
	},
};

our $Mail = shift;
die "Usage: $0 <file path>\n" unless defined $Mail;

local *touch   = (defined $Cfg->{Touch} && ref($Cfg->{Touch}) eq 'CODE') ? $Cfg->{Touch} : \&_touch;
local *compare = (defined &compare) ? \&compare : sub { 1 };  # no compare, then the files are considered unequal

# do pre/post-process if defined
&{$Cfg->{Pre_Proc}}  if(defined $Cfg->{Pre_Proc}  && ref($Cfg->{Pre_Proc})  eq 'CODE');
&process();
&{$Cfg->{Post_Proc}} if(defined $Cfg->{Post_Proc} && ref($Cfg->{Post_Proc}) eq 'CODE');

#BEGIN { # debug
#	(my $error_log = $0) =~ s#[^/\\ ]+$#error.log#;
#	$error_log =~ s#\\#/#g;
#	use CGI::Carp qw(carpout);
#	open(ERR, '>>', $error_log)
#		or die "Unable to open error.log: $!";
#	carpout(\*ERR);
#}

sub process {
	# directories prepared?
	-d $Cfg->{Store_Dir} or mkdir $Cfg->{Store_Dir}
		or die "Unable to mkdir $Cfg->{Store_Dir}: $!";
	-d $Cfg->{Temp_Dir}  or mkdir $Cfg->{Temp_Dir}
		or die "Unable to mkdir $Cfg->{Temp_Dir}: $!";

	my $parser = MIME::Parser->new();
	$parser->output_dir($Cfg->{Temp_Dir});
	$parser->max_parts($Cfg->{Max_Parts});

	# die a clean death
	local $SIG{__DIE__} = sub (@) {
		$parser->filer->purge;
		rmdir $Cfg->{Temp_Dir} if $Cfg->{Rmdir_Temp};
		die @_;
	};

	my $msg = eval { $parser->parse_open($Mail) };
	if(!$msg) { # parse failed
		# .. need to cleanup? ..
		die "Unable to parse $Mail: $@";
	} else {    # parse succeeded
		# move temp files to $Cfg->{Store_Dir}
		my($file_re,$re_x,$re_compiled) = @{$Cfg->{File_RE}} ? @{$Cfg->{File_RE}} : ('^\.', 1, 0);
		$file_re = qr/$file_re/ unless $re_compiled;
		opendir(DIR, $Cfg->{Temp_Dir})
			or die "Unable to opendir $Cfg->{Temp_Dir}: $!";
		my @files;
		foreach(sort { lc($a) cmp lc($b) } grep { $re_x ? !/$file_re/ : /$file_re/ } readdir(DIR)) {
			my $temp_path = "$Cfg->{Temp_Dir}/$_";
			next unless(-f $temp_path && -s _);

			my $store_path = "$Cfg->{Store_Dir}/$_";
			my $store_path_orig = $store_path;
			my $i = 1;
			while(-f $store_path && compare($temp_path, $store_path)) { # $store_path already exists and the files are unequal
				$store_path = $store_path_orig;
				my($base,$ext) = $store_path =~ /^(.*)\.([^\.]*)$/ ? ($1,$2) : ($_,'');
				$store_path =~ s/^\Q$base/${base}_$i/;
				$i++;
			}
			rename $temp_path => $store_path
				or die "Unable to rename $temp_path => $store_path: $!";

			touch($store_path)
				or die "Unable to set file times for $store_path: $!";
		}
		closedir(DIR);

		# memo (test)
#		my $num_parts = $msg->parts;
#		for(my $i = 0; $i < $num_parts; $i++) {
#			my $part = $msg->parts($i);
#			my $content_type = $part->mime_type;
#			my $file_name = 'tmp.jpg';  # $part->recommended_filename ?
#			STORE: if(defined $file_name) {
#				my($file_re, $re_x, $re_compiled) = @{$Cfg->{File_RE}};
#				$file_re = qr/$file_re/ unless $re_compiled;
#				my $matched = ($file_name =~ /$file_re/);
#				last STORE if($re_x ? $matched : !$matched);
#
#				my $file_path = "$Cfg->{Store_Dir}/$file_name";
#				# rename if $file_path already exists
#				my $file_path_orig = $file_path;
#				my $n = 1;
#				while(-f $file_path) {
#					$file_path = $file_path_orig;
#					my($base,$ext) = $file_path =~ /^(.*)\.([^\.]*)$/ ? ($1,$2) : ($_,'');
#					$file_path =~ s/^\Q$base/${base}_$n/;
#					$n++;
#				}
#
#				sysopen(FILE, $file_path, O_WRONLY|O_EXCL|O_CREAT)
#					or die "Unable to open $file_path: $!";
#				flock(FILE, LOCK_EX)
#					or die "Unable to lock $file_path: $!";
#				binmode(FILE);
#				seek(FILE, 0, 0);
#				if(my $fh = $part->open('r')) {
#					while(defined($_ = $fh->getline)) {
#						print FILE;
#					}
#					$fh->close;
#				}
#				close(FILE);
#				unlink $file_path unless -s $file_path;
#			}
#		}
	}
	$parser->filer->purge;
	rmdir $Cfg->{Temp_Dir} if $Cfg->{Rmdir_Temp};  # rmdir temp directory if empty
} # process end

sub _touch($) {
	my $file_path = shift;
	utime TIME, TIME, $file_path;
} # _touch end

sub date2time($) { # converts "YYYY:MM:DD HH:MM:SS" into a UNIX timestamp
#	require Time::Local;
	my $str = shift or return undef;
	my $time = -1;
	if($str =~ /^(\d\d\d\d)\D(\d\d?)\D(\d\d?)\D+(\d\d):(\d\d):(\d\d)/) {
		$time = Time::Local::timelocal($6, $5, $4, $3, $2 -1, $1 -1900);
		return ($time < 0) ? undef : $time;
	} else {
		return undef;
	}
} # date2time end

# End of script