Tag Archives: Perl - Page 2

PerlとSendmailとBccのメーリングリスト配信スクリプト

昨日うっかりBccとCcを間違えてしまう大失態を演じてしまったため簡易ながら不特定多数にBccでメールを一斉配信してくれるスクリプトをPerlでサクッと書いてみました。
そしてどうせ書いたのならば久々に公開して有意義に使っていただこうと思い公開します。

コマンドラインベースで動けばいいかなということで機能自体には特にこだわりは無いのですが必要のある方がおりましたらご自由にコピーしてお使いください。
※ 当スクリプトを利用するにはPerlモジュールのインストールができるレベルの知識を必要とします。

実行用スクリプト
# vi infoEmail.pl

#!/usr/bin/perl
use utf8;
use strict;
use warnings;

binmode(STDOUT, ":utf8");

require "infoEmail.pm";

#
# メールマガジン配信スクリプト
#

my $mm   = infoEmail->new();
my $mime = $mm->mailer();

print $mime->as_string;
print '*' x 50 . "\n";
print "上記の内容で配信してもよろしいですか? (y/N)\n";
print '*' x 50 . "\n";
print "> ";
my $input = <STDIN>;
chomp($input);

if($input eq 'y' || $input eq 'yes'){
        $mm->sendmail($mime);
        print "メールを配信しました\n";
}else{
        print "メールの配信をキャンセルしました\n";
}

モジュール(プログラム本体)
# vi infoEmail.pm

#!/usr/bin/perl
package infoEmail;

use utf8;
use strict;
use warnings;

use Config::Simple;
use Mail::Krohn;
use Mail::Krohn::Sendmail;
use Email::MIME;
use Email::MIME::Creator;
use Encode;

sub new {
        my $class = shift;
        my $cfg = new Config::Simple('./infoEmail.conf') or die Config::Simple->error();
        my $self = {
                from         => $cfg->param('From'),
                to           => $cfg->param('To'),
                subject      => $cfg->param('Subject'),
                x_mailer     => $cfg->param('X-Mailer'),
                bccfilepath  => $cfg->param('BccFilePath'),
                bodyfilepath => $cfg->param('BodyFilePath')
        };
        return bless $self , $class;
}

sub mailer {
        my $self     = shift;
        my $bcc      = $self->read_config($self->{ bccfilepath });
        my $body     = $self->read_config($self->{ bodyfilepath });
        my $from     = $self->{ from };
        my $to       = $self->{ to };
        my $subject  = $self->{ subject };
        my $x_mailer = $self->{ x_mailer };
        my $mime = Email::MIME->create(
                header => [
                        From       => encode('MIME-Header-ISO_2022_JP' => decode('utf-8',$from)),
                        To         => encode('MIME-Header-ISO_2022_JP' => decode('utf-8',$to)),
                        Bcc        => encode('MIME-Header-ISO_2022_JP' => decode('utf-8',$bcc)),
                        Subject    => encode('MIME-Header-ISO_2022_JP' => decode('utf-8',$subject)),
                        'X-Mailer' => decode('utf-8',$x_mailer),
                ],
                attributes => {
                        content_type => 'text/plain',
                        charset      => 'ISO-2022-JP',
                        encoding     => '7bit',
                },
                body => encode('iso-2022-jp' => decode('utf-8',$body)),
        );
        return $mime;
}

sub sendmail {
        my $self = shift;
        my $mime = shift;
        my $mailer = Mail::Krohn->new();
        $mailer->send($mime);
        return 0;
}

sub read_config {
        my $self = shift;
        my $file_path = shift;

        open(my $fh, "<", $file_path) || die("Can not open file $file_path");
        my $file_contents;
        while( my $line = readline $fh ){
                $file_contents .= $line;
        }
        chomp($file_contents);
        return $file_contents;
}

1;

設定ファイル
# vi infoEmail.conf

############################################################
# メールマガジン設定ファイル
############################################################
# 送信元
From         = "ぼっちちゃん" <めーる@あどらあ>
# 送信先
To           = "ぼっちちゃん" <めーる@あどらあ>
# 件名
Subject      = ぼっちちゃんと愉快な仲間たちめーりんぐりすと
# メーラー名
X-Mailer     = My Best Friends Mailing List
############################################################
# 送り先リストの記述されたファイル
BccFilePath  = ./infoEmail_bcc.tmp
# 本文の記述されたファイル
BodyFilePath = ./infoEmail_body.tmp
############################################################

