#!/usr/bin/perl

#    jsRSS++  jsRSS.cgi 4.0
#
#  Copyright(C) 2004-2012 by 大黒屋
#   http://www.daikoku-ya.org/
#       master@daikoku-ya.org

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #  
# 基本設定 

# デフォルトの設定ファイル名
my $def_conf  = './jsRSS_conf3';

# RSSデータを保存するディレクトリ
my $cache_dir = './cache';

# 呼び出しを許可するサーバ名を '～','～',と列挙する
my @callfrom = (
  'http://www.sir-2.net/',
  'https://www.sir-2.net/',
  'http://127.0.0.1/',
  );

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

use Encode;
use CGI;
use LWP::UserAgent;
# use LWP::Protocol::https;

use lib './lib';
use XML::FeedPP;

my $UA  = LWP::UserAgent->new;
my $CGI = CGI->new();

my $CONFIG;

my $VER = '4.0';
my $enc = {
'utf8'   => 'UTF-8',
'euc-jp' => 'EUC-JP',
'jis'    => 'ISO-2022-JP',
'sjis'   => 'Shift_JIS',
};

my $SCRIPT = $ENV{SCRIPT_NAME};
my $SERVER = $ENV{SERVER_NAME};

if((grep /$SERVER/,@callfrom) == 0)
  { warningout('このサーバからの呼び出しは許可されていません'); }

my $url, my $conf;
my $query = $ENV{QUERY_STRING};
if(index($query,'http') >= 0)
  {
  $url  = $query;
  $conf = $def_conf;
  }
elsif($query ne '')
  {
  $url ='';
  $conf = $query;
  }
else
  {
  $url ='';
  $conf = $def_conf;
  }

$conf = (index($conf,'.cgi') > 0) ? $conf : $conf . '.cgi';

if(-f $conf)
  { $CONFIG = require $conf; }
else
  { warningout('設定ファイルが見つかりません : ' . $conf); }

if($url eq '')
  { $url = $CONFIG->{feed}; }

my $data = get_data($url);
my $feed = make_html($data);

my @out_data = split(/\n/,$feed);
for(@out_data) { $_ = "'" . $_ . "',\n" }
my $out_data = join("",@out_data) . "''";

print CGI->new()->header(-charset=>'utf8',-type=>'text/html');
print "document.write($out_data);";

exit;


