EDGE Now!の新着サイトRSS生成Perlスクリプト

EDGE Now!の新着サイトなんですが、このサイト、RSSを活用しているのに、RSSを出していないうんこサイトなんです。アホかと。早速生成スクリプト作りました。

毎回取りに行くタイプなんで、そのまま設置したらAdobeからBANされるかもよ。

Filename: edgenow.cgi

#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple;
use URI;
use XML::Simple;
use XML::RSS;
use utf8;
 
my $result = get_data();
my $rss    = rss($result);
if ($ENV{GATEWAY_INTERFACE}) {
    require CGI;
    print CGI::header('text/xml; charset=utf-8');
}
print $rss;
 
exit;
 
 
sub rss {
  my $hash =shift;
  my $rss = XML::RSS->new;
  $rss->add_module(
    prefix=>'content',
    uri=>'http://purl.org/rss/1.0/modules/content/',
    );
  
  $rss->channel(
    title    => 'EDGE Now! 今注目されているサイト',
    link     => 'http://edgenow.jp/',
    description => 'EDGE Now! 今注目されているサイトのRSS',
    language => 'ja',
    dc => {
      publisher    => 'アドビシステムズ株式会社',
      contributor  => 'DTPWiki.jp',
    },
    syn => {
      updatePeriod => 'hourly',
      updateFrequency => '1',
    },
  );
  
  my $items;
  foreach my $item (keys %$hash) {
    push @$items, {
      link        => _url_decode($hash->{$item}->{url}),
      title       => $hash->{$item}->{title},
      description => "$hash->{$item}->{title} "
                     . _url_decode($hash->{$item}->{url}),
      date => _date($hash->{$item}->{entryTime}),
    };
  }  
  my @sort = sort { $b->{date} cmp $a->{date} } @$items;
  
  foreach my $item (@sort) {   
      $rss->add_item(
        link  => $item->{'link'},
        title => $item->{'title'},
        description => $item->{'description'},
        dc => {
          date       => $item->{'date'},
        },
      );
  }
  return $rss->as_string() ;
}
 
sub get_data {
  # EDGE Nowから必要分ハッシュ取得
  my $refs={};
  for ( my $i = 0; $i < 5; $i++ ) {
    my $ref = get_EDGENow($i);
    $refs = { %$refs, %{$ref->{siteList}->{site} } };
  }
  return $refs;
}
 
sub get_EDGENow {
  my $page = shift;
  my $uri = URI->new('http://edgenow.jp/xml/edgeNow.php');
  $uri->query_form(
    page => $page,
  ) if $page;
  my $xml = get( $uri->as_string );
  my $xs = new XML::Simple();
  my $ref = $xs->XMLin($xml);
  return $ref;
}
 
sub _date {
  my $date = shift;
  my @s = split(' ',$date);
  return "$s[0]-$s[1]-$s[2]T$s[3]:$s[4]:$s[5]T+09:00";
}
 
sub _url_decode {
  my $str = shift;
  $str =~ tr/+/ /;
  $str =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
  return $str;
}

URLデコードどうするんだっけ。古式ゆかしい方法でやっちゃったけれども……