配信用メール本文
# vi infoEmail_body.tmp

お友達100人できるかな?

=======================================
"ぼっちちゃん" <めーる@あどらあ~>
ぼっちちゃんと愉快な仲間たちめーりんぐりすと
=======================================

配信対象のアドレスリスト
# vi infoEmail_bcc.tmp

おともだち1@あどらあ, めーる2@あどらあ, めーる3@あどらあ, めーる4@あどらあ, めーる5@あどらあ

久々にPerl触ったらだいぶ忘れてました(^_^;)

参考サイト
第20回 Email::Sender:メールを送信する:モダンPerlの世界へようこそ|gihyo.jp … 技術評論社

PerlでメールをBccで送信する Email::MIME + Mail::Krohn

メールをEmail::Sendを利用し送信しようとしたところ下記のように色々と怒られたため調べてみたところ
スクリプト起動時にReturn::Value::NO_CLUCKに値を入れれば良いということが分かったが実にスマートではないので代わりになるモジュールを探してみた

Return::Value is deprecated at /usr/lib/perl5/site_perl/5.8.8/Return/Value.pm line 13
        require Return/Value.pm called at /usr/lib/perl5/site_perl/5.8.8/Email/Send.pm line 11
        Email::Send::BEGIN() called at /usr/lib/perl5/site_perl/5.8.8/Return/Value.pm line 0
        eval {...} called at /usr/lib/perl5/site_perl/5.8.8/Return/Value.pm line 0
        require Email/Send.pm called at infoEmail.pl line 6
        main::BEGIN() called at /usr/lib/perl5/site_perl/5.8.8/Return/Value.pm line 0
        eval {...} called at /usr/lib/perl5/site_perl/5.8.8/Return/Value.pm line 0

必要なモジュールをインストールする
# cpan install parent
# cpan install Class::Accessor::Lite
# cpan install Mail::Krohn

#!/usr/bin/perl
use strict;
use warnings;

use utf8;
use Mail::Krohn;
use Mail::Krohn::Sendmail;
use Email::MIME;
use Email::MIME::Creator;
use Encode;

MAIN:{
    my $mime = Email::MIME->create(
        header => [
            From => 'そうしんもとめーる@あどれす',
            To   => 'そうしんもとめーる@あどれす',
            Bcc  => 'そうしんさきめーる@あどれす',
            Subject => Encode::encode( 'MIME-Header-ISO_2022_JP', 'テストメールです' ),
            'X-Mailer' => 'TestMailer',
        ],
        attributes => {
            content_type => 'text/plain',
            charset      => 'iso-2022-jp',
            encoding     => '7bit',
        },
        parts => [
                Encode::encode( 'iso-2022-jp', 'でばっぐおいしー!!' ),
        ],
    );

    my $mailer = Mail::Krohn->new();
    $mailer->send($mime);
}

参考サイト
Email::MIME::CreatorとEmail::Sendでメール送信
[Perl]Email::SendつかったらReturn::Valueにdeprecatedだと怒られた

CentOS5.7 Email::Send インストール

# cpan install Perl::OSType <- make testでエラーが起きる # yum --enablerepo=epel install perl-Perl-OSType # cpan install Module::Build # cpan install Module::Pluggable # cpan install Email::Send

Perl Linux CPU使用率 Memory使用率の高いプロセスを探し出す

最近尋常じゃないほどサーバリソースを喰い潰すプロセスがいるようなので調査しようと監視システムを書くことにしました。
一応PerlではProc::ProcessTableと呼ばれるモジュールにてプロセスを監視できるようなのでサクッとCPU使用率の高いプロセスを見つけ出すプログラムを書いてみました。

#!/usr/bin/perl
use warnings;
use strict;
use Proc::ProcessTable;

my $Processtable = new Proc::ProcessTable;

foreach my $item (@{$Processtable->table}){
        my $pctcpu = sprintf("%5.1f", $item->pctcpu);
        my $pctmem = sprintf("%5.1f", $item->pctmem);
        if($pctcpu > 50){
                print $item->pid ." ". getpwuid($item->uid) ." " . $pctcpu . " ". $pctmem ." ". $item->cmndline . "\n";
        }
}

実行するとちゃんとCPU使用率の高いプロセスを特定してくれました。

# perl ProcessKill.pl
3509 root 100.0   0.0 155 perl -e while (1) { $i++ }

参考
Proc::ProcessTable size differences

かんたんメール送信(添付ファイル対応) Perl用ライブラリ

