Posts Tagged ‘Perl’

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

―――――――――――――――――――――――――――――――――――――
【ソフト名】かんたんメール送信(添付ファイル対応)
【著作権者】ORBIT
【制作日】2011年09月17日
【種 別】Perlモジュール
【連絡先】http://orsp.net/blog/
【配布元】http://orsp.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モジュール
【連絡先】http://rosx.net/blog/
【配布元】http://rosx.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 => 10  # 文字の長さを指定
	);

# 認証画像作成用メソッドを呼び出す
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へのアクセス)は最小限です。低負荷です。

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

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

このバージョンにはバグがあります。ぴくぴくダウンローダ β C01.01をご利用ください。

当サーバからダウンロード
Download:ぴくぴくダウンローダ β03.03 
※ 帯域制限がかかってるのでミラーでダウンロードすることを推薦します。
(環境によってはダウンロードに失敗する事があります。)

ミラー
Download:ぴくぴくダウンローダ β03.03 Rapidshare
Download:ぴくぴくダウンローダ β03.03 MEGAUPLOAD

動作例)
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

※ 近日中にVectorへ更新の申請を行います。更新されるまではこちらからダウンロードするようお願いいたします。
※ ファイルの入れ間違いがありました。すでにぴくぴくダウンローダ Ver β 03.01を公開しておりますのでそちらをご利用ください。

二分探索の処理の様子を細かく見てみる

二分探索の仕組みを詳しく見てみようと思う。サンプルコードはPerlで書いているがCやRuby、Javaなどほかの言語も似たようなものだと思う。

サンプルコード

#!/usr/bin/perl -w

# パラメータ
my $left = 0; my $right = 100; my $target = 140;
my @a; # 初期化

# 0~100までの数字を二倍しながら配列@aに追加
foreach my $i ($left..$right) {push(@a,$i*2);}

# 配列@aのリファレンスとその他引数を添えて二分探索関数を実行する
print &binary_search (@a , $left , $right , $target);

sub binary_search{
	# 配列@aのリファレンスと引数の受け取り
	my ($a , $left , $right , $target) = @_;
	# リファレンス$aを使い配列@aを読み込む
	my @a = @{$a};
	while($left <= $right){
		my $mid = int(($left + $right) / 2);
		if($a[$mid] == $target){
			return $mid;
		}elsif($a[$mid] < $target){
			$left = $mid + 1;
		}else{
			$right = $mid - 1;
		}
	}
	return -1;
}

変数や条件式の動きを追ってみると次のようになっていることが分かる。

$left $right $mid if($a[$mid] == $target)
0 100 (0 + 100) / 2 = 50 100 < 140 → 50 + 1 ($left)
51 100 (51 + 100) / 2 = 75 150 > 140 → 75 – 1 ($right)
51 74 (51 + 74) / 2 = 62 126 < 140 → 62 + 1 ($left)
63 74 (63 + 74) / 2 = 68 137 < 140 → 68 + 1 ($left)
69 74 (69 + 74) / 2 = 71 143 > 140 → 71 – 1 ($right)
69 70 (69 + 70) / 2 = 69 139 > 140 → 69 + 1 ($right)
70 70 (70 + 70) / 2 = 74 140 == 140 → END

二分探索の仕組みも分かったがPerlのリファレンスについても勉強になった。
一石二鳥ですね~

Twitter フォロワー同期(フォロー専用)Bot Perl 作成編

とりあえずさっきのプログラムを書きなおして完全にフォロワーさんを同期するプログラムを書きました。
Botみたいで(処理してるのはBotですが・・・)味気ないけど仕方ないですねwwww

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

# モジュール使用宣言
use Array::Diff;
use Data::Dumper;
use Net::Twitter;
use YAML::Tiny;
use Encode;
use FindBin;

# 現在のパスから見て設定ファイルを読み込み
my $config = (YAML::Tiny->read($FindBin::Bin . '/config.yml'))->[0];
# OAuth認証
my $twitter = Net::Twitter->new(
     traits => ['API::REST', 'OAuth'],
     consumer_key => $config->{'consumer_key'},
     consumer_secret => $config->{'consumer_secret'}
);
$twitter->access_token($config->{'access_token'});
$twitter->access_token_secret($config->{'access_token_secret'});
# 認証失敗時の処理
die('Auth failed:'.$config->{'username'}) unless ( $twitter->authorized ) ;

# ユーザー名を含むユーザー情報を取得
my $cr = $twitter->verify_credentials;
my $own_id = $cr->{id};

