<?xml version="1.0" encoding="UTF-8"?>
<rss version="2.0"
	xmlns:content="http://purl.org/rss/1.0/modules/content/"
	xmlns:wfw="http://wellformedweb.org/CommentAPI/"
	xmlns:dc="http://purl.org/dc/elements/1.1/"
	xmlns:atom="http://www.w3.org/2005/Atom"
	xmlns:sy="http://purl.org/rss/1.0/modules/syndication/"
	xmlns:slash="http://purl.org/rss/1.0/modules/slash/"
	>

<channel>
	<title>perlとMysqlでCGI &#38; サーバ管理 漏れ的メモ</title>
	<atom:link href="http://perl.no-tubo.net/feed/" rel="self" type="application/rss+xml" />
	<link>http://perl.no-tubo.net</link>
	<description>perl＆MySQLでCGIプログラミング。ウェブ運営の小技。鯖管メモもちょっとだけ。</description>
	<lastBuildDate>Mon, 23 Aug 2010 04:41:59 +0000</lastBuildDate>
	<generator>http://wordpress.org/?v=2.8.6</generator>
	<language>ja</language>
	<sy:updatePeriod>hourly</sy:updatePeriod>
	<sy:updateFrequency>1</sy:updateFrequency>
			<item>
		<title>IPベースのバーチャルホストと名前ベースのバーチャルホストを混合させる</title>
		<link>http://perl.no-tubo.net/2010/08/23/ip%e3%83%99%e3%83%bc%e3%82%b9%e3%81%ae%e3%83%90%e3%83%bc%e3%83%81%e3%83%a3%e3%83%ab%e3%83%9b%e3%82%b9%e3%83%88%e3%81%a8%e5%90%8d%e5%89%8d%e3%83%99%e3%83%bc%e3%82%b9%e3%81%ae%e3%83%90%e3%83%bc%e3%83%81/</link>
		<comments>http://perl.no-tubo.net/2010/08/23/ip%e3%83%99%e3%83%bc%e3%82%b9%e3%81%ae%e3%83%90%e3%83%bc%e3%83%81%e3%83%a3%e3%83%ab%e3%83%9b%e3%82%b9%e3%83%88%e3%81%a8%e5%90%8d%e5%89%8d%e3%83%99%e3%83%bc%e3%82%b9%e3%81%ae%e3%83%90%e3%83%bc%e3%83%81/#comments</comments>
		<pubDate>Mon, 23 Aug 2010 04:41:45 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[Apache]]></category>
		<category><![CDATA[SSL]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=774</guid>
		<description><![CDATA[Apache でIPベースのバーチャルホストを使う場合の注意点
VirtualHostディレクティブを利用する。VirtualHostディレクティブは、
&#60;VirtualHost IPアドレス&#62;
～
&#60; [...]]]></description>
			<content:encoded><![CDATA[<h3>Apache でIPベースのバーチャルホストを使う場合の注意点</h3>
<p>VirtualHostディレクティブを利用する。VirtualHostディレクティブは、</p>
<blockquote><p>&lt;VirtualHost IPアドレス&gt;<br />
～<br />
&lt;/VirtualHost&gt;</p></blockquote>
<p>のように記述し、これが1ホスト分のブロックとなる。つまり、バーチャルホストでホスティングしたいホストの数だけ、このブロックを記述すればよい。</p>
<p>IPベースで注意する点は、<strong>&lt;VirtualHost IPアドレス&gt;</strong>のIPアドレスを<strong>各ブロックで異なるものにしなければならない</strong>ということである。Apacheは、このIPアドレスでホストの設定のブロックを識別するからである。</p>
<p><a href="http://www.atmarkit.co.jp/flinux/rensai/apache08/apache08b.html">バーチャルホストによる複数サイトの同時運用</a> より</p>
<p>つまり1つのIPアドレスで1つのサイト（FQDN）のみしか運営出来ない。<br />
名前ベースのバーチャルホストと大きく異なる。</p>
<h3>名前ベースのバーチャルホストと混合させる場合</h3>
<p>名前ベースのバーチャルホストとIPベースのバーチャルホストを混合させる場合、 VirtualHost ディレクティブにポート番号も付加する。</p>
<blockquote><p>&lt;VirtualHost *:80&gt;<br />
～<br />
&lt;/VirtualHost&gt;</p>
<p>&lt;VirtualHost IPアドレス:80&gt;<br />
～<br />
&lt;/VirtualHost&gt;</p></blockquote>
<p>SSL を利用する場合も同様に 443 など、ポート番号を付加する。</p>
<p>IPベースでバーチャルホストを利用する場面としては（自分の場合）SSLサイトを作る際、ドメインが違うサイトでSSL証明書を使い分けなくてはならない為。通常の場合なら名前ベースのバーチャルホストで用が足りるはず。</p>
<p>ワイルドカード証明書では異なるドメインに対応出来ないし。ただ、ベリサインからマルチドメインなる証明書の販売が始まるとか始まったとか。</p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/08/23/ip%e3%83%99%e3%83%bc%e3%82%b9%e3%81%ae%e3%83%90%e3%83%bc%e3%83%81%e3%83%a3%e3%83%ab%e3%83%9b%e3%82%b9%e3%83%88%e3%81%a8%e5%90%8d%e5%89%8d%e3%83%99%e3%83%bc%e3%82%b9%e3%81%ae%e3%83%90%e3%83%bc%e3%83%81/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>centos4.8 に PostgreSQL8.4 をyumでインストール</title>
		<link>http://perl.no-tubo.net/2010/08/17/centos4-8-%e3%81%ab-postgresql8-4-%e3%82%92yum%e3%81%a7%e3%82%a4%e3%83%b3%e3%82%b9%e3%83%88%e3%83%bc%e3%83%ab/</link>
		<comments>http://perl.no-tubo.net/2010/08/17/centos4-8-%e3%81%ab-postgresql8-4-%e3%82%92yum%e3%81%a7%e3%82%a4%e3%83%b3%e3%82%b9%e3%83%88%e3%83%bc%e3%83%ab/#comments</comments>
		<pubDate>Tue, 17 Aug 2010 03:34:39 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[CentOS4.x]]></category>
		<category><![CDATA[PostgreSQL]]></category>
		<category><![CDATA[インストールメモ]]></category>
		<category><![CDATA[centOS]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=597</guid>
		<description><![CDATA[PGDGレポジトリを追加する
純正レポジトリに postgresql を上書きされない様に無効化しておく。
/etc/yum.repos.d/CentOS-Base.repo を編集のうえ、[base]と[update] [...]]]></description>
			<content:encoded><![CDATA[<h3>PGDGレポジトリを追加する</h3>
<p>純正レポジトリに postgresql を上書きされない様に無効化しておく。<br />
/etc/yum.repos.d/CentOS-Base.repo を編集のうえ、[base]と[update]のそれぞれのセクションに、<br />
exclude=postgresql*<br />
を追記する。</p>
<p>http://yum.pgsqlrpms.org/reporpms/repoview/letter_p.group.html<br />
から対象OS＆バージョンを選んでRPMをダウンロード</p>
<pre>wget http://yum.pgsqlrpms.org/reporpms/8.4/pgdg-centos-8.4-2.noarch.rpm
rpm -ivh pgdg-centos-8.4-2.noarch.rpm</pre>
<p>/etc/yum.repos.d/pgdg-84-centos.repo が作成される。</p>
<pre># cat /etc/yum.repos.d/pgdg-84-centos.repo
[pgdg84]
name=PostgreSQL 8.4 $releasever - $basearch
baseurl=http://yum.pgsqlrpms.org/8.4/redhat/rhel-$releasever-$basearch
enabled=1
gpgcheck=1
gpgkey=file:///etc/pki/rpm-gpg/RPM-GPG-KEY-PGDG

[pgdg84-source]
name=PostgreSQL 8.4 $releasever - $basearch - Source
failovermethod=priority
baseurl=http://yum.pgsqlrpms.org/srpms/8.4/redhat/rhel-$releasever-$basearch
enabled=0
gpgcheck=1
gpgkey=file:///etc/pki/rpm-gpg/RPM-GPG-KEY-PGDG</pre>
<p>必要なpostgresqlのパッケージをインストール＆アップデート。</p>
<pre># yum install postgresql postgresql-server postgresql-devel compat-postgresql-libs postgresql-libs postgresql-contrib</pre>
<blockquote><p>&#8211;&gt; Running transaction check<br />
&#8211;&gt; Processing Dependency: libpq.so.4 for package: perl-DBD-Pg<br />
&#8211;&gt; Finished Dependency Resolution<br />
Error: Missing Dependency: libpq.so.4 is needed by package perl-DBD-Pg</p></blockquote>
<p>エラーが出てインストール出来ない。</p>
<p><a href="http://blog.motoo.net/2009/03/13/172626">http://blog.motoo.net/2009/03/13/172626</a><br />
を見て、パッケージを削除しているので試す。</p>
<pre># yum remove perl-DBD-Pg</pre>
<p>再度インストールを試すと、どうやら成功した。</p>
<h3>データベースを初期化</h3>
<pre># service postgresql initdb</pre>
<p>/var/lib/pgsql/pgstartup.log を見てエラーが起きていないことを確認。<br />
前バージョンの古いデータがあると失敗する。</p>
<p>データディレクトリは /var/lib/pgsql/data<br />
設定ファイル /var/lib/pgsql/data/postgresql.conf</p>
<p>サービス開始</p>
<pre># service postgresql start</pre>
<p>自動起動の設定</p>
<pre># chkconfig postgresql on</pre>
<p>自動起動の確認（ランレベル2～5のonを確認）</p>
<pre># chkconfig --list postgresql
postgresql          	0:off	1:off	2:on	3:on	4:on	5:on	6:off</pre>
<p>参考：<a href="http://a98.jugem.jp/?eid=372">CentOS 5.3 に postgresql-8.4 をインストール | お試しlog4</a></p>
<p>認証方式<br />
デフォルトではパスワードによる接続は出来ない。<br />
postgresユーザー パスワードの設定<br />
/var/lib/pgsql/data/postgresql.conf<br />
/var/lib/pgsql/data/pg_hba.conf</p>
<p>参照：<a href="http://safe-linux.homeip.net/web/PostgreSQL/01-setup.html">PostgreSQL Server のセットアップ ～ CentOS-4.5</a></p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/08/17/centos4-8-%e3%81%ab-postgresql8-4-%e3%82%92yum%e3%81%a7%e3%82%a4%e3%83%b3%e3%82%b9%e3%83%88%e3%83%bc%e3%83%ab/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>DNSラウンドロビン サーバダウン等の障害時はどうなる？</title>
		<link>http://perl.no-tubo.net/2010/08/13/dns%e3%83%a9%e3%82%a6%e3%83%b3%e3%83%89%e3%83%ad%e3%83%93%e3%83%b3-%e3%82%b5%e3%83%bc%e3%83%90%e3%83%80%e3%82%a6%e3%83%b3%e7%ad%89%e3%81%ae%e9%9a%9c%e5%ae%b3%e6%99%82%e3%81%af%e3%81%a9%e3%81%86/</link>
		<comments>http://perl.no-tubo.net/2010/08/13/dns%e3%83%a9%e3%82%a6%e3%83%b3%e3%83%89%e3%83%ad%e3%83%93%e3%83%b3-%e3%82%b5%e3%83%bc%e3%83%90%e3%83%80%e3%82%a6%e3%83%b3%e7%ad%89%e3%81%ae%e9%9a%9c%e5%ae%b3%e6%99%82%e3%81%af%e3%81%a9%e3%81%86/#comments</comments>
		<pubDate>Fri, 13 Aug 2010 13:04:52 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[ネットワーク]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=749</guid>
		<description><![CDATA[DNSラウンドロビン？
DNSのAレコードに
A www 111.222.333.444
A www 555.666.777.888
と同じドメインに複数のIPアドレスを設定するとアクセスの度にローテーションしてIPアド [...]]]></description>
			<content:encoded><![CDATA[<h3>DNSラウンドロビン？</h3>
<p>DNSのAレコードに</p>
<blockquote><p>A www 111.222.333.444<br />
A www 555.666.777.888</p></blockquote>
<p>と同じドメインに複数のIPアドレスを設定するとアクセスの度にローテーションしてIPアドレスを返してくれる。<br />
これを用いて負荷分散などに利用出来る。</p>
<h3>サーバダウン時にはどうなる？</h3>
<p>古い文献によると、例えば上の例だと 111.222.333.444 のサーバがダウンしていると繋がらないとあるが、ブラウザ次第のようだ。</p>
<p>Macでの確認は</p>
<blockquote><p>Safari ok<br />
FireFox ok<br />
Google Chrome ok<br />
Opera ng</p></blockquote>
<p>他のWebサイトでもOperaはNGだと書いてあった気がする。</p>
<p>要するにDNSに問い合わせて繋がらなければ次のIPアドレスを試すような仕様になっているみたいだ。<br />
Opera以外は。</p>
<p>Operaさえ気にしなければ、ISPの回線障害に備えておくのにも使えそうな気がする。</p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/08/13/dns%e3%83%a9%e3%82%a6%e3%83%b3%e3%83%89%e3%83%ad%e3%83%93%e3%83%b3-%e3%82%b5%e3%83%bc%e3%83%90%e3%83%80%e3%82%a6%e3%83%b3%e7%ad%89%e3%81%ae%e9%9a%9c%e5%ae%b3%e6%99%82%e3%81%af%e3%81%a9%e3%81%86/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>CentOS に GD をインストール 出来なかったけど yum なら一発で出来た</title>
		<link>http://perl.no-tubo.net/2010/07/28/centos-%e3%81%ab-gd-%e3%82%92%e3%82%a4%e3%83%b3%e3%82%b9%e3%83%88%e3%83%bc%e3%83%ab-%e5%87%ba%e6%9d%a5%e3%81%aa%e3%81%8b%e3%81%a3%e3%81%9f%e3%81%91%e3%81%a9-yum-%e3%81%aa%e3%82%89%e4%b8%80%e7%99%ba/</link>
		<comments>http://perl.no-tubo.net/2010/07/28/centos-%e3%81%ab-gd-%e3%82%92%e3%82%a4%e3%83%b3%e3%82%b9%e3%83%88%e3%83%bc%e3%83%ab-%e5%87%ba%e6%9d%a5%e3%81%aa%e3%81%8b%e3%81%a3%e3%81%9f%e3%81%91%e3%81%a9-yum-%e3%81%aa%e3%82%89%e4%b8%80%e7%99%ba/#comments</comments>
		<pubDate>Wed, 28 Jul 2010 02:23:18 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[perlモジュール]]></category>
		<category><![CDATA[GD]]></category>
		<category><![CDATA[LINUX]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=710</guid>
		<description><![CDATA[GD のインストールに散々悩んだあげく、あきらめかていたけど、
http://tech.hitsug.net/?CentOS%2FPerlモジュール
このページに rpmforge レポジトリを使った yum でのインス [...]]]></description>
			<content:encoded><![CDATA[<p>GD のインストールに散々悩んだあげく、あきらめかていたけど、<br />
<a href="http://tech.hitsug.net/?CentOS%2FPerlモジュール">http://tech.hitsug.net/?CentOS%2FPerlモジュール</a><br />
このページに rpmforge レポジトリを使った yum でのインストールが載っていたので試したら一発で出来た。。。</p>
<pre>yum --enablerepo=rpmforge install perl-GD</pre>
<p>いろいろな要因があるのだろうけど。</p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/07/28/centos-%e3%81%ab-gd-%e3%82%92%e3%82%a4%e3%83%b3%e3%82%b9%e3%83%88%e3%83%bc%e3%83%ab-%e5%87%ba%e6%9d%a5%e3%81%aa%e3%81%8b%e3%81%a3%e3%81%9f%e3%81%91%e3%81%a9-yum-%e3%81%aa%e3%82%89%e4%b8%80%e7%99%ba/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>perl でメールアドレスの有効性をチェックするモジュール</title>
		<link>http://perl.no-tubo.net/2010/07/02/perl-%e3%81%a7%e3%83%a1%e3%83%bc%e3%83%ab%e3%82%a2%e3%83%89%e3%83%ac%e3%82%b9%e3%81%ae%e6%9c%89%e5%8a%b9%e6%80%a7%e3%82%92%e3%83%81%e3%82%a7%e3%83%83%e3%82%af%e3%81%99%e3%82%8b%e3%83%a2%e3%82%b8/</link>
		<comments>http://perl.no-tubo.net/2010/07/02/perl-%e3%81%a7%e3%83%a1%e3%83%bc%e3%83%ab%e3%82%a2%e3%83%89%e3%83%ac%e3%82%b9%e3%81%ae%e6%9c%89%e5%8a%b9%e6%80%a7%e3%82%92%e3%83%81%e3%82%a7%e3%83%83%e3%82%af%e3%81%99%e3%82%8b%e3%83%a2%e3%82%b8/#comments</comments>
		<pubDate>Fri, 02 Jul 2010 10:35:49 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[perlモジュール]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=673</guid>
		<description><![CDATA[Email::Valid
http://search.cpan.org/~rjbs/Email-Valid-0.184/lib/Email/Valid.pm
現在でも更新されている感じのモジュール。携帯向けに Email::Valid::Loose と言うモジュールもある（有名なMIYAGAWAさん作）通常ならばこのモジュールでいいと思う。
Mail::CheckUser
http://search.cpan.org/~ilyam/Mail-CheckUser-1.21/CheckUser.pm
Data::Dumper の作者らしい。18 Sep 2003 となっているので更新はだいぶ前。でもこのモジュールはなかなか良くて、存在ユーザーをある程度（？）調べてくれる。存在ユーザーのチェックは送信先のメールサーバの設定によって違うのかもしれない。ソースに
## gTLD Wildcard IPs
$NXDOMAIN= {&#8230;&#8230;&#8230;}
って感じでトップレベルドメイン（？）のAレコードやらCNAMEと思われるものが定義されているけど、これって更新されないのかなぁ？
で、こちらのモジュールでは携帯向けのアドレスで @ の前に . が付くもの（abc..@docomo.ne.jp など）は使えません。RFC822違反だそうです。
そこで Mail::CheckUser::Loose なるモジュールを作成・・・した訳ではないけど、リメイクして使いました。
自分の環境では /usr/lib/perl5/site_perl/5.8.5/Mail/CheckUser.pm でしたので、/usr/lib/perl5/site_perl/5.8.5/Mail/CheckUser と言うディレクトリを作り、その中に  CheckUser.pm をコピペして Loose.pm にリネーム。
その Loose.pm を数カ所変更するだけです。
7行目付近
package Mail::CheckUser;
↓ ::Loose を追記
package Mail::CheckUser::Loose;
190行目付近
sub last_check() {
    return $Mail::CheckUser::Last_Check;
}
↓ ::Loose を追記
sub last_check() {
    return $Mail::CheckUser::Loose::Last_Check;
}
214行目付近
my $STRING_RE = ('[' . quotemeta(join '',
  [...]]]></description>
			<content:encoded><![CDATA[<h4>Email::Valid</h4>
<p><a href="http://search.cpan.org/~rjbs/Email-Valid-0.184/lib/Email/Valid.pm">http://search.cpan.org/~rjbs/Email-Valid-0.184/lib/Email/Valid.pm</a></p>
<p>現在でも更新されている感じのモジュール。携帯向けに Email::Valid::Loose と言うモジュールもある（有名なMIYAGAWAさん作）通常ならばこのモジュールでいいと思う。</p>
<h4>Mail::CheckUser</h4>
<p><a href="http://search.cpan.org/~ilyam/Mail-CheckUser-1.21/CheckUser.pm">http://search.cpan.org/~ilyam/Mail-CheckUser-1.21/CheckUser.pm</a></p>
<p>Data::Dumper の作者らしい。18 Sep 2003 となっているので更新はだいぶ前。でもこのモジュールはなかなか良くて、存在ユーザーをある程度（？）調べてくれる。存在ユーザーのチェックは送信先のメールサーバの設定によって違うのかもしれない。ソースに<br />
## gTLD Wildcard IPs<br />
$NXDOMAIN= {&#8230;&#8230;&#8230;}<br />
って感じでトップレベルドメイン（？）のAレコードやらCNAMEと思われるものが定義されているけど、これって更新されないのかなぁ？</p>
<p>で、こちらのモジュールでは携帯向けのアドレスで @ の前に . が付くもの（abc..@docomo.ne.jp など）は使えません。RFC822違反だそうです。</p>
<p>そこで Mail::CheckUser::Loose なるモジュールを作成・・・した訳ではないけど、リメイクして使いました。</p>
<p>自分の環境では /usr/lib/perl5/site_perl/5.8.5/Mail/CheckUser.pm でしたので、/usr/lib/perl5/site_perl/5.8.5/Mail/CheckUser と言うディレクトリを作り、その中に  CheckUser.pm をコピペして Loose.pm にリネーム。</p>
<p>その Loose.pm を数カ所変更するだけです。</p>
<p>7行目付近</p>
<pre>package Mail::CheckUser;
↓ ::Loose を追記
package Mail::CheckUser<span style="color: #ff0000;">::Loose</span>;</pre>
<p>190行目付近</p>
<pre>sub last_check() {
    return $Mail::CheckUser::Last_Check;
}
↓ ::Loose を追記
sub last_check() {
    return $Mail::CheckUser<span style="color: #ff0000;">::Loose</span>::Last_Check;
}</pre>
<p>214行目付近</p>
<pre>my $STRING_RE = ('[' . quotemeta(join '',
                                 grep(!/[&lt;&gt;()\[\]\\<span style="color: #ff0000;">\.</span>,;:\@"]/, # ["], UnBug Emacs
                                      map chr, 33 .. 126)) . ']');
↓ <span style="color: #ff0000;">\.</span> を削除
my $STRING_RE = ('[' . quotemeta(join '',
                                 grep(!/[&lt;&gt;()\[\]\\,;:\@"]/, # ["], UnBug Emacs
                                      map chr, 33 .. 126)) . ']');</pre>
<p>244行目付近</p>
<pre>    my $resolver = $Mail::CheckUser::Net_DNS_Resolver || new Net::DNS::Resolver;
↓ ::Loose を追記
    my $resolver = $Mail::CheckUser<span style="color: #ff0000;">::Loose</span>::Net_DNS_Resolver || new Net::DNS::Resolver;</pre>
<p>スキル不足で継承とかよくわからないので（汗</p>
<pre>use Mail::CheckUser::Loose;
my $check_email='h.o.g.e.@docomo.ne.jp';

$Mail::CheckUser::Loose::Timeout = 15;
$Mail::CheckUser::Loose::Treat_Timeout_As_Fail = 'true';

if(check_email($check_email)) {
    print "有効なアドレスです。";
}else {
    print "無効なアドレスです。",last_check()->{reason};
}</pre>
<p>こんな感じで使ったりしてます。</p>
<p>以下修正後の全ソース</p>
<p><span id="more-673"></span></p>
<pre># Copyright (c) 1999-2003 by Ilya Martynov. All rights
# reserved.
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

package Mail::CheckUser::Loose;

use strict;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $VERSION);

require Exporter;

@ISA = qw(Exporter);

@EXPORT_OK = qw(check_email
                last_check
                check_hostname
                check_username);
$EXPORT_TAGS{constants} = [qw(CU_OK
                              CU_BAD_SYNTAX
                              CU_UNKNOWN_DOMAIN
                              CU_DNS_TIMEOUT
                              CU_UNKNOWN_USER
                              CU_SMTP_TIMEOUT
                              CU_SMTP_UNREACHABLE
                              CU_MAILBOX_FULL)];
push @EXPORT_OK, @{$EXPORT_TAGS{constants}};

$VERSION = '1.21';

use Carp;
use Net::DNS;
use Net::SMTP;
use IO::Handle;

use vars qw($Skip_Network_Checks $Skip_SMTP_Checks
            $Skip_SYN $Net_DNS_Resolver
            $NXDOMAIN
            $Timeout $Treat_Timeout_As_Fail $Debug
            $Treat_Full_As_Fail
            $Sender_Addr $Helo_Domain $Last_Check);

# if it is true Mail::CheckUser doesn't make network checks
$Skip_Network_Checks = 0;
# if it is true Mail::CheckUser doesn't try to connect to mail
# server to check if user is valid
$Skip_SMTP_Checks = 0;
# timeout in seconds for network checks
$Timeout = 60;
# if it is true the Net::Ping SYN/ACK check will be skipped
$Skip_SYN = 0;
# if it is true Mail::CheckUser treats timeouted checks as
# failed checks
$Treat_Timeout_As_Fail = 0;
# if it is true Mail::CheckUser treats mailbox full message
# as failed checks
$Treat_Full_As_Fail = 0;
# sender addr used in MAIL/RCPT check
$Sender_Addr = 'check@user.com';
# sender domain used in HELO SMTP command - if undef lets
# Net::SMTP use its default value
$Helo_Domain = undef;
# Default Net::DNS::Resolver override object
$Net_DNS_Resolver = undef;
# if true then enable debug mode
$Debug = 0;
# Wildcard gTLD always denote bogus domains
# (http://www.imperialviolet.org/dnsfix.html)
## gTLD Wildcard IPs
$NXDOMAIN = {
  # com/net
  "64.94.110.11"     =&gt; 1, # A

  # ac
  "194.205.62.122"   =&gt; 1, # A

  # cc
  "206.253.214.102"  =&gt; 1, # A
  "snubby.enic.cc"   =&gt; 1, # MX
  "206.191.159.103"  =&gt; 1, # MX

  # cx
  "219.88.106.80"    =&gt; 1, # A
  "mail.nonregistered.nic.cx" =&gt; 1, # MX

  # mp
  "202.128.12.163"   =&gt; 1, # A

  # museum
  "195.7.77.20"      =&gt; 1, # A

  # nu
  "64.55.105.9"      =&gt; 1, # A
  "212.181.91.6"     =&gt; 1, # A

  # ph
  "203.119.4.6"      =&gt; 1, # A

  # pw
  "216.98.141.250"   =&gt; 1, # A
  "65.125.231.178"   =&gt; 1, # A
  "wfb.dnsvr.com"    =&gt; 1, # CNAME

  # sh
  "194.205.62.62"    =&gt; 1, # A

  # td
  "146.101.245.154"  =&gt; 1, # A
  "www.nic.td"       =&gt; 1, # CNAME

  # tk
  "195.20.32.83"     =&gt; 1, # A
  "195.20.32.86"     =&gt; 1, # A
  "nukumatau.taloha.com" =&gt; 1, # MX
  "195.20.32.99"     =&gt; 1, # MX

  # tm
  "194.205.62.42"    =&gt; 1, # A

  # tw
  "203.73.24.11"     =&gt; 1, # A

  # ws
  "216.35.187.246"   =&gt; 1, # A
  "mail.worldsite.ws" =&gt; 1, # MX
  "216.35.187.251"   =&gt; 1, # MX

};

# check_email EMAIL
sub check_email( $ );
# last_check
sub last_check( );
# check_hostname_syntax HOSTNAME
sub check_hostname_syntax( $ );
# check_username_syntax USERNAME
sub check_username_syntax( $ );
# check_network HOSTNAME, USERNAME
sub check_network( $$ );
# check_user_on_host MSERVER, USERNAME, HOSTNAME, TIMEOUT
sub check_user_on_host( $$$$ );
# _calc_timeout FULL_TIMEOUT START_TIME
sub _calc_timeout( $$ );
# _pm_log LOG_STR
sub _pm_log( $ );
# _result RESULT, REASON
sub _result( $$ );

# check result codes
use constant CU_OK               =&gt; 0;
use constant CU_BAD_SYNTAX       =&gt; 1;
use constant CU_UNKNOWN_DOMAIN   =&gt; 2;
use constant CU_DNS_TIMEOUT      =&gt; 3;
use constant CU_UNKNOWN_USER     =&gt; 4;
use constant CU_SMTP_TIMEOUT     =&gt; 5;
use constant CU_SMTP_UNREACHABLE =&gt; 6;
use constant CU_MAILBOX_FULL     =&gt; 7;

sub check_email($) {
    my($email) = @_;

    unless(defined $email) {
        croak __PACKAGE__ . "::check_email: \$email is undefined";
    }

    _pm_log '=' x 40;
    _pm_log "check_email: checking \"$email\"";

    # split email address on username and hostname
    my($username, $hostname) = $email =~ /^(.*)@(.*)$/;
    # return false if it impossible
    unless(defined $hostname) {
        return _result(CU_BAD_SYNTAX, 'bad address format: missing @');
    }

    my $ok = 1;
    $ok &amp;&amp;= check_hostname_syntax $hostname;
    $ok &amp;&amp;= check_username_syntax $username;
    if($Skip_Network_Checks) {
        _pm_log "check_email: skipping network checks";
    } elsif ($ok) {
        $ok &amp;&amp;= check_network $hostname, $username;
    }

    return $ok;
}

sub last_check() {
    return $Mail::CheckUser::Loose::Last_Check;
}

# build hostname regexp
# NOTE: it doesn't strictly follow RFC822
# because of what registrars now allow.
my $DOMAIN_RE   = qr/(?:[\da-zA-Z]+ -+)* [\da-zA-Z]+/x;
my $HOSTNAME_RE = qr/^ (?:$DOMAIN_RE \.)+ [a-zA-Z]+ $/xo;

sub check_hostname_syntax($) {
    my($hostname) = @_;

    _pm_log "check_hostname_syntax: checking \"$hostname\"";

    # check if hostname syntax is correct
    if($hostname =~ $HOSTNAME_RE) {
        return _result(CU_OK, 'correct hostname syntax');
    } else {
        return _result(CU_BAD_SYNTAX, 'bad hostname syntax');
    }
}

# build username regexp
# NOTE: it doesn't strictly follow RFC821
my $STRING_RE = ('[' . quotemeta(join '',
                                 grep(!/[&lt;&gt;()\[\]\\,;:\@"]/, # ["], UnBug Emacs
                                      map chr, 33 .. 126)) . ']');
my $USERNAME_RE = qr/^ (?:$STRING_RE+ \.)* $STRING_RE+ $/xo;

sub check_username_syntax($) {
    my($username) = @_;

    _pm_log "check_username_syntax: checking \"$username\"";

    # check if username syntax is correct
    if($username =~ $USERNAME_RE) {
        return _result(CU_OK, 'correct username syntax');
    } else {
        return _result(CU_BAD_SYNTAX, 'bad username syntax');
    }
}

sub check_network($$) {
    my($hostname, $username) = @_;

    _pm_log "check_network: checking \"$username\" on \"$hostname\"";

    # list of mail servers for hostname
    my @mservers = ();

    my $timeout = $Timeout;
    my $start_time = time;

    my $resolver = $Mail::CheckUser::Loose::Net_DNS_Resolver || new Net::DNS::Resolver;
    my $tout = _calc_timeout($timeout, $start_time);
    return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0;
    $resolver-&gt;udp_timeout($tout);

    my @mx = mx($resolver, "$hostname.");
    $tout = _calc_timeout($timeout, $start_time);
    return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0;

    # check result of query
    if(@mx) {
        # if MX record exists,
        # then it's already sorted by preference
        @mservers = map {$_-&gt;exchange} @mx;
    } else {
        # if there is no MX record try hostname as mail server
        my $tout = _calc_timeout($timeout, $start_time);
        return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0;
        $resolver-&gt;udp_timeout($tout);

        my $res = $resolver-&gt;search("$hostname.", 'A');
        # check if timeout has happen
        $tout = _calc_timeout($timeout, $start_time);
        return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0;

        # check result of query
        if($res) {
            @mservers = ($hostname);
            my $ip;
            foreach my $rr ($res-&gt;answer) {
              if ($rr-&gt;type eq "A") {
                $ip = $rr-&gt;address;
                last;
              } elsif ($rr-&gt;type eq "CNAME") {
                $ip = $rr-&gt;cname;
              } else {
                # Should never happen!
                $ip = "";
              }
            }
            _pm_log "check_network: \"$ip\" Wildcard gTLD check";
            return _result(CU_UNKNOWN_DOMAIN, 'Wildcard gTLD') if $NXDOMAIN-&gt;{lc $ip};
        } else {
            return _result(CU_UNKNOWN_DOMAIN, 'DNS failure: ' . $resolver-&gt;errorstring);
        }
    }

    foreach my $mserver (@mservers) {
        _pm_log "check_network: \"$mserver\" Wildcard gTLD check";
        return _result(CU_UNKNOWN_DOMAIN, 'Wildcard gTLD') if $NXDOMAIN-&gt;{lc $mserver};
    }

    if($Skip_SMTP_Checks) {
        return _result(CU_OK, 'skipping SMTP checks');
    } else {
        if ($Skip_SYN) {
            # Skip SYN/ACK check.
            # Just check user on each mail server one at a time.
            foreach my $mserver (@mservers) {
                my $tout = _calc_timeout($timeout, $start_time);
                if ($mserver !~ /^\d+\.\d+\.\d+\.\d+$/) {
                    # Resolve it to an IP
                    return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0;
                    $resolver-&gt;udp_timeout($tout);
                    if (my $ans = $resolver-&gt;query($mserver)) {
                        foreach my $rr_a ($ans-&gt;answer) {
                            if ($rr_a-&gt;type eq "A") {
                                $mserver = $rr_a-&gt;address;
                                last;
                            }
                        }
                    }
                    $tout = _calc_timeout($timeout, $start_time);
                }
                return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0;

                my $res = check_user_on_host $mserver, $username, $hostname, $tout;

                return 1 if $res == 1;
                return 0 if $res == 0;
            }
        } else {
            # Determine which mail servers are on
            my $resolve = {};
            my $tout = _calc_timeout($timeout, $start_time);
            foreach my $mserver (@mservers) {
                # All mservers need to be resolved to IPs before the SYN check
                if ($mserver =~ /^\d+\.\d+\.\d+\.\d+$/) {
                    $resolve-&gt;{$mserver} = 1;
                } else {
                    _pm_log "check_network: \"$mserver\" resolving";
                    return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0;
                    $resolver-&gt;udp_timeout($tout);
                    if (my $ans = $resolver-&gt;query($mserver)) {
                        foreach my $rr_a ($ans-&gt;answer) {
                            if ($rr_a-&gt;type eq "A") {
                                $mserver = $rr_a-&gt;address;
                                $resolve-&gt;{$mserver} = 1;
                                _pm_log "check_network: resolved to IP \"$mserver\"";
                                last;
                            }
                        }
                    } else {
                        _pm_log "check_network: \"$mserver\" host not found!";
                    }
                    $tout = _calc_timeout($timeout, $start_time);
                }
            }

            require Net::Ping;
            import Net::Ping 2.24;
            # Use only three-fourths of the full timeout for lookups
            # in order to leave time to actually speak to the server.
            my $ping = Net::Ping-&gt;new("syn", _calc_timeout($timeout, $start_time) * 3 / 4 + 1);
            $ping-&gt;{port_num} = getservbyname("smtp", "tcp");
            $ping-&gt;tcp_service_check(1);
            foreach my $mserver (@mservers) {
                _pm_log "check_network: \"$mserver\" sending SYN...";
                # untaint before passing to Net::Ping
                my ($tainted) = $mserver =~ /(\d+\.\d+\.\d+\.\d+)/;
                if ($tainted and $tainted eq $mserver and
                    $resolve-&gt;{$tainted} and $ping-&gt;ping($tainted)) {
                    _pm_log "check_network: \"$tainted\" SYN packet sent.";
                } else {
                    _pm_log "check_network: \"$mserver\" host not found!";
                }
            }
            foreach my $mserver (@mservers) {
                my $tout = _calc_timeout($timeout, $start_time);
                return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0;

                _pm_log "check_network: \"$mserver\" waiting for ACK";
                if ($resolve-&gt;{$mserver}) {
                    # untaint before passing to Net::Ping
                    my($mserver) = $mserver =~ /(\d+\.\d+\.\d+\.\d+)/;
                    if ($ping-&gt;ack($mserver)) {
                        _pm_log "check_network: \"$mserver\" ACK received.";
                        # check user on this mail server
                        my $res = check_user_on_host $mserver, $username, $hostname, $tout;

                        return 1 if $res == 1;
                        return 0 if $res == 0;
                    } else {
                        _pm_log "check_network: \"$mserver\" no ACK received: [".
                            ($ping-&gt;nack($mserver) || "no SYN sent")."]";
                    }
                } else {
                    _pm_log "check_network: skipping check_user_on_host \"$mserver\" since it did not resolve";
                }
            }
        }

        return _result(CU_SMTP_UNREACHABLE,
                       'Cannot connect SMTP servers: ' .
                       join(', ', @mservers));
    }

    # it should be impossible to reach this statement
    die "Internal error";
}

sub check_user_on_host($$$$) {
    my($mserver, $username, $hostname, $timeout) = @_;

    _pm_log "check_user_on_host: checking user \"$username\" on \"$mserver\"";

    my $start_time = time;

    # disable warnings because Net::SMTP can generate some on timeout
    # conditions
    local $^W = 0;

    # try to connect to mail server
    my $tout = _calc_timeout($timeout, $start_time);
    return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0;

    my @hello_params = defined $Helo_Domain ? (Hello =&gt; $Helo_Domain) : ();
    my $smtp = Net::SMTP-&gt;new($mserver, Timeout =&gt; $tout, @hello_params);
    unless(defined $smtp) {
        _pm_log "check_user_on_host: unable to connect to \"$mserver\"";
        return -1;
    }

    # try to check if user is valid with MAIL/RCPT commands
    $tout = _calc_timeout($timeout, $start_time);
    return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0;
    $smtp-&gt;timeout($tout);

    # send MAIL FROM command
    unless($smtp-&gt;mail($Sender_Addr)) {
        # something wrong?

        # check for timeout
        return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0;

        _pm_log "check_user_on_host: can't say MAIL - " . $smtp-&gt;message;
        return -1;
    }

    # send RCPT TO command
    if($smtp-&gt;to("$username\@$hostname")) {
        # give server opportunity to exist gracefully by telling it QUIT
        my $tout = _calc_timeout($timeout, $start_time);
        if($tout) {
            $smtp-&gt;timeout($tout);
            $smtp-&gt;quit;
        }

        return _result(CU_OK, 'SMTP server accepts username');
    } else {
        # check if verify returned error because of timeout
        my $tout = _calc_timeout($timeout, $start_time);
        return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0;

        my $code = $smtp-&gt;code;

        # give server opportunity to exist gracefully by telling it QUIT
        $smtp-&gt;timeout($tout);
        $smtp-&gt;quit;

        if($code == 550 or $code == 551 or $code == 553) {
            return _result(CU_UNKNOWN_USER, 'no such user');
        } elsif($code == 552) {
            return _result(CU_MAILBOX_FULL, 'mailbox full');
        } else {
            _pm_log "check_user_on_host: unknown error in response";
            return _result(CU_OK, 'unknown error in response');
        }
    }

    # it should be impossible to reach this statement
    die "Internal error";
}

sub _calc_timeout($$) {
    my($full_timeout, $start_time) = @_;

    my $now_time = time;
    my $passed_time = $now_time - $start_time;
    _pm_log "_calc_timeout: start - $start_time, now - $now_time";
    _pm_log "_calc_timeout: timeout - $full_timeout, passed - $passed_time";

    my $timeout = $full_timeout - $passed_time;

    if($timeout &lt; 0) {         return 0;     } else {         return $timeout;     } } sub _pm_log($) {     my($log_str) = @_;     if($Debug) {         print STDERR "$log_str\n";     } } sub _result($$) {     my($code, $reason) = @_;     my $ok = 0;     $ok = 1 if $code == CU_OK;     $ok = 1 if $code == CU_SMTP_UNREACHABLE;     $ok = 1 if $code == CU_MAILBOX_FULL and not $Treat_Full_As_Fail;     $ok = 1 if $code == CU_DNS_TIMEOUT and not $Treat_Timeout_As_Fail;     $ok = 1 if $code == CU_SMTP_TIMEOUT and not $Treat_Timeout_As_Fail;     $Last_Check = { ok     =&gt; $ok,
                    code   =&gt; $code,
                    reason =&gt; $reason };

    my($sub) = (caller(1))[3] =~ /^.*::(.*)$/;

    _pm_log "$sub: check result is " .
            ($ok ? 'ok' : 'not ok') .
            ": [$code] $reason";

    return $ok;
}

1;
__END__

=head1 NAME

Mail::CheckUser - check email addresses for validity

=head1 SYNOPSIS

    use Mail::CheckUser qw(check_email);
    my $ok = check_email($email_addr);

    use Mail::CheckUser qw(:constants check_email last_check)
    my $ok = check_email($email_addr);
    print "DNS timeout\n"
        if last_check()-&gt;{code} == CU_DNS_TIMEOUT;

    use Mail::CheckUser;
    my $res = Mail::CheckUser::check_email($email_addr);

=head1 DESCRIPTION

This Perl module provides routines for checking validity of email address.

It makes several checks:

=over 4

=item 1

It checks the syntax of an email address.

=item 2

It checks if there any MX records or A records for the domain part
of the email address.

=item 3

It tries to connect to an email server directly via SMTP to check if
mailbox is valid.  Old versions of this module performed this check
via the VRFY command.  Now the module uses another check; it uses a
combination of MAIL and RCPT commands which simulates sending an
email.  It can detect bad mailboxes in many cases.

=back

If is possible to turn off some or all networking checks (items 2 and 3).
See L&lt;"GLOBAL VARIABLES"&gt;.

This module was designed with CGIs (or any other dynamic Web content
programmed with Perl) in mind.  Usually it is required to quickly
check e-mail addresses in forms.  If the check can't be finished in
reasonable time, the e-mail address should be treated as valid.  This
is the default policy.  By default if a timeout happens the result of
the check is treated as positive.  This behavior can be overridden -
see L&lt;"GLOBAL VARIABLES"&gt;.

=head1 IMPORTANT WARNING

In many cases there is no way to detect the validity of email
addresses with network checks.  For example, non-monolithic mail
servers (such as Postfix and qmail) often report that a user exists
even if it is not so.  This is because in cases where the work of the
server is split among many components, the SMTP server may not know
how to check for the existence of a particular user.  Systems like
these will reject mail to unknown users, but they do so after the SMTP
conversation.  In cases like these, the only absolutely sure way to
determine whether or not a user exists is to actually send a mail and
wait to see if a bounce messages comes back.  Obviously, this is not a
workable strategy for this module.  Does it mean that the network
checks in this module are useless?  No.  For one thing, just the DNS
checks go a long way towards weeding out mistyped domain parts.  Also,
there are still many SMTP servers that will reject a bad address
during the SMTP conversation.  Because of this, it's still a useful
part of checking for a valid email address.  And this module was
designed such that if there is exists possibility (however small) that
the email address is valid, it will be treated as valid by this
module.

Another warning is about C&lt;$Mail::CheckUser::Treat_Timeout_As_Fail&gt;
global variable.  Use it carefully - if it is set to true then some
valid email addresses can be treated as bad simply because an SMTP or
DNS server responds slowly.

Another warning is about C&lt;$Mail::CheckUser::Treat_Full_As_Fail&gt;
global variable.  Use it carefully - if it is set to true then some
valid email addresses can be treated as bad simply because their
mailbox happens to be temporarily full.

=head1 EXAMPLE

This simple script checks if email address C is
valid.

    use Mail::CheckUser qw(check_email last_check);

    my $email = 'blabla@foo.bar';

    if(check_email($email)) {
        print "E-mail address &lt;$email&gt; is OK\n";
    } else {
        print "E-mail address &lt;$email&gt; isn't valid: ",
              last_check()-&gt;{reason}, "\n";
    }

=head1 SUBROUTINES

=over 4

=item $ok = check_email($email)

Validates email address C&lt;$email&gt;.  Return true if email address is
valid and false otherwise.

=item $res = last_check()

Returns detailed result of last check made with C as hash
reference:

    { ok =&gt; OK, code =&gt; CODE, reason =&gt; REASON }

=over 4

=item OK

True if last checked email address is valid.  False otherwise.

=item CODE

A number which describes result of last check.  See L&lt;"CONSTANTS"&gt;.

=item REASON

A string which describes result of last check.

=back

=back

=head1 CONSTANTS

Constants used by C to describe result of last check can
be exported with

    use Mail::CheckUser qw(:constants)

List of all defined constants:

=over 4

=item CU_OK

Check is successful.

=item CU_BAD_SYNTAX

Bad syntax of email address.

=item CU_UNKNOWN_DOMAIN

Mail domain mentioned in email address is unknown.

=item CU_DNS_TIMEOUT

Timeout has happen during DNS checks.

=item CU_UNKNOWN_USER

User is unknown on SMTP server.

=item CU_SMTP_TIMEOUT

Timeout has happen during SMTP checks.

=item CU_SMTP_UNREACHABLE

All SMTP servers for mail domain were found unreachable during SMTP
checks.

=item CU_MAILBOX_FULL

Mailbox is temporarily full but probably a valid username.

=back

=head1 GLOBAL VARIABLES

It is possible to configure C using the global variables listed
below.

=over 4

=item $Mail::CheckUser::Skip_Network_Checks

If true then do only syntax checks.  By default it is false.

=item $Mail::CheckUser::Skip_SMTP_Checks

If it is true then do not try to connect to mail server to check if a
user exists.  If this is true, and
C&lt;$Mail::CheckUser::Skip_Network_Checks&gt; is false, only syntax and DNS
checks are performed.  By default it is false.

=item $Mail::CheckUser::Skip_SYN

By default L is used to determine remote
reachability of SMTP servers before doing SMTP checks.
Setting this to true skips this check.  By default it is false.

=item $Mail::CheckUser::Sender_Addr

MAIL/RCPT check needs an email address to use as the 'From' address
when performing its checks.  The default value is C.

=item $Mail::CheckUser::Helo_Domain

Sender domain used in HELO SMTP command.  If undef
L is allowed to use its default value.  By
default it is undef.

=item Mail::CheckUser::Timeout

Timeout in seconds for network checks.  By default it is C&lt;60&gt;.

=item $Mail::CheckUser::Treat_Timeout_As_Fail

If it is true C treats checks that time out as
failed.  By default it is false.

=item $Mail::CheckUser::Treat_Full_As_Fail

If it is true C treats error "552 mailbox full"
as an invalid email and sets CU_MAILBOX_FULL.
By default it is false.

=item $Mail::CheckUser::Net_DNS_Resolver

Override with customized Net::DNS::Resolver object.
This is used to lookup MX and A records for the
email domain when network checks are enabled.
If undef, Net::DNS::Resolver-&gt;new will be used.
The default value is undef.

=item $Mail::CheckUser::Debug

If it is true then enable debug output on C.  By default it is
false.

=back

=head1 AUTHORS

Ilya Martynov B

Rob Brown B

Module maintained at Source Forge (
http://sourceforge.net/projects/mail-checkuser/
).

=head1 COPYRIGHT

Copyright (c) 1999-2003 by Ilya Martynov.  All rights
reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

$Id: CheckUser.pm,v 1.46 2003/09/18 23:51:36 hookbot Exp $

=head1 SEE ALSO

perl(1).

=cut</pre>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/07/02/perl-%e3%81%a7%e3%83%a1%e3%83%bc%e3%83%ab%e3%82%a2%e3%83%89%e3%83%ac%e3%82%b9%e3%81%ae%e6%9c%89%e5%8a%b9%e6%80%a7%e3%82%92%e3%83%81%e3%82%a7%e3%83%83%e3%82%af%e3%81%99%e3%82%8b%e3%83%a2%e3%82%b8/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>Javascript でブラウザ判定 IE 6,7,8 と その他のブラウザ</title>
		<link>http://perl.no-tubo.net/2010/07/01/javascript-%e3%81%a7%e3%83%96%e3%83%a9%e3%82%a6%e3%82%b6%e5%88%a4%e5%ae%9a-ie-678-%e3%81%a8-%e3%81%9d%e3%81%ae%e4%bb%96%e3%81%ae%e3%83%96%e3%83%a9%e3%82%a6%e3%82%b6/</link>
		<comments>http://perl.no-tubo.net/2010/07/01/javascript-%e3%81%a7%e3%83%96%e3%83%a9%e3%82%a6%e3%82%b6%e5%88%a4%e5%ae%9a-ie-678-%e3%81%a8-%e3%81%9d%e3%81%ae%e4%bb%96%e3%81%ae%e3%83%96%e3%83%a9%e3%82%a6%e3%82%b6/#comments</comments>
		<pubDate>Thu, 01 Jul 2010 12:55:29 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[JavaScript]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=659</guid>
		<description><![CDATA[IEの6,7,8を判別するJavascript
JavaScriptでIEかどうかをたったの1行で判別する方法
この両者のスクリプトを合わせてみた。
ライブラリを使いたくない（or使えない）状況で役に立つかも。
ちなみに [...]]]></description>
			<content:encoded><![CDATA[<p><a href="http://blog.photosynthesic.jp/2010/01/ie678javascript/">IEの6,7,8を判別するJavascript</a><br />
<a href="http://phpspot.org/blog/archives/2007/04/javascriptie1.html">JavaScriptでIEかどうかをたったの1行で判別する方法</a></p>
<p>この両者のスクリプトを合わせてみた。<br />
ライブラリを使いたくない（or使えない）状況で役に立つかも。<br />
ちなみに「IEの6,7,8を判別するJavascript」のコードは間違っていたので少々修正。</p>
<pre>if (typeof document.body.style.maxHeight != "undefined") {
    if (!/*@cc_on!@*/false){
        // Not IE.
        alert('Not IE.');
    }else if (document.documentMode &gt;=8) {
        // IE8
        alert('IE8');
    }else {
        //IE7, IE8（IE7 mode)
        alert('IE7, IE8（IE7 mode)');
    }
} else {
    // IE6, older browsers
    alert(' IE6, older browsers');
}</pre>
<p>Windows XP の IE8、IE7、FireFox、Chromeで確認OK.<br />
Mac の Safari、FireFox、Opera、Chrome でもOK.</p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/07/01/javascript-%e3%81%a7%e3%83%96%e3%83%a9%e3%82%a6%e3%82%b6%e5%88%a4%e5%ae%9a-ie-678-%e3%81%a8-%e3%81%9d%e3%81%ae%e4%bb%96%e3%81%ae%e3%83%96%e3%83%a9%e3%82%a6%e3%82%b6/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>IE における setAttribute() や getAttribute() や removeAttribute() がだめだめな件</title>
		<link>http://perl.no-tubo.net/2010/07/01/ie-%e3%81%ab%e3%81%8a%e3%81%91%e3%82%8b-setattribute-%e3%82%84-getattribute-%e3%82%84-removeattribute-%e3%81%8c%e3%81%a0%e3%82%81%e3%81%a0%e3%82%81%e3%81%aa%e4%bb%b6/</link>
		<comments>http://perl.no-tubo.net/2010/07/01/ie-%e3%81%ab%e3%81%8a%e3%81%91%e3%82%8b-setattribute-%e3%82%84-getattribute-%e3%82%84-removeattribute-%e3%81%8c%e3%81%a0%e3%82%81%e3%81%a0%e3%82%81%e3%81%aa%e4%bb%b6/#comments</comments>
		<pubDate>Thu, 01 Jul 2010 12:01:19 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[JavaScript]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=641</guid>
		<description><![CDATA[相変わらずクソな実装のIE。
他のブラウザで全部動くのにIE 7.0 以下の挙動はホントにクソ。
先人の方々に感謝感激雨あられですわ。
IEでのgetAttribute,setAttributeのバグ

// NG
el [...]]]></description>
			<content:encoded><![CDATA[<p>相変わらずクソな実装のIE。<br />
他のブラウザで全部動くのにIE 7.0 以下の挙動はホントにクソ。<br />
先人の方々に感謝感激雨あられですわ。</p>
<p><a href="http://javascript-memo.seesaa.net/article/26138927.html">IEでのgetAttribute,setAttributeのバグ</a></p>
<blockquote>
<pre>// NG
element.getAttribute("class");
element.setAttribute("style", "background-color: #fff; color: #000;");
element.setAttribute("onclick", "clickHandler(event);");

// OK
element.getAttribute("className");
element.style.cssText = "background-color: #fff; color: #000;";
element.setAttribute("onclick", new Function("clickHandler(event);"));</pre>
</blockquote>
<p><a href="http://nakawake.net/blog/web/javascript/iesetattributeremoveattribute.php">IEでsetAttribute()とremoveAttribute()がうまく動かない問題 (ウップス!!なかわけ)</a></p>
<blockquote>
<pre>しかも、かなり重要なことを発見しました。

属性名を小文字で書かないとうまく動かない！！（IE7で確認）

setAttribute("<span style="color: #ff6600;">onClick</span>", new Function(""));

ではダメなのです。うまく処理されません。

setAttribute("<span style="color: #ff0000;">onclick</span>", new Function(""));</pre>
</blockquote>
<p>あー、これも引っかかってたわ。</p>
<p>ただし、上記の対応をすると他のブラウザで動かない。IE8 でもエラーが出る。IE 7以下用に振り分けないとダメなのか。。。</p>
<p>まぁ、そろそろIE7以下は捨ててもいいよ・・・ね？</p>
<h3>結局</h3>
<p>ベタにHTMLを document.write() で書けばいい訳で・・。<br />
クロスブラウザにするには手間ががかかる・・。</p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/07/01/ie-%e3%81%ab%e3%81%8a%e3%81%91%e3%82%8b-setattribute-%e3%82%84-getattribute-%e3%82%84-removeattribute-%e3%81%8c%e3%81%a0%e3%82%81%e3%81%a0%e3%82%81%e3%81%aa%e4%bb%b6/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>perl の配列処理で 標準モジュール List::Util を使う理由</title>
		<link>http://perl.no-tubo.net/2010/07/01/perl-%e3%81%ae%e9%85%8d%e5%88%97%e5%87%a6%e7%90%86%e3%81%a7-%e6%a8%99%e6%ba%96%e3%83%a2%e3%82%b8%e3%83%a5%e3%83%bc%e3%83%ab-listutil-%e3%82%92%e4%bd%bf%e3%81%86%e7%90%86%e7%94%b1/</link>
		<comments>http://perl.no-tubo.net/2010/07/01/perl-%e3%81%ae%e9%85%8d%e5%88%97%e5%87%a6%e7%90%86%e3%81%a7-%e6%a8%99%e6%ba%96%e3%83%a2%e3%82%b8%e3%83%a5%e3%83%bc%e3%83%ab-listutil-%e3%82%92%e4%bd%bf%e3%81%86%e7%90%86%e7%94%b1/#comments</comments>
		<pubDate>Thu, 01 Jul 2010 01:42:58 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[perl]]></category>
		<category><![CDATA[perlモジュール]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=635</guid>
		<description><![CDATA[以前に配列をシャッフルの記事（ http://perl.no-tubo.net/2010/01/08/pelrで配列をシャッフル/ ）を書いたのだけれど、その時にコメントで List::Util を使いましょうよ、と頂い [...]]]></description>
			<content:encoded><![CDATA[<p>以前に配列をシャッフルの記事（ <a href="http://perl.no-tubo.net/2010/01/08/pelrで配列をシャッフル/">http://perl.no-tubo.net/2010/01/08/pelrで配列をシャッフル/</a> ）を書いたのだけれど、その時にコメントで List::Util を使いましょうよ、と頂いた。</p>
<p>そういうものもあるのか、と思っていたのだけれど理由があったので軽く調べてみた。</p>
<p>perl を書く時には配列処理と言うのはよく使うので、メモとしてエントリー。</p>
<h3>配列処理をするモジュール List::Util</h3>
<p>配列処理に置いて同じような処理は自前で書いても書けない事は無い。ただし、コアモジュール List::Util は C（XS） で実装されている（？）ので多量の処理になるほど実行速度に差が出る。</p>
<p>ベンチマークをとって比較しているエントリー<br />
<a href="http://pub.ne.jp/wakapon/?entry_id=1872792">配列のしゃほぅ！のベンチマーク</a></p>
<p>上記エントリーにはシャッフルのベンチマークのみだけど、きっと他の処理でも違いがあるのだろう。</p>
<h3>もっとたくさんの処理を使える List::MoreUtils</h3>
<p>List::MoreUtils を使うとさらに多くの配列処理を使用出来る。<br />
簡単なリファレンス<br />
<a href="http://d.hatena.ne.jp/minesouta/20070917/p1">List::MoreUtils &#8211; List::Utilに含まれない関数群 &#8211; あじゃぱー</a></p>
<p>インストールに関して注意点があるようです。<br />
<a href="http://yellowstore.blogspot.com/2009/07/perllist-moreutils-024perl588.html">YellowStore: [Perl]List-MoreUtils-0.24はPerl5.8.8以前には入らない</a></p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/07/01/perl-%e3%81%ae%e9%85%8d%e5%88%97%e5%87%a6%e7%90%86%e3%81%a7-%e6%a8%99%e6%ba%96%e3%83%a2%e3%82%b8%e3%83%a5%e3%83%bc%e3%83%ab-listutil-%e3%82%92%e4%bd%bf%e3%81%86%e7%90%86%e7%94%b1/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>Perl の環境変数 $ENV{PATH} の初期値はどこを参照しているのか？</title>
		<link>http://perl.no-tubo.net/2010/06/30/perl-%e3%81%ae%e7%92%b0%e5%a2%83%e5%a4%89%e6%95%b0-envpath-%e3%81%ae%e5%88%9d%e6%9c%9f%e5%80%a4%e3%81%af%e3%81%a9%e3%81%93%e3%82%92%e5%8f%82%e7%85%a7%e3%81%97%e3%81%a6%e3%81%84%e3%82%8b%e3%81%ae/</link>
		<comments>http://perl.no-tubo.net/2010/06/30/perl-%e3%81%ae%e7%92%b0%e5%a2%83%e5%a4%89%e6%95%b0-envpath-%e3%81%ae%e5%88%9d%e6%9c%9f%e5%80%a4%e3%81%af%e3%81%a9%e3%81%93%e3%82%92%e5%8f%82%e7%85%a7%e3%81%97%e3%81%a6%e3%81%84%e3%82%8b%e3%81%ae/#comments</comments>
		<pubDate>Wed, 30 Jun 2010 04:08:37 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[Apache]]></category>
		<category><![CDATA[CentOS4.x]]></category>
		<category><![CDATA[CentOS5.x]]></category>
		<category><![CDATA[perl]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=628</guid>
		<description><![CDATA[Perl の $ENV{PATH} は何処を参照しているのか？
例えば bayon を perl から使うのに Text::Bayon モジュールを利用したら
sh: bayon: command not found
と [...]]]></description>
			<content:encoded><![CDATA[<h3>Perl の $ENV{PATH} は何処を参照しているのか？</h3>
<p>例えば bayon を perl から使うのに Text::Bayon モジュールを利用したら<br />
sh: bayon: command not found<br />
と言うエラーログが残る。</p>
<p>コマンドが見つからない = パスが通っていない、と言う事なんだろうけど、apache を2.2 にしたらパスが変わったのか apache2.0 の時に使えた Lingua::JA::Summarize を使用するスクリプトも</p>
<p>sh: mecab: command not found</p>
<p>となる。</p>
<p>mecab も bayon も /usr/local/bin にインストールしてあるのだけれど、$ENV{PATH} を調べてみると、<br />
$ENV{PATH} = /sbin:/usr/sbin:/bin:/usr/bin<br />
となっており、/usr/local/bin にはパスが通っていない。</p>
<p>この 環境変数はどこを参照しているのかまさに以下のページのような迷い方をした。</p>
<blockquote><p>apacheの起動ユーザーにPATH通しときゃいいのか？とか、httpd.confにそういう設定が？とか、もしかしてPHP.iniにそんな設定が？とか思ってたんですが、全部ハズレ。</p></blockquote>
<p><a href="http://d.hatena.ne.jp/masahi6/20090720/1248081907">Apache2の環境変数PATHを設定する &#8211; masahilog</a></p>
<p>SetEnvやPassEnvディレクティブを追加してみたり、. bash_profile を変更したり、散々いろいろ試してみたけど、上記ページのおかげでヒントが得られたのでメモ。</p>
<blockquote><p>CentOS系（というかRedhat系、だろうか）は/etc/sysconfig/httpdがそれに該当するような。探しても調べてもenvvarsの影も形も無かったけど、/etc/init.d/httpdの冒頭箇所で/etc/sysconfig/httpdがあったらそれを評価してからhttpdが起動するようになってる。なんでこんな仕様なんだろうか。</p></blockquote>
<p>追記でこのように書かれていたのだけれど、/etc/rc.d/init.d/httpd を見てみると、 /etc/sysconfig/httpd のみではなく、 /etc/rc.d/init.d/functions も参照している。</p>
<p>/etc/rc.d/init.d/functions を見ると、ビンゴでした。</p>
<pre># Set up a default search path.
PATH="/sbin:/usr/sbin:/bin:/usr/bin"
export PATH</pre>
<p>ここのパスを変更して、保存。</p>
<p>注意点としては、apache を再起動ではなく 停止してから起動する事。<br />
再起動では反映されませんでした。</p>
<p>ちなみに CentOS （4.x 5.x） での話ですので他のディストリビューションでは違うかもしれません。</p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/06/30/perl-%e3%81%ae%e7%92%b0%e5%a2%83%e5%a4%89%e6%95%b0-envpath-%e3%81%ae%e5%88%9d%e6%9c%9f%e5%80%a4%e3%81%af%e3%81%a9%e3%81%93%e3%82%92%e5%8f%82%e7%85%a7%e3%81%97%e3%81%a6%e3%81%84%e3%82%8b%e3%81%ae/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
		<item>
		<title>PHP のエラーログ Notice: Undefined variable: を Apacheのエラーログに記録しない様にする</title>
		<link>http://perl.no-tubo.net/2010/06/19/php-%e3%81%ae%e3%82%a8%e3%83%a9%e3%83%bc%e3%83%ad%e3%82%b0-notice-undefined-variable-%e3%82%92-apache%e3%81%ae%e3%82%a8%e3%83%a9%e3%83%bc%e3%83%ad%e3%82%b0%e3%81%ab%e8%a8%98%e9%8c%b2%e3%81%97/</link>
		<comments>http://perl.no-tubo.net/2010/06/19/php-%e3%81%ae%e3%82%a8%e3%83%a9%e3%83%bc%e3%83%ad%e3%82%b0-notice-undefined-variable-%e3%82%92-apache%e3%81%ae%e3%82%a8%e3%83%a9%e3%83%bc%e3%83%ad%e3%82%b0%e3%81%ab%e8%a8%98%e9%8c%b2%e3%81%97/#comments</comments>
		<pubDate>Sat, 19 Jun 2010 09:45:25 +0000</pubDate>
		<dc:creator>admin</dc:creator>
				<category><![CDATA[PHP]]></category>

		<guid isPermaLink="false">http://perl.no-tubo.net/?p=609</guid>
		<description><![CDATA[使っているPHPのプログラムで Notice: Undefined variable: というエラーログが残るのがウザすなので対策。
php.ini の error_reporting = E_ALL &#38; ~E_ [...]]]></description>
			<content:encoded><![CDATA[<p>使っているPHPのプログラムで Notice: Undefined variable: というエラーログが残るのがウザすなので対策。</p>
<p>php.ini の error_reporting = E_ALL &amp; ~E_NOTICE がコメントアウトされているので有効化する。</p>
<pre>;error_reporting = E_ALL &amp; ~E_NOTICE
↓有効化
error_reporting = E_ALL &amp; ~E_NOTICE

error_reporting  =  E_ALL
↓ コメントアウト
;error_reporting  =  E_ALL</pre>
<p>Apache を再起動して設定を有効にする。</p>
]]></content:encoded>
			<wfw:commentRss>http://perl.no-tubo.net/2010/06/19/php-%e3%81%ae%e3%82%a8%e3%83%a9%e3%83%bc%e3%83%ad%e3%82%b0-notice-undefined-variable-%e3%82%92-apache%e3%81%ae%e3%82%a8%e3%83%a9%e3%83%bc%e3%83%ad%e3%82%b0%e3%81%ab%e8%a8%98%e9%8c%b2%e3%81%97/feed/</wfw:commentRss>
		<slash:comments>0</slash:comments>
		</item>
	</channel>
</rss>
