perl

正直perlは最近あんまりやってないのでas isでおねがいします

URLデコード&URLエンコード


#URLデコード
@pairs = split(/&/,$buffer);
foreach $pair (@pairs)
{
    ($name, $value) = split(/=/, $pair);
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $FORM{$name} = $value;
}


#URLエンコード
$arg =~ s/(\W)/sprintf("%%%02X", ord($1))/ego;

または、

$value =~ s/(\W)/'%'.unpack("H2", $1)/ego;

Net::POP3モジュールでメールを受信


#!/usr/bin/perl


use Net::POP3;                      # Net::POP3 モジュール


$hostname = 'mail.unagichan.co.jp'; #メールサーバのホスト名
$username = 'unagi';                #ユーザ
$password = 'doremisama';           #パスワード
$use_apop = 0;                      #よりセキュアなapopを使う場合1


# サーバに接続する。
$pop = Net::POP3->new($hostname);
if( ! $pop )
{
    die("接続失敗 $! \n");
}
print "$hostnameに接続\n";


#コマンド送信
if( $use_apop )
{   # APOP コマンド送信
    $auth_check = $pop->apop($username,$password);
}
else
{   # USER・PASS コマンド送信
    $pop->user($username);
    $auth_check = $pop->pass($password);
}

if( $auth_check == undef )
{
    die "認証失敗\n";
}


# メール一覧ハッシュの参照を得る
$ref_mailsize = $pop->list();

# 受信メール一覧表示
foreach( sort {$a<=>$b} keys %{$ref_mailsize} )
{
    print "Mail NO.$_ $$ref_mailsize{$_}bytes\n";      #メール番号,サイズ
}

*mailindex = $ref_mailsize;                            # $ref_mailsize のエイリアス

# 受信メールの内容を順番に表示する。
foreach $num( sort {$a<=>$b } keys %mailindex )
{
    print "Mail No.$num $mailindex{$num}bytes\n\n";    #メール番号,サイズ

    $ref_lines = $pop->get($num);                      # メール本文を取得
    $line = 1;
    foreach ( @$ref_lines )
    {   # 1行ずつ表示
        print "$line: $_";

        # 例えばもし、'akiyama@dameningen.co.jp'から送信されたメールだった場合、
        # RemoteメールBOXから削除する
        {
            # From行の時 且つ 指定のメアドからの送信だった時
            if( /^From: / && /akiyama\@dameningen.co.jp/ ) 
            {
                # 指定されたメッセージ番号に削除マークを付ける。
                # サーバーとの接続断後、印をつけられたすべてのメッセージは
                # リモートメールボックスから削除される。 
                $pop->delete( $num );
            }
        }

        $line++;
    }
}

# リモートPOP3サーバーとの接続を切断し、終了する。
# 削除マークが付けられたメッセージは全てRemoteメールBOXから削除される。
$pop->quit();                                      # ログアウト


exit;                                              #End of Perl

MIME::Base64を使わずに、自力でBase64Encodeして添付ファイル付きメールを送る


#! /usr/bin/perl

# sendMailwithFile()で添付ファイル付きメールが送信できる。
# 添付書類がnullでも勝手に判断して普通に送れる。
# 

require "jcode.pl";    # 文字コード変換用

$sendmail = '/usr/bin/sendmail';    #メールコマンドのパス

$boundary = "MIME_Boundary_For_MultiPart_Level_000";

$type1 = "text/plain; charset=ISO-2022-JP";
$type2 = "multipart/mixed; boundary=$boundary";

# Base64 エンコード/デコード用キャラクタセット
$base64Char = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";