―――――――――――――――――――――――――――――――――――――
【ソフト名】かんたんメール送信(添付ファイル対応)
【著作権者】ORBIT
【制作日】2011年09月17日
【種 別】Perlモジュール
【連絡先】https://www.orsx.net/blog/
【配布元】https://www.orsx.net/blog/
【圧縮形式】zip
【動作環境】Sendmailコマンドの使えるUNIX系OS
【開発環境】Perl5.8(標準モジュール Encode MIME::Base64 使用)
―――――――――――――――――――――――――――――――――――――
≪著作権および免責事項≫

 本ソフトはフリーソフトです。自由にご使用ください。なお,著作権は作者
であるORBITが保有しています。

 このソフトウェアを使用したことによって生じたすべての障害・損害・不具
合等に関しては、私と私の関係者および私の所属するいかなる団体・組織とも、
一切の責任を負いません。各自の責任においてご使用ください。

・はじめに
 メール送信を行うとき毎回文字操作を行うのが面倒だったためそれらを全て行う
モジュールを作成しました。
 わずか数行で添付ファイル付きのメールを送信できるため簡単なメールフォーム
の作成等に強力な力を発揮すると思います。

・ファイル構成
readme.txt ← 当ファイル
Sendmail.pm ← 本体

・インストール方法
対象のプロブラムと同じディレクトリにおいてください。

・使い方
Sendmail.pm最下部に簡単な利用法を記載してるのでそちらを御覧ください。

・履歴
2011年09月17日 Ver 1.0.0 公開

簡単な使用例

#!/usr/bin/perl
# 当モジュールを呼び出し
use Sendmail;

# オブジェクトの生成
my $send_obj = Sendmail->new({
        Subject => '件名',                     # 件名
        From    => 'user@mail.goge.net',       # 送信元
        });

# メール送信
$send_obj->sendmail(
                'user@mail.goge.net',          # 送信先
                '添付ファイル無し',            # メッセージ
                );

# メール送信
$send_obj->sendmail(
                'user@mail.goge.net',          # 送信先
                '添付ファイル有り',            # メッセージ
                'file.txt,日本語ファイル.txt'  # 添付ファイル(,で区切ると複数送信可能)
                );

ライセンス形態:GPL
Sendmail

オブジェクト指向 Perl プログラミング 設定用クラスのひな形

Perlでオブジェクト指向なプログラミングを行う時設定ファイルの扱いに困った。confファイルでも使おうかと思ったが、Settingクラスを作ってやったところ思いの外使い勝手が良かったので公開してみる。

Settingクラスは値の設定だけでなく外部の設定ファイルへのアクセスを行うメソッドを定義しておくことでメールのテンプレートや、禁止ワード等幅広い用途で外部の設定ファイルを素早く使う事ができる。

Settingクラス(Setting.cgi)のひな形

package Setting; # クラスのパッケージ名を宣言

sub new {
	my $class = shift;
	my $self= {
		# 設定項目を適当に作る
		setting1 => 'mogempoge',
		setting2 => 'hogehoge.txt',
		setting3 => 'hoguhogu.txt'
	};
	return bless $self , $class;
};

# テンプレートを記述したファイルから内容を読み取り変数に格納し、返すメソッド
sub read_config{
	my $self = shift; #クラスプロパティ
	$self->{ ConfigFile } = $_[0] if( @_ );
	
	open(my $fh, "<", $self->{ ConfigFile }) || die("Can not open file $self->{ ConfigFile }");
	my $file_contents;
	while( my $line = readline $fh ){ 
		$file_contents .= $line;
	}
	return $file_contents;
}

# 改行で区切られたワードを記述したファイルから内容を読み取り配列に格納し、返すメソッド
sub read_words {
	my $self = shift; #クラスプロパティ
	$self->{ ConfigFile } = $_[0] if( @_ );
	
	open(my $fh, "<", $self->{ ConfigFile }) || die("Can not open file $self->{ ConfigFile }");
	my @word_contents;
	while( my $line = readline $fh ){ 
		chomp($line); # 改行を削除
		push(@word_contents, $line);
	}
	return \@word_contents;
}

1;

mainクラス(Test.cgi)のひな形

#!/usr/bin/perl
BEGIN{ $| = 1; print "Content-type: text/html\n\n"; open(STDERR, ">&STDOUT"); }
# オプション関連の宣言
use strict;
use warnings;

# クラスを宣言
require "Setting.cgi";
require "Function.cgi";

