Perl で、世界時計を作りたい。

実はタイムゾーンの計算は自力でやると非常に難しい。なぜなら、例えば米国の場合は「3月の第2週の日曜日の午前2時」ならびに「11月の第1週の日曜日の午前2時」だったりするからだ。ちなみにウィキペディア（Wikipedia）によると、
2007年からは「包括エネルギー法案」の可決により期間が約1ヶ月延び、開始日は3月の第2日曜日、終了は11月の第1日曜日となることが決まっている。なお、議会で法案が通れば、その自治体は夏時間を使用しなくてもよいため、2005年現在、ハワイ州は州全体、アリゾナ州とインディアナ州では大半の自治体で夏時間を採用していない。
ということで、2007年3月からはそれまでの4月の第1週の日曜日～10月の最終週の日曜日から制度の変更があった。 さて、Perl でタイムゾーンを得るにはどうするかというと、Time::Timezone モジュールを使う。フォーマットは Time::CTime を使ってみた。 使用するモジュール 
use Time::Timezone;
use Time::CTime;
#!/usr/bin/perl

print &getDateTime('JST');
print &getDateTime('GMT');
print &getDateTime('PST');

sub getDateTime {

    my $tz = shift;

    use Time::Timezone qw (tz_offset);
    use Time::CTime;
    return strftime("%Y/%m/%d %R", gmtime(time + tz_offset($tz)));
}

1;
実はタイムゾーンの計算は自力でやると非常に難しい。なぜなら、例えば米国の場合は「3月の第2週の日曜日の午前2時」ならびに「11月の第1週の日曜日の午前2時」だったりするからだ。ちなみにウィキペディア（Wikipedia）によると、
2007年からは「包括エネルギー法案」の可決により期間が約1ヶ月延び、開始日は3月の第2日曜日、終了は11月の第1日曜日となることが決まっている。なお、議会で法案が通れば、その自治体は夏時間を使用しなくてもよいため、2005年現在、ハワイ州は州全体、アリゾナ州とインディアナ州では大半の自治体で夏時間を採用していない。
ということで、2007年3月からはそれまでの4月の第1週の日曜日～10月の最終週の日曜日から制度の変更があった。 さて、Perl でタイムゾーンを得るにはどうするかというと、Time::Timezone モジュールを使う。フォーマットは Time::CTime を使ってみた。 使用するモジュール 
use Time::Timezone;
use Time::CTime;
#!/usr/bin/perl

print &getDateTime('JST');
print &getDateTime('GMT');
print &getDateTime('PST');

sub getDateTime {

    my $tz = shift;

    use Time::Timezone qw (tz_offset);
    use Time::CTime;
    return strftime("%Y/%m/%d %R", gmtime(time + tz_offset($tz)));
}

1;
» 「Perl で、世界時計を作りたい。」の 続きを読む
Posted on 2005-02-08 by yas |

Perl で、iモード (ケータイ) 用に全角カナを半角カナに変換したい

Unicode::Japanese を使う。つまりは SJIS に変換するが絵文字とかもこのモジュールでは考慮されている。このモジュール、モバイル用にいろいろ考えられている。こんな感じ。絵文字が入ったテキストでは、Jcode などを使うと文字化けして使いものにならない。$isiMode は、モバイルでアクセスされたときのフラグ用変数。この変数のために前もって自分で関数を書いておくこと。 使用するモジュール 
use Unicode::Japanese;

# C コンパイラが使えれば XS も利用できる
#!/usr/bin/perl

my $text = 'テスト';
my $output = print4i(¥$text);

sub print4i {

    my $str = shift;
    use Unicode::Japanese;
    $$str = Unicode::Japanese->new($$str, 'sjis-imode')->z2h->sjis_imode
    if $isiMode;
    print $$str;
}
Unicode::Japanese を使う。つまりは SJIS に変換するが絵文字とかもこのモジュールでは考慮されている。このモジュール、モバイル用にいろいろ考えられている。こんな感じ。絵文字が入ったテキストでは、Jcode などを使うと文字化けして使いものにならない。$isiMode は、モバイルでアクセスされたときのフラグ用変数。この変数のために前もって自分で関数を書いておくこと。 使用するモジュール 
use Unicode::Japanese;

# C コンパイラが使えれば XS も利用できる
#!/usr/bin/perl

my $text = 'テスト';
my $output = print4i(¥$text);

sub print4i {

    my $str = shift;
    use Unicode::Japanese;
    $$str = Unicode::Japanese->new($$str, 'sjis-imode')->z2h->sjis_imode
    if $isiMode;
    print $$str;
}
» 「Perl で、iモード (ケータイ) 用に全角カナを半角カナに変換したい」の 続きを読む
Posted on 2005-02-08 by yas |

Perl で、バイナリデータを MySQL に登録する

バイナリデータはアスキーコードのシングルクォート「'」を含んでいる可能性があり、これが SQL文 (MySQL) のリテラルを表すためにエスケープする必要が出てくる。以下のように prepare → execute というように2行に分ければ execute の中で prepare の ? を埋め込んでくれるからシングルクォートの問題は考えなくてよくなる。 使用するモジュール 
use DBI;
# 要 DBD::MySQL
#!/usr/bin/perl

