Perlについて

95ブログに投稿する際、後ろでいろいろやっているのがPerlです。
ここでは、RTMに登録する際に追加したプログラムの
Perlのソースを行ごとに解説していきます。

 

#!/usr/local/bin/perl    # perlの場所を指定
require '/bin/mimer.pl';   # メールのヘッダや本文に文章を書く際エンコードするもの
require '/bin/mimew.pl';
require '/bin/jcode.pl';
require '/bin/zen2han.pl';
sleep 10;
$loop=0;                # $loopを0にしている        
$real_to='kyu5blog+xxxxxx@rmilk.com'; # このperlで書き出したメールを送信する宛先
$file="/bin/mail$$.txt";        # $fileという名前にmail$$.txtのパスを当てている
open(MAIL,">$file");          # 受信したメールを$fileに書き出している
while (  ) { 				# ヘッダーの処理
	print DEBUG "-$_-\n";
	chomp;
	if ( /^$/ ){			
		print MAIL "To: $real_to\n";   # 宛先を$real_toにしている
		print MAIL "X-Loop: $loop\n";
		print DEBUG "To: $real_to\n";
		&print_cooked_subject();
		print MAIL "\n";
		print DEBUG "$_\n";
		last;
	}elsif(/^X-Loop: 0/i){        # 同じメールが何度も届かないように(ループしないように)している
		$loop=1;
	}elsif(/^X-Loop: 1/i){
		exit;
	}elsif( /^To:/i ){
		s/^To:/X-Original-To:/i;
		print MAIL "$_\n";
		print DEBUG "$_\n";
	}elsif( /^Content-Type: multipart\/mixed; boundary=\"(.*)\"/) {	
		$boundary=$1;
		print MAIL "$_\n";
	}elsif( /^From:/i ){	
		s/^From:/X-Original-From:/i;
		print MAIL "$_\n";
		print DEBUG "$_\n";
		print MAIL "From: txxxx\@students.miyakyo-u.ac.jp\n";
		print DEBUG "From: txxxx\@students.miyakyo-u.ac.jp\n";
		if(/(...)\@/){ $signature=$1; }
        print "$_\n";
	}elsif( /^Date:/i ){
		s/^Date:/X-Original-Date:/i;
		print MAIL "$_\n";
		print DEBUG "$_\n";
	}elsif( /^Subject:[ \t]+(.*)/i ){	
		print MAIL "X-Oiginal-$_\n";
		print DEBUG "X-Oiginal-$_\n";
		$subject=$1;
		$sub_c = 1;
	}elsif( /^[ \t]+(.*)/ && $sub_c ) {	
		$subject.=" ". $1;
	}else{
		$sub_c = undef;			
		print MAIL "$_\n";
		print DEBUG "$_\n";
	}
}
	print MAIL "\-\-$boundary\n";            # ヘッダーと本文の区切りを入れている
	print DEBUG "\-\-$boundary\n";
	print MAIL "Content-Type: text/plain; charset=\"iso-2022-jp\"\n";
	print DEBUG "Content-Type: text/plain; charset=\"iso-2022-jp\"\n";
	print MAIL "Content\-Transfer\-Encoding: 7bit\n";
	print DEBUG "Content\-Transfer\-Encoding: 7bit\n";
	print MAIL "\n";
	print DEBUG "\n";
	print MAIL "L:$List\n";               # 本文に表示する形を決めている
	print DEBUG "L:$List\n";
	print MAIL "D:$MON\/$DAY\n";
	print DEBUG "D:$MON\/$DAY\n";
	print MAIL "\-\-\-\n";
	print DEBUG "\-\-\-\n";
while (  ) { 				# 本文をメールに書き出している
	print MAIL "$_";
	print DEBUG "$_";
}
close(MAIL);

system("/usr/lib/sendmail $real_to <$file");   # メールを送信
unlink($file);