# パッケージ名宣言
package main;

my $f_obj = Function->new();
$f_obj->function();

その他クラス(Function.cgi)で設定ファイルを読み込む場合のひな形

package Function; # クラスのパッケージ名を宣言

# コンストラクタを定義する時にSettingクラスを継承してあげる。
sub new {
	# 引数を受ける
	my ( $class, @args ) = @_;
	my %args = ref $args[0] eq 'HASH' ? %{ $args[0] } : @args;
	my $self = { %args }; #クラスプロパティ
	# オブジェクト生成
	$self = Setting->new();
	return bless $self , $class;
};

sub function{
	my $self = shift; #クラスプロパティ
	# "setting1"の値を表示する
	print $self->{ setting1 };
	# テンプレート"setting2"の内容を変数で受け取り表示する
	print $self->read_config( $self->{ setting2 } );
	# ワードリスト"setting3"の一覧を配列で受け取り表示する
	print $self->read_words( $self->{ setting3 } );
}

対ボット+外国人用 平仮名+和製漢字CAPTCHA Perl用ライブラリ

―――――――――――――――――――――――――――――――――――――
【ソフト名】かんたん日本語画像認証(アルファベットも可)
【著作権者】ORBIT
【制作日】2011年07月05日
【種 別】Perlモジュール
【連絡先】https://www.orsx.net/blog/
【配布元】https://www.orsx.net/blog/
【圧縮形式】zip
【動作環境】Perl5とImage::Magick、sazanami-gothicをインストールしたLinux
Windows系OSでは動作しない事が確認されております。
【開発環境】
CentOS5.6 perl, v5.8.8
―――――――――――――――――――――――――――――――――――――
≪著作権および免責事項≫

 本ソフトはフリーソフトです。自由にご使用ください。なお,著作権は作者
であるORBITが保有しています。

 このソフトウェアを使用したことによって生じたすべての障害・損害・不具
合等に関しては、私と私の関係者および私の所属するいかなる団体・組織とも、
一切の責任を負いません。各自の責任においてご使用ください。

・はじめに
 新しいフォームを作った時の副産物の公開です。わずか数行で画像認証機能
を実装することが可能です。
 海外のスパム・人間、共に日本特有の和製漢字・平仮名は入力できないこと
に着目し今回の日本語画像認証を作成しました。

・ファイル構成
readme.txt 当取説ファイル
JCaptcha.pm 本ソフト
background.jpg 画像認証用の下地となる画像ファイル
tmp/imgs/ 作成済みの画像ファイルを保存するディレクトリ

sazanami-gothic.ttf
↑さざなみゴシック(フォント) ライセンスの関係上同封しておりません。

・導入方法
efont プロジェクト日本語トップページ – SourceForge.JP
http://sourceforge.jp/projects/efont/
よりさざなみフォントをダウンロードし、sazanami-gothic.ttfのみ取り出し
ファイル構成のようにJCaptcha.pmと同じディレクトリに格納する。

 画像認証機能を追加したい対象のプログラムと同じディレクトリに上記、
ファイル構成を設置する。

・利用方法
下記の使用例を参考にプログラムに組み込んでください。

簡単な使用例

#!/usr/bin/perl

# 当モジュールを呼び出し
use JCaptcha;

# オブジェクトの生成
my $obj = JCaptcha->new(
		Key    => RX, # 鍵を指定
		Lang   => JP, # 言語を指定(JP/ENG)
		Length => 5   # 文字の長さを指定
	);

# 認証画像作成用メソッドを呼び出す
my $tmp1 = $obj->makeimgcode(); # 認証用画像を作成し、その画像までのパスを受ける
print "$tmp1\n"; # 認証画像までのパスを受け取る

#==============================================#
# 画像を表示し、入力を行う処理を書いてください #
#==============================================#

# 認証
# 入力された文字列で認証を行い、正しければ"1"間違っていれば"0"を受ける
#(受け渡す文字列はフラグ無しUTF-8とする)
my $tmp2 = $obj->enimgcode('入力を受けた文字列');
print "$tmp2\n"; # if文などで認証の成功失敗を判別する

・履歴

2011年09月05日 Ver 1.0.0 公開

作成された画像認証用画像の一例

ライセンス形態:GPL
Download:JCaptcha

ぴくぴくダウンローダ Ver β 03.03 Windows UNIX (MacOSX Linux) 対応

ぴくぴくダウンローダ Ver β 03.03でのバグを一部修正しました。