sub get_data
{
my $url = shift;

my $feed, my $filename;

($filename = $url) =~ s{http://}{};
$filename =~ s{\.}{-}g;
$filename =~ s{/}{_}g;
my $cache_file = "$cache_dir/$filename" . '.dat';

if(-e $cache_file)
  {
  my $modified;
  my $now = (time);
  my $checktime = 60 * $CONFIG->{check_interval};

  $modified->{cache} = (stat $cache_file)[9];
  $modified->{check} = $modified->{cache} + $checktime;
  $modified->{gmt}   = gmtime($modified->{cache});
  
  if($now > $modified->{check})
    {
    my $req = $UA->head($url,if_modified_since => $modified->{gmt});
    if($req->{_rc} ne '304')
      {
      $feed->{xml} =  XML::FeedPP->new($url);
      $feed->{data} = parse_feed($feed->{xml});
      &save_cache($cache_file,$feed->{data});
      }
    $feed->{data} = &read_cache($cache_file);
    }
  else
    {
    $feed->{data} = &read_cache($cache_file);
    }
  }
else
  {
  $feed->{xml} = XML::FeedPP->new($url) or die "$!";
  $feed->{data} = parse_feed($feed->{xml});
  &save_cache($cache_file,$feed->{data});
  }

return $feed->{data};
}

sub get_feed
{
my $url = shift;

$UA->agent("jsRSS++/$VER (http://www.daikoku-ya.org/)");
$UA->timeout(15);

my $req = HTTP::Request->new(GET => $url);
my $res = $UA->request($req);

if($res->is_success) 
  { return $res->content; }
else
  {
  my $RC = $res->code;
  if($RC == 404)
    { warningout('指定されたURLのFeedが見つかりません : ' . $url); }
  elsif($RC == 403)
    { warningout('指定されたURLのFeedにアクセス出来ません : ' . $url); }
  elsif($RC == 401)
    { warningout('指定されたURLのFeedは認証が必要です : ' . $url); }
  elsif($RC == 500 || $RC != 200)
    { warningout('指定されたURLのFeedでサーバエラーが発生しました : ' . $url); }
  }
}

sub parse_feed
{
my $feed = shift;

my $site, my $entries, my @data;
my $data = '';

$site->{version}     = ' ';
$site->{title}       = $feed->title()       || '';
$site->{link}        = $feed->link()        || '';
#$site->{description} = $feed->description() || '';
$site->{creator}     = $feed->copyright()   || '';
$site->{date}        = $feed->pubDate()     || '';

#for('title','description')
for('title')
  {
  $site->{$_} =~ s{\r\n}{\n}g;
  $site->{$_} =~ s{\r}{\n}g;
  $site->{$_} =~ s{\n}{<br />}g;
  $site->{$_} =~ s{\t}{}g;
  }

$data = join("\t",
        $site->{version},
        $site->{title},
        $site->{link},
#        $site->{description},
        $site->{creator},
        $site->{date}
        ) . "\n";

  $data =~ s{'}{&apos;}g; #'
  $data =~ s{"}{&quot;}g; #"

  push @data,$data;

my %MON = ('Jan' => 1,'Feb' => 2,'Mar' => 3,'Apr' => 4, 'May' => 5, 'Jun' => 6,
           'Jul' => 7,'Aug' => 8,'Sep' => 9,'Oct' => 10,'Nov' => 11,'Dec' => 12);

for my $item($feed->get_item())
  {
  my $entry;
  my $data = '';

  $entry->{date}        = $item->pubDate()     || '';
  $entry->{title}       = $item->title()       || '';
  $entry->{link}        = $item->link()        || '';
#  $entry->{category}    = $item->category()    || '';
  $entry->{creator}     = $item->author()      || '';
#  $entry->{description} = $item->description() || '';

#  if(ref($entry->{category}) eq "ARRAY")
#    {
#    if(ref($entry->{category}->[0]) eq "HASH")
#      {
#      $entry->{category} = $entry->{category}->[0]->{'-term'};
#      }
#    else
#      {
#      $entry->{category} = $entry->{category}->[0];
#      }
#    }

#  if($item->get('summary'))
#    {
#    $entry->{description} = $item->get('summary');
#    }

  if($entry->{date} =~ m{(\d+).(\w+).(\d{4}).(\d+):(\d+):(\d+)}) #Y!
    {
    $entry->{date} = sprintf("%04d%02d%02d%02d%02d%02d",$3,$MON{$2},$1,$4,$5,$6);
    }
  else
    {
    $entry->{date} =~ s{[+|-]\d\d:\d\d}{};
    $entry->{date} =~ s{[-|:|T|Z]}{}g;
    }

  while(length($entry->{date}) < 14 && length($entry->{date}) > 1) { $entry->{date} .= '0' }

#  for('title','description')
  for('title')
    {
    $entry->{$_} =~ s{\r\n}{\n}g;
    $entry->{$_} =~ s{\r}{\n}g;
    $entry->{$_} =~ s{\n}{<br />}g;
    $entry->{$_} =~ s{\t}{}g;
    }

  $data = join("\t",
          $entry->{date},
          $entry->{title},
          $entry->{link},
#          $entry->{category},
          $entry->{creator},
#          $entry->{description}
          );

  $data =~ s{'}{&apos;}g; #'
  $data =~ s{"}{&quot;}g; #"
  push @data,$data . "\n";
  }

return $site,\@data;
}

sub make_html
{
my @data = @{$_[0]};
my $site_data = shift @data;

my $signature = qq{<div id="signature"><a href="http://www.daikoku-ya.org/?jsRSS$VER" target="_blank">jsRSS++ $VER</a></div>};

if(lc($CONFIG->{add_block}) eq 'yes')
  {
  my $add_regexp = '[' . join('|',@{$CONFIG->{add_prefix}}) . ']';
  @data = map {$_->[0]} grep { $_->[1] !~ m{^$add_regexp}ig } map { [ $_,(split(/\t/))[1] ] }  @data;
  }
@data = splice(@data,0,$CONFIG->{feedline});

my($version,$site_title,$site_link,$site_dscription,$site_creator,$site_date) = split(/\t/,$site_data);

for('header','footer')
  {
  $CONFIG->{$_} =~ s{#Version#}{$version}g;
  $CONFIG->{$_} =~ s{#SiteTitle#}{$site_title}g;
  $CONFIG->{$_} =~ s{#SiteLink#}{$site_link}g;
#  $CONFIG->{$_} =~ s{#SiteDescription#}{$site_dscription}g;
  $CONFIG->{$_} =~ s{#SiteCreator#}{$site_creator}g;
  $CONFIG->{$_} =~ s{#SiteDate#}{$site_date}g;
  $CONFIG->{$_} =~ s{#Signature#}{$signature}g;
  }

my($yyyy,$mm,$dd,$HH,$MM,$SS) = (localtime(time - 60 * 60 * $CONFIG->{new_entry}))[5,4,3,2,1,0];
my $new_check = sprintf("%04d%02d%02d%02d%02d%02d",$yyyy +1900,$mm +1,$dd,$HH,$MM,$SS);

my $repeats = '';
for(@data)
  {
  my $repeat = $CONFIG->{repeat};

  if($CONFIG->{HTMLTAG} eq 'cut')
    {
    $_ =~ s{<[^>]*>}{}g;
    }
  elsif($CONFIG->{HTMLTAG} eq 'off')
    {
    $_ =~ s{&}{&amp;}g ;
    $_ =~ s{<}{&lt;}g ;
    $_ =~ s{>}{&gt;}g ;
    }

  my($date,$title,$link,$category,$creator,$dscription) = split(/\t/,$_);

  if($CONFIG->{title_length} != 0 && length($title) > $CONFIG->{title_length})
    {
    $title = Encode::encode_utf8(substr(Encode::decode_utf8($title),0,$CONFIG->{title_length})) . '...';
    }

#  if($CONFIG->{description_length} != 0 && length($dscription) > $CONFIG->{description_length})
#    {
#    $dscription = Encode::encode_utf8(substr(Encode::decode_utf8($dscription),0,$CONFIG->{description_length})) . '...';
#    }

  my $timestamp = '';
  if($date ne '')
    {
    my $yyyy = substr($date,0,4);
    my $mm   = substr($date,4,2);
    my $dd   = substr($date,6,2);
    my $HH   = substr($date,8,2);
    my $MM   = substr($date,10,2);
    my $SS   = substr($date,12,2);

    $timestamp = $CONFIG->{time_format};
    $timestamp =~ s{y}{$yyyy};
    $timestamp =~ s{m}{$mm};
    $timestamp =~ s{d}{$dd};
    $timestamp =~ s{H}{$HH};
    $timestamp =~ s{M}{$MM};
    $timestamp =~ s{S}{$SS};
    }

  my $whatsnew = ($new_check <= $date) ? $CONFIG->{new_mark} : '';
  my $wnfront  = ($new_check <= $date) ? $CONFIG->{whatsnew_front} : '';
  my $wnback   = ($new_check <= $date) ? $CONFIG->{whatsnew_back} : '';

  $repeat =~ s{#TimeStamp#}{$timestamp}g;
  $repeat =~ s{#WhatsNew#}{$whatsnew}g;
  $repeat =~ s{#WhatsNewFront#}{$wnfront}g;
  $repeat =~ s{#WhatsNewBack#}{$wnback}g;
  $repeat =~ s{#Title#}{$title}g;
  $repeat =~ s{#Link#}{$link}g;
#  $repeat =~ s{#Category#}{$category}g;
  $repeat =~ s{#Creator#}{$creator}g;
#  $repeat =~ s{#Description#}{$dscription}g;

  $repeats = $repeats . $repeat;
  }

return $CONFIG->{header} . $repeats . $CONFIG->{footer};
}

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

sub save_cache
{
my $file = shift;
my $data = shift;
open(OUT,">$file") or die "$! :: ";
print OUT @{$data};
close(OUT);
}

sub warningout
{
my $text = shift;
print CGI->new()->header(-charset => $enc->{$CONFIG->{encode}});
print "document.write('$text');";
exit;
}