Perl: 画像ファイルをアップロードしてメール添付で送る

![upload_send_perl_apr18.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/179446/461c00a1-cadb-aab7-c010-96d256b16607.png)

Ubuntu で必要なライブラリーのインストール

```bash
sudo apt install libpath-class-perl
```

フォルダーの構造

```text
$ tree -a
.
├── .env
├── data_work
├── index.html -> upload_send_perl.html
├── mail_attache.pl
├── upload_send_perl.html
└── upload_send_perl.pl
```

```html:upload_send_perl.html
<!DOCTYPE html>
<html lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>upload send perl (Apr/18/2021)</title>
</head>
<body>
<h2>Upload Send Perl</h2>
<form method="post" action="upload_send_perl.pl" enctype="multipart/form-data">
<input type="file" name="files"  multiple>
<p><input type="submit" value="送信する"></p>
</form>
<p>Files will be uploaded to ./data_work.</p>
<hr />
<p>Apr/18/2021 AM 08:25</p>
</body>
</html>
```

```pl:upload_send_perl.pl
#! /usr/bin/perl
#
#	upload_send_perl.pl
#
#						Apr/18/2021
#
# --------------------------------------------------------------------
use	strict;
use	warnings;
use	utf8;
use	CGI;
use	File::Copy;
use	Dotenv;

push (@INC,'./');
require	"mail_attache.pl";
# --------------------------------------------------------------------
print STDERR "*** upload_send_perl.pl *** start ***\n";

my $env = Dotenv->parse('.env');
print STDERR %$env{'SERVER'} . "\n";
print STDERR %$env{'PORT'} . "\n";
#

my $SAVE_DIR = './data_work';

my $q = CGI->new;
my @files = $q->multi_param ('files');
print "Content-type: text/html\n\n";
for my $filename (@files)
{
	copy($q->tmpFileName($filename), "$SAVE_DIR/$filename") or die $!;
	print $filename . "<br />";

	my $path = "$SAVE_DIR/$filename";
	print $path . "<br />";
	mail_attache_proc($env,$path,$filename);
	print $filename . " *** sent ***<br />";
}

print	"Data is saved<br />";
#
print STDERR "*** end ***\n";
exit;

# --------------------------------------------------------------------
```

```pl:mail_attache.pl
#
#	mail_attache.pl
#
#						Apr/18/2021
#
# ---------------------------------------------------------------- 
use warnings;
use strict;
use utf8;
use Encode qw(encode);
use Net::SMTP;
use Email::MIME;
use Email::MIME::Creator;
use Path::Class;
 
# ---------------------------------------------------------------- 
sub mail_attache_proc
{
my $env = $_[0];
my $path = $_[1];
my $filename = $_[2];


print STDERR "*** mail_attache_proc *** start ***\n";

print "*** mail_attache_proc *** start ***<br />";
print "path = " . $path . "<br />";
#
my $mailhost = %$env{'SERVER'};
my $mailport = %$env{'PORT'};
my $mail_username = %$env{'FROM'};
my $mail_password = %$env{'PASSWORD'};

my $from_mail = %$env{'FROM'};
my $to_mail = %$env{'TO'};

print "from_mail = " . $from_mail . "<br />";
print "to_mail = " . $to_mail . "<br />";

my $subject = 'test テストApr/18/2021 AM 09:15';
my $body =
    "ある人がロバを一匹飼っていました。"
  . "そのロバはこれまで長い間、やすまずせっせと、麦を"
  . "水車小屋に運んできました。\n"
  . "ところがロバも年を取り、だんだん仕事の役に立たなくなりました。";
 
my $mail = Email::MIME->create(
	'header' => [
        'From'    => encode( 'MIME-Header-ISO_2022_JP', $from_mail ),
        'To'      => encode( 'MIME-Header-ISO_2022_JP', $to_mail ),
        'Subject' => encode( 'MIME-Header-ISO_2022_JP', $subject ),
    ],
parts => [
	Email::MIME->create(
		'attributes' => {
                      'content_type' => 'text/plain',
                      'charset'      => 'ISO-2022-JP',
                      'encoding'     => '7bit',
    },
    'body' => encode( 'iso-2022-jp', $body ),
),
Email::MIME->create(
	'attributes' => {
		'content_type' => 'image/bmp',
		'name'         => 'attached image name',
		'filename'     => $filename,
		'encoding'     => 'base64',
		'disposition'  => 'attachment',
		},
		'body' => scalar Path::Class::file($path)->slurp,
               ),
    ],
);

 
eval {
    my $smtp = Net::SMTP->new(
	$mailhost,
	Port  => $mailport,
	doSSL => 'starttls',
#	Debug => 1
    );
 
	$smtp->auth($mail_username, $mail_password, 'CRAM-MD5' );
	$smtp->mail($from_mail);
	$smtp->recipient( $to_mail, { SkipBad => 1 } );
	$smtp->data();
	$smtp->datasend( $mail->as_string() );
	$smtp->dataend();
	$smtp->quit;
};

if ($@) {
	die "ERROR : $@\n";
}

print STDERR "*** mail_attache_proc *** end ***\n";
}

# ----------------------------------------------------------------
1;
```

関連情報
[Perl: メールの送信 （添付ファイル付き）](https://qiita.com/ekzemplaro/items/0b7743c53cbf0002a2b4)
[Perl: ファイルのアップロード (cgi)](https://qiita.com/ekzemplaro/items/170eeb682d21e60f8345)