ホーム
warning: Creating default object from empty value in /var/www/drupal-5.23/modules/taxonomy/taxonomy.module on line 1418.

Perl で、ハッシュ値 (ハッシュダイジェスト) を扱う:<br />コンテンツの内容が変更されたかどうかをチェックする方法

たとえば、あるウェブサイトのコンテンツ (ウェブページ) が変更されたかどうかをチェックする処理を考えてみる。Perl で、文字列比較を行う場合には if($a eq $b) {...} などとすればいいだろう。ただしこれは $a と $b が比較的「小さな」文字列であった場合である。それでは HTML などのデータで、以前アクセスしたときと今回アクセスしたときで内容が変更されているかどうかを効率的にチェックするにはどうしたらいいのだろう。1つの解法としては、ハッシュ関数を使うことが考えられる。Perl の変数で「ハッシュ」というものが出てくるが、こちらは「ハッシュ関数」である。ハッシュ関数としては、以前は MD5 というものが多く使われていたが、コンピュータの処理速度の向上によって相対的にセキュリティが低下したので、より安全な SHA1 を利用する。 使用するクラス 
use Digest::SHA1;
use Digest::SHA1 qw(sha1_hex);  # sha1_hex 関数をインポートしておく

my $content = "ここに HTML などのコンテンツが入る";
my $digest = sha1_hex($content); # コンテンツのハッシュ値 (16進数)
print $digest;
SHA1 は、もともとあるデータから 160ビット (20 バイト) の固定長の一意のデータを生成する。このデータを「ハッシュ値」と言っているが、ハッシュ値は元のデータが 1文字でも違えば、値自体もまったく違うものとなることが約束されている。また、ハッシュ値から元のデータは復元できないようになっている (これを一方向関数という)。Digest::SHA1 モジュールには単に my $data = sha1($content); とすればハッシュ値をバイナリで出力してくれるが、視覚的に見たい場合、文字列として処理する場合 (たとえばファイル名にこのハッシュ値を使うこともできる) は sha1_hex を使う。sha1_hex を使った場合はハッシュ値が 16進数の文字列として出力されるため、固定長 40バイトのデータとなる。 この方法は特にPerl だけにできるということではなく、言語を問わず、ハッシュ関数が用意されている Java や PHP にも使える。
参考リンク
たとえば、あるウェブサイトのコンテンツ (ウェブページ) が変更されたかどうかをチェックする処理を考えてみる。Perl で、文字列比較を行う場合には if($a eq $b) {...} などとすればいいだろう。ただしこれは $a と $b が比較的「小さな」文字列であった場合である。それでは HTML などのデータで、以前アクセスしたときと今回アクセスしたときで内容が変更されているかどうかを効率的にチェックするにはどうしたらいいのだろう。1つの解法としては、ハッシュ関数を使うことが考えられる。Perl の変数で「ハッシュ」というものが出てくるが、こちらは「ハッシュ関数」である。ハッシュ関数としては、以前は MD5 というものが多く使われていたが、コンピュータの処理速度の向上によって相対的にセキュリティが低下したので、より安全な SHA1 を利用する。 使用するクラス 
use Digest::SHA1;
use Digest::SHA1 qw(sha1_hex);  # sha1_hex 関数をインポートしておく

my $content = "ここに HTML などのコンテンツが入る";
my $digest = sha1_hex($content); # コンテンツのハッシュ値 (16進数)
print $digest;
SHA1 は、もともとあるデータから 160ビット (20 バイト) の固定長の一意のデータを生成する。このデータを「ハッシュ値」と言っているが、ハッシュ値は元のデータが 1文字でも違えば、値自体もまったく違うものとなることが約束されている。また、ハッシュ値から元のデータは復元できないようになっている (これを一方向関数という)。Digest::SHA1 モジュールには単に my $data = sha1($content); とすればハッシュ値をバイナリで出力してくれるが、視覚的に見たい場合、文字列として処理する場合 (たとえばファイル名にこのハッシュ値を使うこともできる) は sha1_hex を使う。sha1_hex を使った場合はハッシュ値が 16進数の文字列として出力されるため、固定長 40バイトのデータとなる。 この方法は特にPerl だけにできるということではなく、言語を問わず、ハッシュ関数が用意されている Java や PHP にも使える。
参考リンク
Posted on 2005-12-07 by yas |

Perl で、メールサーバに送られてきたメールを処理する

Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。 使用するクラス 
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use Unicode::Japanese;

my ($mail) = &parse;
print "From: " . $mail->{sender} . "\n";
print "To: " . $mail->{recipient} . "\n";
print "Subject: " . $mail->{subject} . "\n";