exit;
sub print_cooked_subject(){   # 18行目で処理をするサブルーチン
	$_ = $subject;
	$_ = &mimedecode($_);
	$_ = &jcode::euc($_);
	&zen2han();
	print DEBUG "-$_-\n";
	( $sec, $min, $hour, $date, $mon, $year, $wday ) = localtime;  # 現在の年月日時を取得している  
	$year += 1900;                             # 1900を加えて現在の西暦に合わせている
	$mon++;                                    # 月は1月を0, 2月を1で返すため1を加えて合わせている
	print DEBUG "$year,$mon,$date\n";
	if(length($mon)==1){            # 月が1桁なら頭に0を付けるようにしている(2月→02)
		$mon = "0" . $mon;
	}
	if(length($date)==1){           # 日が1桁なら頭に0を付けるようにしている(7日→07)
		$date = "0" . $date;                  
	}
	$today = $mon . $date;                     # 日付を4桁の数字にしている(2月7日→0207)(1)
	print DEBUG "$today\n";
	$sub = $_;                                 # $subの中にメールに書かれた件名を入れている 
	if($sub=~/(\d)$/){              # 件名の最後の数字1桁を$classとする       
		$class = $1;
		print DEBUG "$class\n";
	}
	if($sub=~/^t(\d\d\d\d)/){         # 件名の最初にt****(*は1桁の自然数)と書かれている場合の処理
		$a = "$1";                 # t****の****を$aとする
		print DEBUG "-$a-\n";
		$sub =~ s/^.....(.*)$/$1/;         # t****の後に書かれた文字(授業科目名)を$subの中に入れている
		$sub = $1;
		print DEBUG "$sub\n";
		if($a < $today){              # $aが(1)で作った数字より小さければ$yearに1を加えている
			$year++;
			print DEBUG "$year,$a\n";
		}
		elsif($a >= $today){            # 上に当てはまらなければ$yearはそのまま
			print DEBUG "$year,$a\n";
		}
		if($a =~/(\d\d)(\d\d)/){          # $aが4桁の自然数の場合,前の2桁を$MON,後ろ2桁を$DAYとする
			print DEBUG "$a\n";
			$MON = $1;
			$DAY = $2;
			$sub =~ s/(\d)$//;           # $subの最後の数字1桁(コマ数)を削除する
			$Subject = "追試:" . $sub ."(" . $class . "コマ)";  # 表示する件名の形を決めている(t0207情報A1→追試 情報A(2コマ))
			$List = "tsuishi";             # tuishiを$Listとする  
		}
	}
	elsif($sub=~/^(\d\d\d\d)/){         # 件名の最初に****(*は1桁の自然数)と書かれている場合の処理
		$a = "$1";                (内容は上記とほぼ同じ)
		print DEBUG "-$a-\n";
		$sub =~ s/^....(.*)$/$1/;
		$sub = $1;
		print DEBUG "$sub\n";
		if($a < $today){
			$year++;
			print DEBUG "$year,$a\n";
		}
		elsif($a >= $today){
			print DEBUG "$year,$a\n";
		}
		if($a =~/(\d\d)(\d\d)/){
			print DEBUG "$a\n";
			$MON = $1;
			$DAY = $2;
			$sub =~ s/(\d)$//;
			$Subject = "休講:" . $sub ."(" . $class . "コマ)";
			$List = "kyuukou";
		}
	}
	elsif($sub=~/^h(\d\d\d\d)/){        # 件名の最初にh****(*は1桁の自然数)と書かれている場合の処理
		$a = "$1";                (内容は上記とほぼ同じ)
		print DEBUG "-$a-\n";
		$sub =~ s/^.....(.*)$/$1/;
		$sub = $1;
		print DEBUG "$sub\n";
		if($a < $today){
			$year++;
			print DEBUG "$year,$a\n";
		}
		elsif($a >= $today){
			print DEBUG "$year,$a\n";
		}
		if($a =~/(\d\d)(\d\d)/){
			$MON = $1;
			$DAY = $2;
			$sub =~ s/(\d)$//;
			$Subject = "補講:" . $sub ."(" . $class . "コマ)";
			$List = "hokou";
		}
	}
	else{
		$Subject = $sub;
	}
	$Subject = &mimeencode($Subject);
	print MAIL "Subject: $Subject\n";
}
sub zen2han(){               # 全角で書かれた英数字を半角に直している
s/0/0/g;
s/1/1/g;
s/2/2/g;
s/3/3/g;
s/4/4/g;
s/5/5/g;
s/6/6/g;
s/7/7/g;
s/8/8/g;
s/9/9/g;
s/A/A/g;
s/B/B/g;
s/C/C/g;
s/D/D/g;
s/E/E/g;
s/F/F/g;
s/G/G/g;
s/H/H/g;
s/I/I/g;
s/J/J/g;
s/K/K/g;
s/L/L/g;
s/M/M/g;
s/N/N/g;
s/O/O/g;
s/P/P/g;
s/Q/Q/g;
s/R/R/g;
s/S/S/g;
s/T/T/g;
s/U/U/g;
s/V/V/g;
s/W/W/g;
s/X/X/g;
s/Y/Y/g;
s/Z/Z/g;
s/T/l/g;                 # ローマ数字のような機種依存文字を半角英字を使って直している
s/U/ll/g;                  (T→I,X→V,]→X)
s/V/lll/g;
s/W/lV/g;
s/X/V/g;
s/Y/Vl/g;
s/Z/Vll/g;
s/[/Vlll/g;
s/\/lX/g;
s/]/X/g;
}