#!/usr/bin/perl

#  jsRSS for Audioscrobbler++  jsRSS4AS.cgi 1.12
#               based jsRSS++
#
#    Copyright(C) 2004-2005 by 大黒屋
#     http://www.daikoku-ya.org/
#      webmaster@daikoku-ya.org

# 12/04/2005 ippei@mail.org
#  modified for being used at http://www.ippei813.com/diary/

use CGI::Carp qw(fatalsToBrowser);
use Socket;

# Jcode がサーバにインストールされている場合は use lib './'; をコメントアウト
# インストールされていない場合は Jcode.pm のあるディレクトリを use lib './lib'; で指定(ディレクトリ名は任意)

use lib './lib';
use Jcode;

my $acchk    = '';           # 外部サーバからのアクセスを許可する場合は空欄に

my $check    = 5;            # 更新間隔(分)
my $dir_feed = 'feed';        # キャッシュを保存するディレクトリ
my $max_log  = 30;            # キャッシュに保存する過去の曲数

my $dir_temp = 'temp';        # RSS表示用テンプレートのあるディレクトリ
my $def_temp = 'AS.tmp';      # デフォルトのテンプテート

my $G2J      = 'on';          # GMTをJSTに変換する

my $affid    = '';   # AmazonのアソシエイトエイトID

my $CR       = 'no';          # 下部のスクリプト名(+リンク)の表示

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 

if($G2J ne '') { use Time::Local }

my $VER = 1.12;
my %enc = (
'jis'  => 'ISO-2022-JP',
'sjis' => 'Shift_JIS',
'euc'  => 'EUC-JP',
'utf8' => 'UTF-8'
);

my $rssbase     = 'http://ws.audioscrobbler.com/1.0/user/';
my $linkbase_as = "http://www.audioscrobbler.com/music/";
my $linkbase_am = "http://www.amazon.co.jp/exec/obidos/external-search?tag=$affid&mode=music-jp&keyword=";

my $time_format = '';

my $REFF = $ENV{HTTP_REFERER};
my $ROOT = $ENV{DOCUMENT_ROOT};
my $SERVER = $ENV{SERVER_NAME};
my $SCRIPT = $ENV{SCRIPT_NAME};
my $str = $ENV{QUERY_STRING};
my @str = split(/&/,$str);
for(@str)
  {
  my($nam,$val) = split(/=/,$_,2);
  $nam =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2",$1)/eg;
  $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2",$1)/eg;
  ${$nam} = $val;
  }

$id = ippei813;
$line ||= 11;
$line = $max_log if($line > $max_log);
$enc = 'euc';
$temp ||= $def_temp;

my $rdf = my $RSS = undef;

my $cache = "$dir_feed/AS_$id" . '.dat';
my $url = $rssbase . $id . '/recenttracks.xml';

my %mod_time = ();
my $now = (time);
my $checktime = 60 * $check;

$mod{cache} = (stat $cache)[9];
$mod{check} = $mod{cache} + $checktime;

if(length($acchk) == 1 && $REFF !~ /$SERVER/)
  { $RSS = qq(<div>Bad Call!!</div>) }
elsif(length($id) == 0)
  { $RSS = qq(<div>ユーザーIDを指定してください</div>) }
elsif(!(-e "$dir_temp/$temp"))
  { $RSS = qq(<div>テンプレートファイルがありません</div>) }
elsif(!(-e $cache))
  {
  my $tmp = &sock();
  my $data = &parse($tmp);
  @data = @{$data};
  &save_cache($data);
  }
else
  {
  my $tmp = &read_cache;
  @cache = @{$tmp};
  $old_site_data = shift @cache;
  
  if($now > $mod{check})
    {
    my $tmp = &sock();
    my $data = &parse($tmp);
    @data = @{$data};
    }
  else
    { push @data,$old_site_data }

  push @data,@cache;

  my %c; @data = grep(!$c{$_}++,@data);
  @data = map { $_ -> [0] } sort { $b -> [1] cmp $a -> [1] } map { [$_,split(/\t/)] } @data;

  @data = splice(@data,0,$max_log +1);
  &save_cache(\@data) if($now > $mod{check});
  }