更新内容
絵師さんのID指定時に次のページに移動しない事があるようなので修正しました。
(Pixivの仕様が変わったため?不明です)

当ソフトの特徴
・ブラウザでリンクを開かなくても自動で条件(タグ検索、ブックマーク数、絵師さんのID)を指定することで画像を収集します。

・最初HTMLファイルのみを取得し作品へのリンクを解析するためダウンロードする画像(Pixivへのアクセス)は最小限です。低負荷です。

・一度ダウンロードした作品はコミックはフォルダ分けされ管理されます。指定されたフォルダにある画像は多重ダウンロードを行いません。

・バッチファイル等にコマンドを記述し指定した時間に実行させることも可能です。(絵師さんの新しい作品を定期的に収集し同期します。)

Download
こちらのダウンロードページよりダウンロードをお願い致します。

動作例)
Windows 7 (検索ワード,ミク ブックマーク数,5以上)

MacOSX 10.6 (検索ワード,ミク)

Perlで簡易WEBサーバを書く

なんとなく書いてみました。リファラやユーザエージェントとかそんなものは環境変数として取得できませんしForkもしません。とりあえず動かして一対一でHTMLファイルや画像ファイルを表示するだけです。ファイヤウォールを外せば他のパソコンからも閲覧できたりします。(危ないのでやらないようにw)

#!/usr/bin/perl -w
use FindBin;
use Socket qw/sockaddr_in inet_ntoa/;
use HTTP::Daemon;
use HTTP::Status;
 
# バッファリングしない
local $| = 1;
# 公開パス
my $public_path = "$FindBin::Bin"."/public_html";
my %in; # ブラウザからデータを受け取るハッシュを初期化

my $daemon = HTTP::Daemon->new(LocalAddr => '',LocalPort => "8080");
print "START SERVER $public_pathn";

while (my ( $client, $peer_addr ) = $daemon->accept){ # メインループ

    my ( $port, $iaddr ) = sockaddr_in($peer_addr); # PortとIPを取得する
    my $remote_addr = inet_ntoa($iaddr); # バイナリ状態のIPを変換する
    print "Access IP: $remote_addrn";

    while (my $request = $client->get_request){ # リクエスト処理ループ

        if ($request->method eq 'GET'){

            my $resource = $request->url->path;

            # GETで送られてきた情報を取得
            my $get_request = $request->url;
            my $get_data = ""; $get_data = $1 if($get_request =~ m/.*?(.+)/);
            &get_form($get_data) if($get_data);
            
            print "---> PATH: $resource GET: $get_datan";
            foreach my $key (keys (%in)){print "------> HASH: $key -> $in{$key}n";}

            if($resource =~ m/^/-_-/){ # インフォメーションページ
                my $header = HTTP::Headers->new( 'Content-Type' => 'text/html' );
                my $res = HTTP::Response->new( 200, 'OK', $header );
                $client->send_response($res);
                print $client "日本語でおk? PATH: $resource GET: $get_data IP: $remote_addrn";
            }elsif($resource =~ m//$/){ # ファイル名を省略していたらとりあえず"index.html"を表示する
                $client->send_file_response($public_path.$resource."index.html");
            }else{ # それ以外はファイルを探して表示
                $client->send_file_response($public_path.$resource);
            }

        }

    }

    $client->close;

}

sub get_form{
	%in = (); my ($get_data) = @_ ;
	foreach my $data (split(/&/, $get_data)) {
		my ($key, $value) = split(/=/, $data);

		$value =~ s/+/ /g;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
		$value =~ s/t//g;

		$in{"$key"} = $value;
	}
}

ブラウザで適当にhttp://127.0.01:8080/-_-/ でアクセスすれば下記のような返答があると思います。
日本語でおk? PATH: /-_-/ GET: IP: 127.0.0.1

Pixiv 画像 ダウンロード ぴくぴくダウンローダ Ver β 03.00 公開

大まかな更新内容
*コミックのダウンロードでフォルダー分けするようになりました。(重複ダウンロード対策済み)
*多重ダウンロード対策の強化でPixivサーバへの負荷軽減を目指しました。
*ブックマーク数の制限でPixivの仕様が若干変更されているみたいなので対策しました。

cielavenir さん の修正していただいたソースを元に更新しました。

動作画面 タグ検索(ミク) ブックマーク数(5以上)で動作させております。

ダウンロード:ぴくぴくダウンローダ Ver β 03.00

Download
こちらのダウンロードページよりダウンロードをお願い致します。