use DBI;

$TABLE_NAME = 'テーブル名';
$DB = DBI->connect(...);

my $sth = $DB->prepare(qq|INSERT INTO $TABLE_NAME (
                                                   `id`,
                                                   `mimetype`,
                                                   `object`,
                                                   `created`,
                                                   `updated`
                                                  )
                                                  VALUES (?, ?, ?, ?, ?)|
                       );

$sth->execute(
              $id,
              $miemetype,
              $object,
              $NOW,
              $NOW
             );

$DB->disconnect();

1;
バイナリデータはアスキーコードのシングルクォート「'」を含んでいる可能性があり、これが SQL文 (MySQL) のリテラルを表すためにエスケープする必要が出てくる。以下のように prepare → execute というように2行に分ければ execute の中で prepare の ? を埋め込んでくれるからシングルクォートの問題は考えなくてよくなる。 使用するモジュール 
use DBI;
# 要 DBD::MySQL
#!/usr/bin/perl

use DBI;

$TABLE_NAME = 'テーブル名';
$DB = DBI->connect(...);

my $sth = $DB->prepare(qq|INSERT INTO $TABLE_NAME (
                                                   `id`,
                                                   `mimetype`,
                                                   `object`,
                                                   `created`,
                                                   `updated`
                                                  )
                                                  VALUES (?, ?, ?, ?, ?)|
                       );

$sth->execute(
              $id,
              $miemetype,
              $object,
              $NOW,
              $NOW
             );

$DB->disconnect();

1;
» 「Perl で、バイナリデータを MySQL に登録する」の 続きを読む
Posted on 2005-02-08 by yas |

Perl で、メールアドレスの自動リンクをする

以下のサブルーチン getEmails で抜き出したテキスト中のメールアドレス一覧を emailToLink が配列で受け取る。getEmails 中の　while はヘタすると無限ループに陥る可能性があるので変換対象のテキストで 50個まで抜き出すようにしている。 使用するモジュール 
なし
#!/usr/bin/perl

sub getEmails {

    my $text = shift;
    my @emails;

    my $email_regex =
      q{(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥}
    . q{¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][}
    . q{^¥¥¥¥¥x80-¥xff¥n¥015"]*)*")(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x}
    . q{80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-}
    . q{¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][^¥¥¥¥¥x80-¥xff¥n¥015"]*)*"))*@(?:[^(}
    . q{¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥0}
    . q{00-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[^¥x80-¥xff])*}
    . q{¥])(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,}
    . q{;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[}
    . q{^¥x80-¥xff])*¥]))*};

    my $i = 0;
    while($text =~ /($email_regex)/o && $i++ < 50) {
        push(@emails, $1);
        $text =~ s/$1/XXXXXXXXXX/g;
    }

    return @emails;
}

sub emailToLink {

    my $text = shift;
    my @emails = &getEmails($text);

    foreach my $email (@emails) {
        $text =~ s/$email/<a href=mailto:$email>$email<¥/>/g;
    }

    return $text;
}

1;
参考リンク：
以下のサブルーチン getEmails で抜き出したテキスト中のメールアドレス一覧を emailToLink が配列で受け取る。getEmails 中の　while はヘタすると無限ループに陥る可能性があるので変換対象のテキストで 50個まで抜き出すようにしている。 使用するモジュール 
なし
#!/usr/bin/perl

sub getEmails {

    my $text = shift;
    my @emails;

    my $email_regex =
      q{(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥}
    . q{¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][}
    . q{^¥¥¥¥¥x80-¥xff¥n¥015"]*)*")(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x}
    . q{80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|"[^¥¥¥¥¥x80-}
    . q{¥xff¥n¥015"]*(?:¥¥¥¥[^¥x80-¥xff][^¥¥¥¥¥x80-¥xff¥n¥015"]*)*"))*@(?:[^(}
    . q{¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥0}
    . q{00-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[^¥x80-¥xff])*}
    . q{¥])(?:¥.(?:[^(¥040)&lt:>@,;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff]+(?![^(¥040)&lt:>@,}
    . q{;:".¥¥¥¥¥[¥]¥000-¥037¥x80-¥xff])|¥[(?:[^¥¥¥¥¥x80-¥xff¥n¥015¥[¥]]|¥¥¥¥[}
    . q{^¥x80-¥xff])*¥]))*};

    my $i = 0;
    while($text =~ /($email_regex)/o && $i++ < 50) {
        push(@emails, $1);
        $text =~ s/$1/XXXXXXXXXX/g;
    }

    return @emails;
}

sub emailToLink {

    my $text = shift;
    my @emails = &getEmails($text);

    foreach my $email (@emails) {
        $text =~ s/$email/<a href=mailto:$email>$email<¥/>/g;
    }

    return $text;
}

1;
参考リンク：
» 「Perl で、メールアドレスの自動リンクをする」の 続きを読む
Posted on 2005-02-08 by yas |
« 先頭‹ 前…767778798081828384次 ›最終 »