# 添付ファイル付きメールを送信する(used sendmail)
# 
sub sendMailwithFile
{
       #from  to   件名      本文      添付書類:複数送りたい時は予め圧縮結合してね(笑
    my($from, $to, $subject, $comment, $file1 ) = @_;

    my( $baseType, $fdata1, $buf, $head, $msg0, $msg1 );


# 件名のエンコード
if($subject ne "")
{
    $str = &encodeBase64("$subject");        # 自力でBase64Encode
    $str =~ s/\n//g;
    $subject = "=\?ISO-2022-JP\?B\?$str\?=";
}

$baseType = $type1;       # MIMEバウンダリ設定:text/plain
if( $file1 ne "" )        # 添付ファイル処理
{
    $baseType = $type2;   # MIMEバウンダリ変更:multipart/mixed

    # ファイル情報取得
    my($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
    $atime, $mtime, $ctime, $blksize, $blocks) = stat($file1);

    # 作業バッファに読込
    open(IN, $file1);
    binmode(IN);
    read(IN, $buf, $size);
    close(IN);

    $fdata1 = &encodeBase64( $buf );                   # 自力でBase64Encode
    $msg1 = &getMultiPartHeader($file1) . "$fdata1";   # Content-Type 解析
    $msg1 .= "\n--$boundary--\n";
}


# 状態に応じてバウンダリ追加
if($baseType =~ /multipart/)
{
    $msg0 =<<"__EOF__";

--$boundary
Content-Type: $type1

$comment
__EOF__
}
else
{
    $msg0 = "$comment";
}


# ヘッダ
my($head) = <<"__EOF__";
To: $to
From: $from
Subject: $subject
MIME-Version: 1.0
Content-Type: $baseType
Content-Transfer-Encoding: 7bit

__EOF__



$head = &change_code( 'jis', $head );    # 文字コード変換: →jis
$msg0 = &change_code( 'sjis', $msg0 );   # 文字コード変換: →sjis  なんでだろうね(笑) fix me !

# メール送信
open(MAIL, "| $sendmail -F $from $to");
print MAIL "$head$msg0$msg1";
close(MAIL);

}


# 以下ユーティリティ
#

# base64エンコード
sub encodeBase64
{
    my($len, $idx, $num, $ch, $ord, $bit24, @xx, $result, $rest, $cnt, $str4);
    my($temp) = "$_[0]\0\0";
    $result ="";
    if($_[0] eq "") {return $result;}
    $len = length($temp);
    $idx = 0;
    $cnt = 0;

    while( $idx < $len )
    {
        $ord = ord(substr($temp, $idx, 1));
        $idx++;
        $num = $idx % 3;
        $xx[$num] = $ord;

        if( $num == 0 )
        {
            $rest = $len - $idx;
            $bit24 = ($xx[1] << 16) + ($xx[2] << 8) + $xx[0];

            if ($rest < 2) { $ch = "="; }
            else { $ch = substr($base64Char, ($bit24 & 63), 1); }

            $str4 = $ch;
            $bit24 = ($bit24 >> 6);

            if ( $rest < 1) { $ch = "="; }
            else { $ch = substr($base64Char, ($bit24 & 63), 1); }

            $str4 = $ch . $str4;
            $bit24 = ($bit24 >> 6);
            $ch = substr($base64Char, ($bit24 & 63), 1);
            $str4 = $ch . $str4;
            $bit24 = ($bit24 >> 6);
            $ch = substr($base64Char, ($bit24 & 63), 1);
            $str4 = $ch . $str4;
            $result .= $str4;

            if($cnt == 15)
            {
                $result .= "\n";
                $cnt = 0;
            }
            else
            {
                $cnt++;
            }

            if( $rest < 3 ) { last; }
        }
    }

    return "$result\n";
}


# mail向けContent-Type 解析
#
sub getMultiPartHeader
{
    my($file) = $_[0];
    my($result, $type, $ext);

    $type = "application/octet-stream";
    $type = "${type}; name=\"$file\"";

    $result =<<"__EOF__";

--$boundary
Content-Type: $type
Content-Disposition: attachment; filename="$file"
Content-Transfer-Encoding: base64

__EOF__

    return "$result";
}


# 文字コード変換
#
sub change_code
{
    my($mojicode, $text) = @_;
    &jcode'convert(*text,$mojicode);
    if($mojicode eq 'jis') { &jcode'h2z_jis(*text); }
    if($mojicode eq 'sjis') { &jcode'h2z_sjis(*text); }
    if($mojicode eq 'euc')  { &jcode'h2z_euc(*text); }

# 必要ならアクティブにしてください。
#     $text =~ s/\&/&amp;/g;
#     $text =~ s/</&lt;/g;
#     $text =~ s/>/&gt;/g;
#     $text =~ s/"/&quot;/g;

    return $text;
}