テキストファイルを Gmail にバックアップする
主にテキストファイルを Gmail にバックアップするつもりででっち上げてみたが,車輪の再開発のような気がしてならない.
#!/usr/bin/env perl
use strict;
use Net::SMTP;
use MIME::Entity;
use File::MMagic;
use Getopt::Long;
use Encode qw/from_to/;
use Encode::Guess qw/euc-jp shiftjis 7bit-jis/;
use Compress::Zlib;
use FileHandle;
use File::Basename;
# SMTP サーバ
my $mailhost = 'smtp.server';
my $from = $ENV{USER};
my $subject = "";
my @files = ();
# コマンドライン引数
Getopt::Long::config('bundling');
my $gor = GetOptions(
'f|from=s' => \$from,
's|subject=s' => \$subject,
'a|attach=s@' => \@files,
);
if (@ARGV == 0 or $gor == 0) {
print << "USAGE";
usage: $0 mailto [options]
-f, --from=MAIL mail from
-s, --subject=SUBJECT subject
-a, --attach=FILE attachment file(s)
USAGE
;
exit;
}
my $to = shift;
my $smtp = Net::SMTP->new($mailhost) or die;
$smtp->mail($from);
$smtp->to($to);
my $mime = MIME::Entity->build(
From => tojis($from),
To => tojis($to),
Subject => tojis($subject),
Data => [""]
);
# 添付ファイルのデータを構築
my $mm = new File::MMagic;
for my $file (@files) {
my $type = $mm->checktype_filename($file);
my $path = "";
my $data = "";
my $name = "";
# ファイルタイプが 'text/plain' のときは,gzip で圧縮する
if ($type eq 'text/plain') {
my $fh = new FileHandle($file);
$data = join("", $fh->getlines());
# 圧縮
deflateInit(-Level => Z_BEST_COMPRESSION);
$data = Compress::Zlib::memGzip($data);
$type = 'application/x-gzip';
# ファイル名を取得
fileparse_set_fstype('VMS');
$name = basename($file, "") . '.gz';
} else {
$path = $file;
}
$mime->attach(
Path => $path,
Type => $type,
Data => $data,
Filename => $name,
Encoding => 'Base64'
);
}
$smtp->data();
$smtp->datasend($mime->stringify);
$smtp->dataend();
$smtp->quit;
#
# エンコードを jis に変換
#
sub tojis {
my ($data) = @_;
my $enc = guess_encoding($data);
from_to($data, $enc->name, 'jis');
return $data;
}
関連記事:
[2005-06-13-1] gmail をネットワークストレージ として使う Gmail Hard Drive.com