トリビアの泉で沐浴 全トリビアリスト

  http://www.oride.net/trivia/trivia.htm

センス・オブ・プログラミング！

  
  http://www.amazon.co.jp/o/ASIN/4774121738/todaysnonsenc-22/ref=nosim/
  前橋 和弥 (著)
  技術評論社
  ISBN: 4774121738
  2004/11
  2,079 円

テキストファイルを 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;
}