Results for category "Perl"

11111011011

1
2
3
4
use strict;
use warnings
use feature qw/say/;
say 'A Heavy New Yeah!!!';

[Perl]ATNDの参加者IDをTwitterでフォローする

30分ででっち上げたのでXMLのパースとかTwitterIDの正規表現とかいろいろ問題がありますが、何となく動いたので。
ATNDのID = TwitterのIDじゃないので誤フォローもありえます。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
use strict;
use warnings;
use Net::Twitter;
use LWP::Simple;
use XML::Simple;
use URI::Escape;
 
# TwitterのID/PW
my $twitter = new Net::Twitter(
    username => 'username',
    password => 'password',
);
 
# ATNDのイベントID
my $event_id = 1;
 
my $uri = "http://api.atnd.org/events/users/?event_id=$event_id";
 
my $xml = LWP::Simple::get($uri) or die "cannot get content from $uri";
my $data = XML::Simple->new->XMLin($xml);
 
for (@{$data->{events}{event}{users}{user}}) {
    $twitter->create_friend(uri_escape_utf8 $_->{nickname}) if $_->{nickname} =~ /[A-Za-z0-9_]+/;
}

[Perl]localtimeで日本時間にならない場合の対処

Perlのlocaltime関数を使って、以下のようなコードで日本時間を出力しようとしても、何らかの原因(海外から取り寄せたサーバでタイムゾーンが違うとか)で正しく出力されない場合がある。

▼環境によってはうまく動かないコード

1
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time + 32400);

この場合、gmtime関数を使えば、必ずグリニッジ標準時を返すので以下のコードで環境に依存せずに日本時間が出力可能になる。

▼環境に依存しないコード

1
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime(time + 32400);

▼動作確認用コード

1
2
3
4
5
6
7
8
9
use strict;
use warnings;
use Perl6::Say;
 
say gmtime time;
say gmtime;
say gmtime time + 32400;
say localtime time;
say localtime;

[Perl]ドコモのiメニュー検索のキーワードを取得する

ドコモ2009夏モデルのリファラー出力記念。
ドコモのiメニューで検索した時の検索キーワードを取得します。(たぶん)
$uriの値は実際はちょっと異なります。

1
2
3
4
5
6
7
8
9
10
11
12
use strict;
use warnings;
use Perl6::Say;
use URI;
use URI::Escape;
use URI::Query;
 
my $uri = 'http://docomo.ne.jp/?key=%41%42%43';
 
my $query = URI->new($uri)->query;
my $key = (URI::Query->new($query)->hash)->{key};
say uri_unescape($key);

ドコモのドメインじゃなくてもkeyパラメータがあったらデコードしちゃいますが・・・

[Perl]新型インフルエンザの状況を調べる

職場から「新型インフルエンザの状況が第二段階(国内発生早期)またはそれ以上の段階となった場合はマスクをして来い」とお達しが出ましたが、いちいち厚生労働省のページを見に行くのがメンドくさかったのでツール作った。

2009/05/13 動かなくなってたのでlook_down(‘class’, ‘link’)をlook_down(‘class’, ‘link_icon’)に変更しました。

H1N1-Stage-Japan.pl

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
use strict;
use warnings;
use HTML::TreeBuilder;
use HTTP::Lite;
use Perl6::Say;
 
my $uri = 'http://www-bm.mhlw.go.jp/bunya/kenkou/kekkaku-kansenshou04/';
 
my $http = new HTTP::Lite;
$http->request($uri) || die $!;
my $body = $http->body;
 
my (undef, $tag) = HTML::TreeBuilder->new->parse($body)->eof->look_down('class', 'link_icon');
 
say $tag->as_text;

「第一段階(海外発生期)」とか返ってきます。