my $nextc = -1; # paging default.
my @following_id_list; # outgo

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
	# パラメータcursorは前回取得したフォローイングまでの番号が入っている
	my $following_list = $twitter->friends_ids({ id=>$own_id, cursor => $nextc });
	$nextc = $following_list->{next_cursor};
	# 配列からフォローイングのidを取得
	foreach my $id (@{ $following_list->{ids} }){
		push(@following_id_list, $id); # 後で比較するためにフォローイングを配列に保管
	}
}while($nextc!=0);
# 文字昇順でソート
@following_id_list = sort @following_id_list; 

$nextc = -1;
my @followers_id_list; # income

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
	# パラメータcursorは前回取得したフォロワーまでの番号が入っている
	my $followers_list = $twitter->followers_ids({ id=>$own_id, cursor => $nextc });
	$nextc = $followers_list->{next_cursor};
	# 配列からフォロワーのidを取得
	foreach my $id (@{ $followers_list->{ids} }){
		push(@followers_id_list, $id); # 後で比較するためにフォロワーを配列に保管
	}
}while($nextc!=0);
# 文字昇順でソート
@followers_id_list = sort @followers_id_list; 

# 差分を取得(フォローイング)
my $diff_following = Array::Diff->diff(@following_id_list, @followers_id_list);

# 差分を取得(フォロワー)
my $diff_followers = Array::Diff->diff(@followers_id_list, @following_id_list);

# リムった人をリム返し
foreach my $delid_following (@{ $diff_following->{deleted} }){
	$twitter->destroy_friend($delid_following);
}

# フォローした人をフォロー返し
foreach my $delid_followers (@{ $diff_followers->{deleted} }){
	$twitter->create_friend($delid_followers);
}

うん。書いてて思った。今まで差分取るとかループで比較するだけじゃんとか思ってたけどData::Dumperって結構便利だなw 今度機会があったら使ってみようかな?

Twitter フォロワー同期(リム専用)Bot Perl 解析編

自動でフォローされたらフォローし返すプログラムを書きたいけどNet::Twitterの使い方がわからなかったのでとりあえずフォロワー同期(リム専用)Botのソースをマニュアルを読みながら適当に解析してコメント打ちました。

マニュアル:Net::Twitter(英語)
参考にさせて頂いたソース:■[メモ]Twitterで自動フォロー削除

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

# モジュール使用宣言
use Array::Diff;
use Data::Dumper;
use Net::Twitter;
use YAML::Tiny;
use Encode;
use FindBin;

# 現在のパスから見て設定ファイルを読み込み
my $config = (YAML::Tiny->read($FindBin::Bin . '/config.yml'))->[0];
# OAuth認証
my $twitter = Net::Twitter->new(
     traits => ['API::REST', 'OAuth'],
     consumer_key => $config->{'consumer_key'},
     consumer_secret => $config->{'consumer_secret'}
);
$twitter->access_token($config->{'access_token'});
$twitter->access_token_secret($config->{'access_token_secret'});
# 認証失敗時の処理
die('Auth failed:'.$config->{'username'}) unless ( $twitter->authorized ) ;

# ユーザー名を含むユーザー情報を取得
my $cr = $twitter->verify_credentials;
my $own_id = $cr->{id};

my $nextc = -1; # paging default.
my @following_id_list; # outgo

# APIの仕様?から一度に100人までしか取得できないから0が返ってくるまでdoブロックをループ
do{
	# cursorは前回取得したフォローイングまでの番号が入っている
	my $following_list = $twitter->friends_ids({ id=>$own_id, cursor => $nextc });
	$nextc = $following_list->{next_cursor};
	# 配列からフォローイングのidを取得
	foreach my $id (@{ $following_list->{ids} }){
		push(@following_id_list, $id); # 後で比較するためにフォローイングを配列に保管
	}
}while($nextc!=0);
# 文字昇順でソート
@following_id_list = sort @following_id_list; 

$nextc = -1;
my @followers_id_list; # income
do{
	# cursorは前回取得したフォロワーまでの番号が入っている
	my $followers_list = $twitter->followers_ids({ id=>$own_id, cursor => $nextc });
	$nextc = $followers_list->{next_cursor};
	# 配列からフォロワーのidを取得
	foreach my $id (@{ $followers_list->{ids} }){
		push(@followers_id_list, $id); # 後で比較するためにフォロワーを配列に保管
	}
}while($nextc!=0);
# 文字昇順でソート
@followers_id_list = sort @followers_id_list; 

# 差分を取得
my $diff = Array::Diff->diff(@following_id_list, @followers_id_list);

# リムった人をリム返し
foreach my $delid (@{ $diff->{deleted} }){
	$twitter->destroy_friend($delid);
}

だいたい構造がわかったのでちゃちゃっと書き足しましょうか^^

ぴくぴくダウンローダ インストーラ付き 公開 β01.00

Pixivの画像を寝ている合間もひたすらダウンロードするソフトです。

インストール画面

動作画面

pixpix_downloader β01.00
このバージョンは古いです。最新のバージョンをダウンロードしてください。