if($RSS eq '')
  {
  local $/ = undef;
  open(IN,"<$dir_temp/$temp") or die "$!";
  my $TEMP = <IN>;
  close(IN);
# 20060122
# $TEMP = (getcode($TEMP) eq 'euc') ? $TEMP : Jcode -> new($TEMP) -> euc;
  $TEMP =~ s/\r\n/\n/g;
  $TEMP =~ s/\r/\n/g;
  eval($TEMP);

  my($head,$foot) = ($HEAD,$FOOT);


  for(0..$line)
    {
    my $data = Jcode -> new($data[$_]) -> euc;

    $data[$_] =~ s/'/&apos;/g;
    $data[$_] =~ s/"/&quot;/g; #"'

    my($DATE,$TITLE,$CREAT,$LINK) = split(/\t/,$data[$_]);
    next if($TITLE eq '' && $CREAT eq '');

    my $ts = '';
    if($DATE ne '')
      {
	  

      if($G2J ne '')
        {
	$DATE -= 3600;  # timezone difference between EST and CST
	($SS,$MM,$HH,$dd,$mm,$yyyy) = (localtime($DATE))[0..5];
        $yyyy = sprintf("%04d",$yyyy +1900);
        $mm   = sprintf("%02d",$mm+1);
        $dd   = sprintf("%02d",$dd);
        $HH   = sprintf("%02d",$HH);
        $MM   = sprintf("%02d",$MM);
        $SS   = sprintf("%02d",$SS);
        }

      $ts = $time_format;
      $ts =~ s/y/$yyyy/;
      $ts =~ s/m/$mm/;
      $ts =~ s/d/$dd/;
      $ts =~ s/H/$HH/;
      $ts =~ s/M/$MM/;
      $ts =~ s/S/$SS/;
      }

    my $as_link_tune   = $LINK;

    my $as_link_artist = $LINK;
    $as_link_artist =~ s#(http://.*/)_.*$/#$1#;

    my $am_link_album  = $linkbase_am . $album; 
    my $am_link_tune   = $linkbase_am . $title; 
    my $am_link_artist = $linkbase_am . $creat; 

    my $repeat = $REPEAT;

    $repeat =~ s/#ALBUM#/$album/g;
    $repeat =~ s/#TUNE#/$TITLE/g;
    $repeat =~ s/#ARTIST#/$CREAT/g;

    $repeat =~ s/#AS_LINK_TUNE#/$as_link_tune/g;
    $repeat =~ s/#AS_LINK_ARTIST#/$as_link_artist/g;

    $repeat =~ s/#AM_LINK_ALBUM#/$am_link_album/g;
    $repeat =~ s/#AM_LINK_TUNE#/$am_link_tune/g;
    $repeat =~ s/#AM_LINK_ARTIST#/$am_link_artist/g;

    $repeat =~ s/#PLAYTIME#/$ts/g;
    $repeat =~ s/#DESC#/$desc/g;

    $list .= $repeat;
    }
  $RSS = $head . $list . $foot;
  $RSS .= qq(<div style="font-size:8pt;text-align:center;"><a href="http://www.daikoku-ya.org/" target="_blank">jsRSS4AS++ $VER</a></div>\n) if($CR ne 'no');
  }

# 20060122
# $RSS = ($enc eq 'euc') ? $RSS : Jcode -> new($RSS) -> $enc;
@RSS = split(/\n/,$RSS);
for(@RSS) { $_ = "'$_',\n" }
$RSS = join("",@RSS);

print <<_SRC;
document.write(
$RSS''
);
_SRC

exit;

sub parse
{
my $rdf = ${$_[0]};
my $DATA = undef;
my @DATA = undef;
my %site = undef;
my %entry = undef;

# 20060122
# $rdf = (getcode($rdf) eq 'euc') ? $rdf : Jcode -> new($rdf) -> euc;


my @ENTRY = ($rdf =~ /<track>(.*?)<\/track>/ismg);
shift @ENTRY if($ENTRY[0] =~ /rdf:Seq/ism);

for(@ENTRY)
  {
  if($_ =~ m!<name>(.*)</name>!i)
# 20060122
    { $entry{TITLE} = Jcode -> new($1, utf8) -> euc }
  if($_ =~ m!<url>(.*)</url>!ism)
    { $entry{LINK} = $1  }
  if($_ =~ m!<artist mbid=".*">(.*)</artist>!ism)
# 20060122
    { $entry{CREAT} = Jcode -> new($1, utf8) -> euc }
  if($_ =~ m!<date uts="(\d+)">.*</date>!i)
    { $entry{DATE} = $1}

  push @DATA,join("\t",$entry{DATE},$entry{TITLE},$entry{CREAT},$entry{LINK}) . "\n";
  }
return (\$site,\@DATA);
}

sub read_cache
{
open(IN,"<$cache") or die "$!";
my @data = <IN>;
close(IN);
return \@data;
}

sub save_cache
{
my @data = @{$_[0]};
open(OUT,">$cache") or die "$! :: ";
print OUT @data;
close(OUT);
}

sub sock
{
my $rss = undef;
my $URL = $url;
$URL =~ m|http://([^:/]*)(:(\d+))?(/.*)?|;
$host = $1;
($port = $3) || ($port = 80);
($path = $4) || ($path = '/');

$ipaddr = inet_aton($host);

socket(SOCK,PF_INET,SOCK_STREAM,getprotobyname('tcp')) or die "$!";
connect(SOCK,sockaddr_in($port,$ipaddr)) or die "Cannot Connect to $host:\n$!";
select(SOCK); $| = 1;
select(STDOUT);

$request  = "GET $path HTTP/1.0\r\n";
$request .= "Host: $host\r\n";
$request .= "User-Agent: jsRSS4AS++/$VER (http://www.daikoku-ya.org/)\r\n";
$request .= "\r\n";

print SOCK $request;
while(<SOCK>) { $rss .= $_ }
close(SOCK);

return \$rss;
}