use strict; use XML::RSS; use LWP::UserAgent; use utf8; #----- 設定 ----- # はてなアンテナのRSSのURL # http://a.hatena.ne.jp/($ID)/rss my $hatena_url = 'http://a.hatena.ne.jp/kits/rss'; # RSSファイルを置くディレクトリ(末尾に/必要) my $base_local_dir = './'; # RSSファイルを置くディレクトリに該当するURL(OPMLで使用) my $base_url = 'http://www.example.com/hatena-rss/'; #---------------- my $hatena_go = 'http://a.hatena.ne.jp/go?'; my $hatena_ns = 'http://www.hatena.ne.jp/info/xmlns#'; my $last_mod = localtime; my $rss_exclude; #---------------- # RSS生成を抑止するURLチェック用の正規表現を作成 while () { last if /^(?:__END__)?$/; chomp; $rss_exclude .= '|' . quotemeta($_); } $rss_exclude =~ s/^\|//; # はてなアンテナのRSSを取得 my $ua = LWP::UserAgent->new; my $req = HTTP::Request->new(GET => $hatena_url); my $doc = $ua->request($req)->content; # RSSを解析 my $rss = XML::RSS->new; eval { $rss->parse($doc); }; #eval { $rss->parsefile('rss.rdf'); }; # RSSから必要な情報を取得 my $sites = &sites_info($rss); # 各サイトのRSSを出力 my $index = ''; my $outline = ''; foreach my $site (@$sites) { my $file = &output_rss($site); # 目次に追加 my $title = escape($site->{title}); my $link = escape($site->{link}); $index .= qq{
  • $titleの}; $index .= qq{RSS }; $index .= qq{$site->{date}}; $index .= qq{
  • \n}; # OPMLに追加 $outline .= qq{\n}; } # 目次を出力 open INDEX, '>:utf8', "${base_local_dir}index.html"; print INDEX <<__END_OF_HTML__; はてなアンテナの更新情報を元にRSSを作成

    はてなアンテナの更新情報を元にRSSを作成

    はてなアンテナにより取得された更新情報を元に、幾つかのサイトのRSSを作成しています。

    RSS一覧(OPML)

    last-modified: $last_mod

    __END_OF_HTML__ close INDEX; # OPMLを出力 open OPML, '>:utf8', "${base_local_dir}opml.xml"; print OPML <<__END_OF_OPML__; hatena-antenna-rss $outline __END_OF_OPML__ close OPML; #----- 終了 ----- ##### サブルーチン ############################################################# # サイト情報のリストを作成 sub sites_info { my $rss = shift; my @site; foreach my $site (@{$rss->{items}}) { # 除外するURLをチェック next if ($site->{link} =~ /$rss_exclude/o); # descriptionの調整 my $item_desc = $site->{description}; $item_desc =~ s/^\s+//s; $item_desc =~ s/\s+$//s; # descriptionの1行目(30文字まで)をitemの題とする my $item_title = ( $item_desc =~ m{^(.+)} ) ? $1 : '(none)'; $item_title = substr($item_title, 0, 30) if (length($item_title) > 30); # $item_linkを生成 my $date_num = $site->{dc}->{date}; $date_num =~ tr/T:+-//d; $date_num =~ s/\d{4}$//; my $item_link = $hatena_go . $site->{link} . $date_num; push @site, { title => $site->{title}, link => $site->{link}, date => $site->{dc}->{date}, imageurl => $site->{$hatena_ns}->{imageurlsmall}, item => { title => $item_title, link => $item_link, desc => $item_desc, }, }; } return \@site; } # サイト情報を元にRSSを作成(ファイル名を返す) sub output_rss { my $site = shift; my $file = &url_to_filename($site->{link}); my $output_file = $base_local_dir . $file; my $rss = XML::RSS->new(version => '1.0'); $rss->add_module( prefix => 'content', uri=>'http://purl.org/rss/1.0/modules/content/', ); my $last_item_link = ''; # 既にRSSファイルがあればそれを読み込む if (-r $output_file) { eval { $rss->parsefile($output_file); }; if ($@) { warn "$output_file: $@\n"; } else { $last_item_link = $rss->{items}->[0]->{link}; } } # channel情報を追加 $rss->channel( title => "$site->{title} (via ?A)", link => $site->{link}, description => "はてなアンテナで取得された更新情報を元に作成した、「$site->{title}」($site->{link})のRSSです。", dc => { date => $site->{date}, }, ); # image情報を追加 $rss->image( title => "「$site->{title}」のスクリーンショット", url => $site->{imageurl}, link => $site->{link}, ); # 最後に追加したitemと違うものであれば追加 if ( !$last_item_link || $last_item_link ne $site->{item}->{link} ) { # description と content::encoded を作成 my ($desc, $content); $desc = $content = $site->{item}->{desc}; $desc =~ s/\n/ /g; $content =~ s{\n}{
    }g; # itemを追加 $rss->add_item( title => $site->{item}->{title}, link => $site->{item}->{link}, #description => $desc, dc => { date => $site->{date}, }, content => { encoded => $content, }, mode => 'insert', # 先頭に追加 ); # itemが5個以上なら古いものを削除 pop @{$rss->{items}} if (@{$rss->{items}} > 5); } # RSSファイルを出力 if (open OUT, '>:utf8', $output_file) { print OUT $rss->as_string; close OUT; } else { warn "can't open $file: $!\n"; } return $file; } # URLをRSSファイル名に変換 sub url_to_filename { my $str = shift; $str =~ s{^http://}{}; $str =~ s/([^\w-])/_/g; return "$str.xml"; } # HTMLエスケープ sub escape { my $str = shift; $str =~ s/&(?!(?:amp|lt|gt|quot);)/&/g; $str =~ s//>/g; $str =~ s/"/"/g; return $str; } # 以下にRSS生成を除外するURL(の一部)を記入 __DATA__ exblog.jp ameblo.jp slashdot.jp blog.drecom.jp blog.livedoor.jp blogs.dion.ne.jp hatena.ne.jp fc2.com diary.jp.aol.com blogspot.com tdiary.net blogtribe.org __END__