sub parse {

    my ($mail);

    # Parser Setting
    my $parser = new MIME::Parser;
    $parser->output_to_core(1);    # Keeps body analyzed internally
    $parser->tmp_recycling (1);    # Recycles the temporary stuff

    my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";

    # Headers
    $mail->{sender   } =  $entity->head->get('from'   );
    $mail->{subject  } =  $entity->head->get('subject');
    $mail->{recipient} =  $entity->head->get('to'     );
    $mail->{recipient} =~ s/\n//g;

    # From
    @addrs = Mail::Address->parse($mail->{sender});
    foreach $addr (@addrs) {
        $mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
    }

    # Subject
    my $subject = $mail->{subject};
    $lws      = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
    $ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
    $subject  =~ s/\n//g;
    $subject  =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
    $subject  =~ s/$lws/ /go;
    $subject  =~ s/$ew_regex/decode_base64($1)/egio;
    $subject  = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
    $mail->{subject} = $subject;

    # Get MIME
    ($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
    $mail->{body   } =  Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
    $mail->{body   } =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line
    $mail->{subject} =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line

    return $mail;
}

sub getEntities {

    my $entity = shift;
    my $body, $filename, $mimetype, $object;

    # BODY
    my @parts = $entity->parts;
    if (@parts) {                   # multipart...

        my $i;
        foreach $i (0 .. $#parts) { # dump each part...

            &getEntities($parts[$i]);
        }
    } else {                        # single part...

        # Get MIME type, and display accordingly...
        my ($type, $subtype) = split('/', $entity->head->mime_type);
        my $bodyhandle = $entity->bodyhandle;

        if ($type =~ /^(text|message)$/) {      # text

            $body .= $bodyhandle->as_string;

        } else {                                # binary

            $filename= $entity->head->recommended_filename;
            $mimetype = $entity->head->mime_type;
            $object = $bodyhandle->as_string;
            binmode($object);
            # if we want to store it as BASE64, you can continue the processs here
        }
    }

    return ($body, $filename, $mimetype, $object);
}

1;
Procmail を利用すればサーバに送られてきたメールが標準入力から Perl スクリプトに渡すことができる。ここでは Procmail の詳細は割愛するが、以下は標準入力に入っているメールを処理する関数。 使用するクラス 
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use MIME::Parser;
use MIME::Base64;
use Mail::Address;
use Unicode::Japanese;

my ($mail) = &parse;
print "From: " . $mail->{sender} . "\n";
print "To: " . $mail->{recipient} . "\n";
print "Subject: " . $mail->{subject} . "\n";

sub parse {

    my ($mail);

    # Parser Setting
    my $parser = new MIME::Parser;
    $parser->output_to_core(1);    # Keeps body analyzed internally
    $parser->tmp_recycling (1);    # Recycles the temporary stuff

    my $entity = $parser->parse(\*STDIN) or die "Parse Error in __FILE__\n";

    # Headers
    $mail->{sender   } =  $entity->head->get('from'   );
    $mail->{subject  } =  $entity->head->get('subject');
    $mail->{recipient} =  $entity->head->get('to'     );
    $mail->{recipient} =~ s/\n//g;

    # From
    @addrs = Mail::Address->parse($mail->{sender});
    foreach $addr (@addrs) {
        $mail->{sender} = $addr->address if $addr->address; # USE CAUTION, for the multiple address
    }

    # Subject
    my $subject = $mail->{subject};
    $lws      = '(?:(?:\x0D\x0A|\x0D|\x0A)?[ \t])+';
    $ew_regex = '=\?ISO-2022-JP\?B\?([A-Za-z0-9+/]+=*)\?=';
    $subject  =~ s/\n//g;
    $subject  =~ s/($ew_regex)$lws(?=$ew_regex)/$1/gio;
    $subject  =~ s/$lws/ /go;
    $subject  =~ s/$ew_regex/decode_base64($1)/egio;
    $subject  = Unicode::Japanese->new($subject, 'auto')->sjis_imode;
    $mail->{subject} = $subject;

    # Get MIME
    ($mail->{body}, $mail->{filename}, $mail->{mimetype}, $mail->{object}) = &getEntities($entity);
    $mail->{body   } =  Unicode::Japanese->new($mail->{body}, 'auto')->sjis_imode;
    $mail->{body   } =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line
    $mail->{subject} =~ s/[ 　\n\r]+$//g;    # Delete the white spaces in the end of the line

    return $mail;
}

sub getEntities {

    my $entity = shift;
    my $body, $filename, $mimetype, $object;

    # BODY
    my @parts = $entity->parts;
    if (@parts) {                   # multipart...

        my $i;
        foreach $i (0 .. $#parts) { # dump each part...

            &getEntities($parts[$i]);
        }
    } else {                        # single part...

        # Get MIME type, and display accordingly...
        my ($type, $subtype) = split('/', $entity->head->mime_type);
        my $bodyhandle = $entity->bodyhandle;

        if ($type =~ /^(text|message)$/) {      # text

            $body .= $bodyhandle->as_string;

        } else {                                # binary

            $filename= $entity->head->recommended_filename;
            $mimetype = $entity->head->mime_type;
            $object = $bodyhandle->as_string;
            binmode($object);
            # if we want to store it as BASE64, you can continue the processs here
        }
    }

    return ($body, $filename, $mimetype, $object);
}

1;
Posted on 2005-12-06 by yas |

Perl で、RSS で配信されたエントリーの日付を処理する

HTTP::Date クラスを使うと RSS で配信されたエントリーの日付 (dc:date) を変換してくれる。この場合、RSS のソースによって米国から日本のニュースにアクセスした場合などは、時差 (タイムゾーン) を考慮する必要があるため注意する。 使用するクラス 
use HTTP::Date;
#!/usr/bin/perl

use LWP::UserAgent;
use HTTP::Request;
use HTTP::Date;

# 初期化
my $html;
my $timezone = 'JST';
my $url    = 'https://www.yoursite.com/index.rdf';
my $rss    = new XML::RSS;
my $proxy  = new LWP::UserAgent;       # UseAgent の作成
my $req    = new HTTP::Request(GET=>$url);
my $res    = $proxy->request($req);    # $url にアクセスする
my $xml    = $res->content;            # コンテンツ (この場合は RSS/XML) を取得

# RSS を解析
eval {
    $rss->parse($xml);
};

if($@) {
    # $rss->parse が失敗したとき
}

# @{$rss->{items}} に、RSS のすべてのエントリー (item) が入る
foreach my $item ( @{$rss->{items}} ) {

    my $date        = HTTP::Date::str2time($item->{dc}->{date}, $timezone);

    $html    .=    qq|<a href=$item->{link}>$item->{title}</a><br>\n|; # タイトルをリンクつきで出力
    $html    .=    qq|$description<br>|    if $item->{description};    # 概要 (description) を出力
    $html    .=    qq|[<a href=$item->{link}>続きを読む</a>]<hr size=1>\n|;
}

print $html;

1;
参考リンク
HTTP::Date クラスを使うと RSS で配信されたエントリーの日付 (dc:date) を変換してくれる。この場合、RSS のソースによって米国から日本のニュースにアクセスした場合などは、時差 (タイムゾーン) を考慮する必要があるため注意する。 使用するクラス 
use HTTP::Date;
#!/usr/bin/perl

use LWP::UserAgent;
use HTTP::Request;
use HTTP::Date;

# 初期化
my $html;
my $timezone = 'JST';
my $url    = 'https://www.yoursite.com/index.rdf';
my $rss    = new XML::RSS;
my $proxy  = new LWP::UserAgent;       # UseAgent の作成
my $req    = new HTTP::Request(GET=>$url);
my $res    = $proxy->request($req);    # $url にアクセスする
my $xml    = $res->content;            # コンテンツ (この場合は RSS/XML) を取得

# RSS を解析
eval {
    $rss->parse($xml);
};

if($@) {
    # $rss->parse が失敗したとき
}

# @{$rss->{items}} に、RSS のすべてのエントリー (item) が入る
foreach my $item ( @{$rss->{items}} ) {

    my $date        = HTTP::Date::str2time($item->{dc}->{date}, $timezone);

    $html    .=    qq|<a href=$item->{link}>$item->{title}</a><br>\n|; # タイトルをリンクつきで出力
    $html    .=    qq|$description<br>|    if $item->{description};    # 概要 (description) を出力
    $html    .=    qq|[<a href=$item->{link}>続きを読む</a>]<hr size=1>\n|;
}

print $html;

1;
参考リンク
Posted on 2005-12-02 by yas |

Perl で、文字コードの自動判定をする

たとえば、LWP::UserAgent で取得した RSS (= XML ファイル) の文字コードの自動判定 (エンコーディングの自動判定) を行うには、以下のようにする。
#!/usr/bin/perl

use Encode::Guess;
use LWP::UserAgent;
use HTTP::Request;

my $url = 'https://perltips.twinkle.cc/index.rdf';

my $proxy = new LWP::UserAgent;
my $req   = new HTTP::Request(GET=>$url);
my $res   = $proxy->request($req);
my $xml   = $res->content;
my $enc   = guess_encoding($xml, qw/euc-jp shiftjis 7bit-jis utf8/);
ref($enc) or die "Can't guess: $enc"; #　自動判定に失敗したときのエラー処理
$xml = decode($enc->name, $xml);      # utf8 で保存

...
参考リンク
たとえば、LWP::UserAgent で取得した RSS (= XML ファイル) の文字コードの自動判定 (エンコーディングの自動判定) を行うには、以下のようにする。
#!/usr/bin/perl

use Encode::Guess;
use LWP::UserAgent;
use HTTP::Request;

my $url = 'https://perltips.twinkle.cc/index.rdf';

my $proxy = new LWP::UserAgent;
my $req   = new HTTP::Request(GET=>$url);
my $res   = $proxy->request($req);
my $xml   = $res->content;
my $enc   = guess_encoding($xml, qw/euc-jp shiftjis 7bit-jis utf8/);
ref($enc) or die "Can't guess: $enc"; #　自動判定に失敗したときのエラー処理
$xml = decode($enc->name, $xml);      # utf8 で保存

...
参考リンク
Posted on 2005-11-30 by yas |
« 先頭‹ 前…456789101112次 ›最終 »