{ changepref boringfile .boring hunk ./tmpl/index.html 1 - - - - - :.. RssC ..: - - - - - - -

RssC

- - -

RSS URL生成

- - - -

タイトル登録

- - - -

タイトル變更

- - - - - - - - - - - - - - - - - -

URL	- -
タイトル	- -
元のタイトル
	- - -

- - -

タイトル削除

- - - - -

タイトル登録濟サイト一覽

- - - - - - - - - - - - - - - - -

サイト	編集	削除
- -	- - - -	- - - -
- タイトルの設定されたサイトは在りません。 -

- - - rmfile ./tmpl/index.html hunk ./setup.pl 1 -#!/usr/bin/perl -# -*- cperl -*- -# ------------------------------------------------------------------------------ -# setup.pl is in the public domain. -# written by PHO. -# -# v1.0 / 2006-01-28 -# ------------------------------------------------------------------------------ -use strict; -use warnings; -sub req ($;$); -sub opt ($;$); -# ------------------------------------------------------------------------------ -# Example: -# -# [Requirement] -# req 'LWP::UserAgent'; # any version of LWP::UserAgent -# req 'Data::Dumper' => 1.1; # Data::Dumper 1.1 or later -# -# [Optional] -# opt 'CGI::Fast'; -# opt 'CGI' => 3.0; -# -# ------------------------------------------------------------------------------ -req 'URI'; -req 'URI::QueryParam'; -req 'HTTP::Date'; -req 'CGI'; -opt 'CGI::Fast'; -req 'DBI'; -req 'DBD::SQLite'; -req 'File::Spec'; -req 'HTTP::Cookies'; -req 'HTTP::Status'; -req 'Digest::MD5'; -req 'Encode'; -req 'XML::RSS'; -req 'Time::Zone'; -req 'Carp'; - -# ------------------------------------------------------------------------------ -# Code below is not supposed to be modified. -# ------------------------------------------------------------------------------ -my @unavail_req; -my @unavail_opt; - -sub req ($;$) { - check(req => @_); -} - -sub opt ($;$) { - check(opt => @_); -} - -sub check { - my ($which, $mod, $ver) = @_; - my $unavail = ($which eq 'req' ? \@unavail_req : \@unavail_opt); - - local $| = 1; - if ($ver) { - print "checking if $mod >= $ver is available... "; - } - else { - print "checking if $mod is available... "; - } - - eval qq{ - use $mod; - }; - if ($@) { - if ($ver) { - print "no (not available)\n"; - } - else { - print "no\n$@\n"; - } - push @$unavail, $mod; - } - else { - if ($ver) { - my $VER = eval("\$${mod}::VERSION"); - if ($VER >= $ver) { - print "yes ($VER)\n"; - } - else { - print "no ($VER)\n"; - push @$unavail, $mod; - } - } - else { - print "yes\n"; - } - } -} - -my $cpan; -sub check_for_cpans () { - $cpan and return; - - $cpan = {}; - - eval qq{ - use CPAN; - }; - $@ or $cpan->{cpan} = 1; - - eval qq{ - use CPANPLUS; - }; - $@ or $cpan->{cpanplus} = 1; -} - -sub install { - my ($req, @mods) = @_; - check_for_cpans; - - my $default; - if ($cpan->{cpan} and $cpan->{cpanplus}) { - print "Both CPAN.pm and CPANPLUS.pm are available.\n"; - print "What do you want to make me do?\n"; - print "\n"; - print " [1] Install them with CPAN.pm\n"; - print " [2] Install them with CPANPLUS.pm\n"; - if ($req) { - print " [3] Abort the setup.\n"; - } - else { - print " [3] Ignore those modules.\n"; - } - $default = 2; - } - elsif ($cpan->{cpan}) { - print "CPAN.pm is available.\n"; - print "What do you want to make me do?\n"; - print "\n"; - print " [1] Install them with CPAN.pm\n"; - if ($req) { - print " [2] Abort the setup.\n"; - } - else { - print " [2] Ignore those modules.\n"; - } - $default = 1; - } - elsif ($cpan->{cpanplus}) { - print "CPANPLUS.pm is available.\n"; - print "What do you want to make me do?\n"; - print "\n"; - print " [1] Install them with CPANPLUS.pm\n"; - if ($req) { - print " [2] Abort the setup.\n"; - } - else { - print " [2] Ignore those modules.\n"; - } - $default = 1; - } - else { - print "Neither CPAN.pm nor CPANPLUS.pm are available, so I can't\n"; - print "install them automatically for you.\n"; - $req and exit 1; - return; - } - - local $| = 1; - while (1) { - print "\n"; - print "Please enter the number [$default]: "; - my $choice = <>; - chomp $choice; - length $choice or $choice = $default; - - if ($cpan->{cpan} and $cpan->{cpanplus}) { - if ($choice == 1) { - cpan_install(@mods); - last; - } - elsif ($choice == 2) { - cpanplus_install(@mods); - last; - } - elsif ($choice == 3) { - $req and exit 1; - return; - } - } - else { - if ($choice == 1) { - if ($cpan->{cpan}) { - cpan_install(@mods); - } - elsif ($cpan->{cpanplus}) { - cpanplus_install(@mods); - } - last; - } - elsif ($choice == 2) { - $req and exit 1; - return; - } - } - } -} - -sub cpan_install { - my @mods = @_; - - foreach my $mod (@mods) { - CPAN::Shell->install($mod); - } -} - -sub cpanplus_install { - my @mods = @_; - - foreach my $mod (@mods) { - CPANPLUS::install($mod); - } -} - -if (@unavail_req) { - print "\n"; - print "The following modules are unavailable, which are required by this program:\n"; - foreach (@unavail_req) { - print " $_\n"; - } - print "\n"; - install(1, @unavail_req); -} - -if (@unavail_opt) { - print "\n"; - print "The following modules are unavailable, which are optionally wanted by this program:\n"; - foreach (@unavail_opt) { - print " $_\n"; - } - print "\n"; - install(0, @unavail_opt); -} - -print "\n"; -print "Setup completed.\n"; rmfile ./setup.pl hunk ./schema.sql 1 --- スキーマのバージョン -CREATE TABLE schema_ver ( - current INTEGER, - minimum INTEGER -); - --- URIマスタ -CREATE TABLE uri ( - uri_id INTEGER PRIMARY KEY, - uri VARCHAR(255), - - UNIQUE (uri) -); - --- タイトル -CREATE TABLE title ( - uri_id INTEGER, - title BLOB, - - UNIQUE (uri_id) -); - --- ユーザーによって設定されたタイトル -CREATE TABLE user_title ( - uri_id INTEGER, - user_title BLOB, - - UNIQUE (uri_id) -); - --- 中身のMD5 -CREATE TABLE md5 ( - uri_id INTEGER, - md5 CHAR(32), - - UNIQUE (uri_id) -); - --- 最終更新時刻 -CREATE TABLE last_modified ( - uri_id INTEGER, - lastmod INTEGER, -- エポック - - UNIQUE (uri_id) -); - --- Local Variables: --- sql-product: sqlite --- End: + rmfile ./schema.sql hunk ./rssc.pl 1 -#!/usr/bin/perl -# -*- cperl -*- -use strict; -use warnings; -use URI; -use RssC::DB; -use RssC::Checker; -use RssC::Formatter; - -if (!$ARGV[0]) { - print "\n"; - print "Usage: $0 http://www.example.org/\n"; - print "\n"; - exit 0; -} - -my $uri = URI->new($ARGV[0]); -$uri->fragment(undef); -$uri = $uri->canonical; -my ($lastmod, $title) = RssC::Checker->check($uri); - -# user_titleを見る -my ($user_title) = DB->selectrow_array(q{ - SELECT user_title - FROM user_title - LEFT JOIN uri USING (uri_id) - WHERE uri = ? -}, undef, $uri->as_string); - -$user_title and - $title = $user_title; - -my $fm = RssC::Formatter->new( - $uri, $lastmod, $title); -print $fm->format; rmfile ./rssc.pl hunk ./rssc.cgi 1 -#!/usr/bin/perl -# -*- Coding: utf-8 -*- -# -# ::: RssC ::: RSS Concoction ::: -# -# 使ひ方: -# -# rc.cgi/rss/http://www.example.org/ -# (Last-Modified, If-Modified-Since對應) -# -# -package rssc_cgi; -use strict; -use warnings; -use lib '.'; -use URI; -use URI::QueryParam; -use RssC::Checker; -use RssC::Formatter; -use RssC::DB; -use HTTP::Date; -use Template; -our $VERSION = '1.0'; - -eval q{ - use CGI::Fast; -}; -if ($@) { - # FastCGI is not available - eval q{ - use CGI; - }; - if ($@) { - die "Neither CGI nor CGI::Fast are available"; - } - else { - cgi_main(CGI->new); - } -} -else { - while (my $q = CGI::Fast->new) { - $q or exit 0; - - cgi_main($q); - - eval { - DB->do(q{ROLLBACK}); - }; - } -} - -sub cgi_main { - my $q = shift; - eval { - if ($q->path_info) { - disp_rss($q); - } - else { - my $cmd = $q->param('cmd'); - if (!$cmd) { - disp_index($q); - } - elsif ($cmd eq 'rss') { - disp_rss_url($q); - } - elsif ($cmd eq 'set') { - do_set_title($q); - } - elsif ($cmd eq 'del') { - do_delete_title($q); - } - else { - die "Invalid command: $cmd\n"; - } - } - }; - if (my $err = $@) { - print $q->header( - -status => '500 Internal Server Error', - -type => 'text/plain'); - print "Error: $err"; - } -} - -sub disp_rss { - my $q = shift; - - my $qstr = $ENV{QUERY_STRING}; - my $uri = URI->new( - substr($q->path_info, 1) . (length $qstr ? '?'.$qstr : '')); - $uri->fragment(undef); - $uri = $uri->canonical; - my ($lastmod, $title) = RssC::Checker->check($uri); - - if (defined($_ = $q->http('If-Modified-Since'))) { - my $ifmod = str2time($_); - if ($ifmod >= $lastmod) { - print $q->header( - -status => '304 Not Modified', - -Last_Modified => time2str($lastmod)); - return; - } - } - - # user_titleを見る - my ($user_title) = DB->selectrow_array(q{ - SELECT user_title - FROM user_title - LEFT JOIN uri USING (uri_id) - WHERE uri = ? - }, undef, $uri->as_string); - - $user_title and - $title = $user_title; - - my $fm = RssC::Formatter->new( - $uri, $lastmod, $title); - print $q->header( - -type => 'application/rss+xml; charset=UTF-8', - -Last_Modified => time2str($lastmod)); - print $fm->format; -} - -sub disp_index { - my $q = shift; - my $t = Template->new( - -fpath => 'tmpl/index.html'); - - my $uri_id; - if ($uri_id = $q->param('edit')) { - my $row = DB->selectrow_hashref(q{ - SELECT uri.uri_id AS uri_id, - uri, - title, - user_title - FROM uri - LEFT JOIN title ON (uri.uri_id = title.uri_id) - LEFT JOIN user_title ON (uri.uri_id = user_title.uri_id) - WHERE uri.uri_id = ? - }, undef, $uri_id); - - if (not $row) { - die "No such id: $uri_id\n"; - } - - $t->form_edit->add_hidden_form( - do { - my $uri = URI->new($q->url); - $uri->query_param(cmd => 'set'); - $uri->query_param(uri_id => $row->{uri_id}); - $uri; - }); - $t->form_edit->set_form( - do { - my $uri = URI->new($q->url); - $uri->query_param(title => $row->{user_title}); - $uri; - }); - $t->form_edit->add( - uri => $row->{uri}, - original_title => $row->{title} || '', - ); - } - elsif ($uri_id = $q->param('del')) { - my $row = DB->selectrow_hashref(q{ - SELECT uri.uri_id AS uri_id, - uri, - title, - user_title - FROM uri - LEFT JOIN title ON (uri.uri_id = title.uri_id) - LEFT JOIN user_title ON (uri.uri_id = user_title.uri_id) - WHERE uri.uri_id = ? - }, undef, $uri_id); - - if (not $row) { - die "No such id: $uri_id\n"; - } - - $t->form_del->add_hidden_form( - do { - my $uri = URI->new($q->url); - $uri->query_param(cmd => 'del'); - $uri->query_param(uri_id => $row->{uri_id}); - $uri; - }); - $t->form_del->add( - uri => $row->{uri}, - title => $row->{user_title}, - original_title => $row->{title} || '', - ); - } - else { - $t->form_url->add_hidden_form( - do { - my $uri = URI->new($q->url); - $uri->query_param(cmd => 'rss'); - $uri; - }); - $t->form_url->add; - - $t->form_add->add_hidden_form( - do { - my $uri = URI->new($q->url); - $uri->query_param(cmd => 'set'); - $uri; - }); - $t->form_add->add; - } - - my $sth = DB->prepare(q{ - SELECT uri.uri_id AS uri_id, - uri, - title, - user_title - FROM uri - LEFT JOIN title ON (uri.uri_id = title.uri_id) - LEFT JOIN user_title ON (uri.uri_id = user_title.uri_id) - WHERE user_title IS NOT NULL - ORDER BY uri - }); - $sth->execute; - my $any_rows; - while (my $row = $sth->fetchrow_hashref) { - $any_rows = 1; - - $t->title_list->row->add_hidden_form( - do { - my $uri = URI->new($q->url); - $uri->query_param( - edit => $row->{uri_id}); - $uri; - }, 'edit'); - - $t->title_list->row->add_hidden_form( - do { - my $uri = URI->new($q->url); - $uri->query_param( - del => $row->{uri_id}); - $uri; - }, 'del'); - - $t->title_list->row->add( - uri => $row->{uri}, - title => $row->{user_title}, - ); - } - if (!$any_rows) { - $t->title_list->no_rows->add; - } - $t->title_list->add; - - print $q->header( - -type => 'text/html; charset=UTF-8'); - print $t->str; -} - -sub disp_rss_url { - my $q = shift; - my $t = Template->new( - -fpath => 'tmpl/index.html'); - - if ($q->param('cancel')) { - print $q->redirect($q->url); - return; - } - - my $rss_uri = URI->new( - sprintf( - 'http://%s%s/%s', - $q->http('Host'), - $q->url(-absolute => 1), - $q->param('uri')))->canonical; - - $t->rss->add( - rss => $rss_uri->as_string); - - $t->form_url->back->add; - - $t->form_url->rss->add( - rss => $rss_uri->as_string); - - $t->form_url->add_hidden_form( - do { - my $uri = URI->new($q->url); - $uri->query_param(cmd => 'rss'); - $uri; - }); - $t->form_url->add; - - print $q->header( - -type => 'text/html; charset=UTF-8'); - print $t->str; -} - -sub do_set_title { - my $q = shift; - - my $title = $q->param('title'); - if ($title and !$q->param('cancel')) { - - DB->do(q{BEGIN}); - - if (my $uri = $q->param('uri')) { - my $uri_id = RssC::Checker->uri_id($uri); - - DB->do(q{ - REPLACE INTO user_title - (uri_id, user_title) - VALUES (? , ? ) - }, undef, $uri_id, $title); - } - elsif (my $uri_id = $q->param('uri_id')) { - DB->do(q{ - REPLACE INTO user_title - (uri_id, user_title) - VALUES (? , ? ) - }, undef, $uri_id, $title); - } - - DB->do(q{COMMIT}); - } - - print $q->redirect($q->url); -} - -sub do_delete_title { - my $q = shift; - - my $uri_id = $q->param('uri_id'); - if (defined $uri_id and !$q->param('cancel')) { - DB->do(q{ - DELETE FROM user_title - WHERE uri_id = ? - }, undef, $uri_id); - } - - print $q->redirect($q->url); -} rmfile ./rssc.cgi hunk ./css/style.css 1 -@charset "UTF-8"; - -body { - background-color: #efefef; - margin: 0; - padding: 0; -} - -h1 { - background-color: #444444; - color: #efefef; - width: 50%; - text-align: center; - font-size: 300%; - - border-color: #666666; - border-width: 1px; - border-style: solid; - - padding: 5px 15px; - margin: 5px; -} -h1:before { - content: ":.. "; -} -h1:after { - content: " ..:"; -} -h1:before, h1:after { - color: #cdcdcd; -} - -h2 { - background-color: #cccccc; - padding: 3px; - width: 50%; - margin-left: auto; - margin-right: 5px; - margin-top: 20px; - margin-bottom: 20px; - text-align: right; - - border-width: 1px; - border-style: solid; - border-color: #dddddd; -} - -form { - width: 70%; - margin-left: auto; - margin-right: auto; -} - -form table { - width: 100%; -} - -table { - width: 70%; - margin-left: auto; - margin-right: auto; -} - -td { - background-color: #dddddd; - - /*border-color: #eeeeee; - border-width: 1px; - border-style: solid;*/ -} - -th { - background-color: #555555; - color: white; - - border-color: #777777; - border-width: 1px; - border-style: solid; -} - -td, th { - padding: 2px; - - text-align: center; -} - -input[type="text"] { - width: 99%; -} - -input[type="submit"] { - background-color: #444444; - color: white; - - border-style: solid; - border-color: #aaa #333 #333 #aaa; - border-width: 2px; -} - -input[type="text"] { - background-color: #ccc; - - border-style: solid; - border-width: 1px; - border-color: #666 #eee #eee #666; - - padding: 2px; -} - -a { - text-decoration: none; - color: #664444; - - border-color: #664444; - border-style: dotted; - border-width: 0 0 1px 0; -} + rmfile ./css/style.css hunk ./Template.pm 1 -# -*- cperl -*- -package Template; -use strict; -use warnings; -use Carp; -use UNIVERSAL; -our $AUTOLOAD; -our $VERSION = 4; - -our $SETFORM_SUPPORTED = 1; -BEGIN { - eval q{ use URI; use URI::QueryParam; }; - $@ and $SETFORM_SUPPORTED = 0; -} - -=head1 NAME - - Template - Text Template Class (especially for (x)html) - -=head1 SYNOPSIS - - ### sample.html ### - - - - Sample Page - <t-tag:embed> - Sample Page - - -

- - line:
- -

- - - - - ### sample.pl ### - - use Template; - my $t = Template->new( - -fpath => './sample.html', - ); - $t->expand( - embed => 'EMBED TITLE', - ); - foreach (1 .. 3) { - $t->block->add( - foo => ".: $_ :.", - ); - } - print $t->str; - - - ### output ### - - - - Sample Page - EMBED TITLE - Sample Page - - -

- - line: 1
- - line: 2
- - line: 3
- -

- - - -=head1 DESCRIPTION - -not available yet... - -=head1 CONSTRUCTOR - -=over 4 - -=item $t = Template->new( %args ); - -=over 8 - -=item -fpath => file to use as template (one of this and -data is required) - -=item -data => data to use as template - -=item -strip => whether delete newlines after , or not - -=item -lang => language to output - -Any blocks surrounded by and are treated as -language specific block. - - e.g. - - This is default - Nihongo(Japanese) - - my $t = Template->new( - -fpath => './foo.html', - -lang => 'ja'); - print $t->str; # this shows "Nihongo(Japanese)" - - $t = Template->new( - -fpath => './foo.html', - -lang => 'en'); - print $t->str; # this shows "This is default" - -=back - -=back - -=cut - -sub new { - # %args = ( - # -fpath => テンプレートとして使用するファイル - # -data => テンプレートとして使用するデータ - # -strip => やの直後の改行を削除するかどうか, - # -lang => 言語名, - # ) - my ($class, %args) = @_; - my $this = { - original => undef, # リーフをに置換した中身。 - current => undef, # <&foo>を置換した後のもの。 - leaves => {}, # {名前 => Template} - parent => undef, # これがトップレベルでなければ、親(Template)。 - leafname => undef, # これがトップレベルでなければ、リーフ名。 - }; - bless $this => $class; - - my $source; - if (defined $args{-fpath}) { - if (defined $args{-data}) { - croak "You can't specify both of -fpath and -data at the same time.\n"; - } - local $/ = undef; - open my $fh, '<', $args{-fpath} - or croak "Failed to open file $args{-fpath}"; - $source = <$fh>; - close($fh); - } - elsif (defined $args{-data}) { - $source = $args{-data}; - } - else { - croak "Missing both of -fpath and -data. Read `perldoc Template'\n"; - } - - # やの直後が改行コードなら、それを消す。 - # その改行コードから始まるスペースまたはタブも、インデントと見做して消す。 - if ($args{-strip}) { - $source =~ s{(|)\x0d?\x0a[ \t]*}{$1}g; - } - - # 言語 - my $lang = 'default'; - if ($args{-lang} and $source =~ m//) { - $lang = $args{-lang}; - } - $source =~ s{(.+?)}{ - if ($1 eq $lang) { - $2; - } - else { - ''; - } - }seg; - - $this->_load($source); - $this; -} - -sub reset { - my $this = shift; - $this->{current} = $this->{original}; - $this; -} - -sub expand { - # $t->expand({foo => '---' , bar => '+++'}); - # もしくは - # $t->expand(foo => '---' , bar => '+++'); - - # このメソッドは、キー内に現われたアンダースコアを - # ハイフンにフォールバックする事が出來る。 - # つまり、というタグを、キー名"foo_bar"で指定する事が出來る。 - my $this = shift; - my $hash = do { - if (@_ == 1 && UNIVERSAL::isa($_[0],'HASH')) { - $_[0]; - } - elsif (@_ % 2 == 0) { - my %h = @_; - \%h; - } - else { - croak "Illegal argument for Template->expand"; - } - }; - while (my ($key,$value) = each %$hash) { - # $key,$value共にスカラー値でなければならない。 - # リファならエラー。 - if (!defined $value) { - croak "Values must not be undef; key: $key"; - } - if (ref($key) ne '') { - croak "Keys and values must be scalar values: $key"; - } - if (ref($value) ne '') { - croak "Keys and values must be scalar values: $value"; - } - - if ($key =~ s/^raw://) { - # valueを弄らない - } - else { - $value = escape_tag($value); - } - - if ($this->{current} !~ s||$value|g) { - # 無い。アンダースコアをハイフンに変えてみる。 - (my $tred_key = $key) =~ tr/_/-/; - if ($this->{current} !~ s||$value|g) { - # そのようなキーは存在しなかった。警告。 - #carp "No are in template, or you have replaced it already"; - } - } - } - $this; -} - -sub add { - my $this = shift; - - # 引数があればexpandする。 - if (@_ > 0) { - eval { - $this->expand(@_); - }; if ($@) { - croak $@; - } - } - - # 親が存在しなければcroak。 - if (!defined $this->{parent}) { - croak "This template doesn't have its parent."; - } - - # 親のの直前に、このリーフを挿入。 - my $str = $this->str; - $this->{parent}{current} =~ s|({leafname}\E(?:\s*/)?>)|$str$1|g; - - # リセット - $this->reset; - - $this; -} - -sub str { - my $this = shift; - my $result = $this->{current}; - - # 未置換のがあればそれを消してcarp。 - while ($result =~ s/()//) { - carp "Unexpanded tag: $1"; - } - - # を消す。 - $result =~ s///g; - - $result; -} - -sub leaf { - my ($this,$leafname) = @_; - $this->{leaves}{$leafname}; -} - -sub AUTOLOAD { - my $this = shift; - (my $leafname = $AUTOLOAD) =~ s/.+?:://g; - - # 余分な引數が付いてゐれば、恐らくこれは關數名の誤り。 - if (@_) { - croak "Calling autoloaded Template->$leafname with extra arguments must be a mistake"; - } - - # アンダースコアはハイフンに置換。 - $leafname =~ tr/_/-/; - $this->{leaves}{$leafname}; -} - -sub _new_leaf { - my ($class,$parent,$leafname,$source) = @_; - my $this = { - original => undef, - current => undef, - leaves => {}, - parent => $parent, - leafname => $leafname, - }; - bless $this,$class; - - $this->_load($source); -} - -sub _load { - my ($this,$source) = @_; - - # ... をに置換しつつ、そのリーフを保存。 - while ($source =~ s|(.+?)||s) { - my ($leafname,$source) = ($1,$2); - - if (defined $this->{leaves}{$leafname}) { - # 既にこのリーフが定義されていたらcroak。 - croak "duplicated leaves in template: $leafname"; - } - else { - $this->{leaves}{$leafname} = Template->_new_leaf($this,$leafname,$source); - } - } - $this->{original} = $this->{current} = $source; - - $this; -} - -sub escape_tag { - my @args = @_; - my @result; - foreach my $str (@args) { - if (defined $str) { - $str =~ s/\&/\&/g; - $str =~ s//\>/g; - $str =~ s/\"/\"/g; - } - push @result, $str; - } - wantarray ? @result : $result[0]; -} - -sub unescape_tag { - my @args = @_; - my @result; - foreach my $str (@args) { - if (defined $str) { - $str =~ s/\<//g; - $str =~ s/\"/\"/g; - $str =~ s/\&/\&/g; - } - push @result, $str; - } - wantarray ? @result : $result[0]; -} - -sub html2tag { - my $tag = {}; - $_ = shift; - - s|^<||; - s|^(/?\w+)|| and $tag->{__top} = lc $1; - - while (1) { - s|([\w\-]+)=([\"\'])(.*?)\2|| and do { - $tag->{lc $1} = $3; - next; - }; - s|([\w\-]+)=([^\s\>]+)|| and do { - $tag->{lc $1} = $2; - next; - }; - s,(\w+|/),, and do { - $tag->{__end} = lc $1; - next; - }; - last; - } - - my $new = {}; - foreach (keys %$tag) { - $new->{unescape_tag($_)} = unescape_tag($tag->{$_}); - } - $new; -} - -sub tag2html { - my $tag = shift; - - my $html; - $html .= '<' . $tag->{__top}; - foreach (keys %$tag) { - /^__/ and next; - $html .= sprintf ' %s="%s"', escape_tag($_), escape_tag($tag->{$_}); - } - defined $tag->{__end} and - $html .= ' ' . $tag->{__end}; - - $html .= '>'; - $html; -} - -sub set_form { - goto &setform; -} -sub setform { - # $uri: URI - my ($this, $uri, $name) = @_; - defined $name or $name = ''; - - if (!UNIVERSAL::isa($uri, 'URI')) { - croak "Usage: Template->setform(URI [, name])"; - } - - $SETFORM_SUPPORTED or - croak "Install URI::QueryParam to enable setform"; - - my $is_xhtml = ($this->{current} =~ m|^\s*<\?xml|); - - my $outhtml = ''; - my $in_select; # name - my $in_select_option_tag; # tag - my $in_textarea; # name - my $in_form = ''; # name - foreach (split /(<[^\<\>]+?>)/, $this->{current}) { - if (defined $in_select and defined $in_select_option_tag) { - my $value = ''; - /^([^ \<\r\n]*)/i and $value = $1; - - my $tag = $in_select_option_tag; - if (grep {$value eq $_} $uri->query_param($in_select)) { - $tag->{$is_xhtml ? 'selected' : '__end'} = 'selected'; - } - else { - delete $tag->{$is_xhtml ? 'selected' : '__end'}; - } - - $outhtml .= tag2html($tag); - undef $in_select_option_tag; - } - if (defined $in_textarea) { - if (!m|^|i) { - next; - } - } - - my $taghtml = $_; - if (!/^{__top}) { - $outhtml .= $taghtml; - } - elsif ($tag->{__top} eq 'form') { - if (defined($_ = $tag->{name})) { - $in_form = unescape_tag($_); - } - else { - $in_form = ''; - } - - if (!$tag->{action}) { - my $act = $uri->clone; - $act->query(undef); - $act->fragment(undef); - $tag->{action} = $act->canonical->as_string; - } - - $outhtml .= tag2html($tag); - } - elsif ($name ne $in_form) { - $outhtml .= $taghtml; - } - elsif ($tag->{__top} eq 'input') { - if (defined $tag->{name}) { - my $type = $tag->{type}; - if (!$type or - grep {$_ eq $type} qw[text password hidden submit]) { - if (defined(my $value = $uri->query_param($tag->{name}))) { - $tag->{value} = $value; - } - $outhtml .= tag2html($tag); - } - elsif (grep {$_ eq $type} qw[radio checkbox]) { - if (defined $tag->{value} and - grep {$_ eq $tag->{value}} - $uri->query_param($tag->{name})) { - $tag->{$is_xhtml ? 'checked' : '__end'} = 'checked'; - } - else { - delete $tag->{$is_xhtml ? 'checked' : '__end'}; - } - $outhtml .= tag2html($tag); - } - else { - $outhtml .= $taghtml; - } - } - else { - $outhtml .= $taghtml; - } - } - elsif ($tag->{__top} eq 'textarea') { - if (defined($_ = $tag->{name})) { - $in_textarea = $_; - $outhtml .= tag2html($tag); - if (defined(my $value = $uri->query_param($_))) { - $outhtml .= escape_tag($value); - } - } - else { - $outhtml .= tag2html($tag); - } - } - elsif ($tag->{__top} eq '/textarea') { - $outhtml .= tag2html($tag); - undef $in_textarea; - } - elsif ($tag->{__top} eq 'select') { - if (defined($_ = $tag->{name})) { - $in_select = $_; - } - $outhtml .= tag2html($tag); - } - elsif ($tag->{__top} eq '/select') { - $outhtml .= tag2html($tag); - undef $in_select; - } - elsif (defined $in_select) { - if ($tag->{__top} eq 'option') { - if (defined(my $val = $tag->{value})) { - if (grep {$val eq $_} $uri->query_param($in_select)) { - $tag->{$is_xhtml ? 'selected' : '__end'} = 'selected'; - } - else { - delete $tag->{$is_xhtml ? 'selected' : '__end'}; - } - $outhtml .= tag2html($tag); - } - else { - $in_select_option_tag = $tag; - } - } - else { - $outhtml .= $taghtml; - } - } - else { - $outhtml .= $taghtml; - } - } - - $this->{current} = $outhtml; -} - -sub add_hidden_form { - goto &addhiddenform; -} -sub addhiddenform { - # $uri: URI or HASH - my ($this, $uri, $name) = @_; - defined $name or $name = ''; - - $SETFORM_SUPPORTED or - croak "Install URI::QueryParam to enable setform"; - - if (!UNIVERSAL::isa($uri, 'URI')) { - if (UNIVERSAL::isa($uri, 'HASH')) { - my $u = URI->new('', 'http'); - while (my ($key, $value) = each %$uri) { - $u->query_param( - $key => UNIVERSAL::isa($value, 'ARRAY') ? @$value : $value); - } - $uri = $u; - } - else { - croak "\$uri was not URI nor HASH"; - } - } - - my $is_xhtml = ($this->{current} =~ m|^\s*<\?xml|); - - my $outhtml = ''; - foreach (split /(<[^\<\>]+?>)/, $this->{current}) { - my $taghtml = $_; - if (!/^{__top} and - $tag->{__top} eq 'form' and - !$tag->{action}) { - my $act = $uri->clone; - $act->query(undef); - $act->fragment(undef); - $tag->{action} = $act->canonical->as_string; - - $outhtml .= tag2html($tag); - } - else { - $outhtml .= $taghtml; - } - - if (defined $tag->{__top} and - $tag->{__top} eq 'form') { - if ((!defined $tag->{name} and $name eq '') or - (defined $tag->{name} and $name eq $tag->{name})) { - foreach my $key ($uri->query_param) { - my $format = $is_xhtml ? - q{} : - q{}; - $outhtml .= sprintf($format, $key, $uri->query_param($key)); - } - } - } - } - - $this->{current} = $outhtml; -} - -sub disable_form { - goto &disableform; -} -sub disableform { - my ($this, $keylist, $name) = @_; - defined $name or $name = ''; - - my %keyhash = map {$_ => 1} @$keylist; - - my $is_xhtml = ($this->{current} =~ m|^\s*<\?xml|); - - my $outhtml = ''; - my $in_textarea; # name - my $in_form = ''; - foreach (split /(<[^\<\>]+?>)/, $this->{current}) { - my $taghtml = $_; - if (!/^|i) { - next; - } - } - - my $tag = html2tag($taghtml); - - if (!defined $tag->{__top}) { - $outhtml .= $taghtml; - } - elsif ($tag->{__top} eq 'form') { - if (defined($_ = $tag->{name})) { - $in_form = unescape_tag($_); - } - else { - $in_form = ''; - } - - $outhtml .= tag2html($tag); - } - elsif ($name ne $in_form) { - $outhtml .= $taghtml; - } - elsif ($tag->{__top} eq 'textarea') { - $in_textarea = 1; - $outhtml .= tag2html($tag); - } - elsif ($tag->{__top} eq '/textarea') { - $outhtml .= tag2html($tag); - undef $in_textarea; - } - elsif ($tag->{__top} eq 'input' or - $tag->{__top} eq 'select' or - $tag->{__top} eq 'textarea') { - - my $name = $tag->{name}; - if ($name and $keyhash{$name}) { - # disable this - $tag->{$is_xhtml ? 'disabled' : '__end'} = 'disabled'; - - # nameを消したいところだが、多分消した時の動作は實裝依存になる。 - # 代はりにnameを別の名前に變換する。 - $tag->{name} = sprintf 'DiSaBLeD_%s_DiSaBLeD', $tag->{name}; - } - - $outhtml .= tag2html($tag); - } - else { - $outhtml .= $taghtml; - } - } - - $this->{current} = $outhtml; -} - -1; rmfile ./Template.pm hunk ./RssC/Formatter.pm 1 -# -*- cperl -*- -package RssC::Formatter; -use strict; -use warnings; -use CGI; -use XML::RSS; -use Time::Zone; - -sub new { - my ($class, $uri, $lastmod, $title) = @_; - my $this = bless {} => $class; - - $this->{uri} = $uri; - $this->{lastmod} = $lastmod; - $this->{title} = $title; - - $this; -} - -sub format { - my $this = shift; - my $rss = XML::RSS->new(version => '1.0'); - - my ($sec, $min, $hour, $day, $mon, $year) = localtime($this->{lastmod}); - $mon++; - $year += 1900; - - my $tz_hour = tz_local_offset() / 60 / 60; - my $tz_min = tz_local_offset() / 60 - $tz_hour * 60; - - my $w3c_lastmod = sprintf( - '%04d-%02d-%02dT%02d:%02d:%02d+%02d:%02d', - $year, $mon, $day, $hour, $min, $sec, $tz_hour, $tz_min); - - $rss->channel( - title => $this->{title} || $this->{uri}->as_string, - link => $this->{uri}->as_string, - description => 'Generated by RssC', - - dc => { - date => $w3c_lastmod, - }, - ); - - $rss->add_item( - title => sprintf( - '[RssC] %02d-%02d-%02d %02d:%02d:%02d +%02d:%02d', - $year, $mon, $day, $hour, $min, $sec, $tz_hour, $tz_min), - link => $this->{uri}->as_string, - dc => { - date => $w3c_lastmod, - }, - ); - - $rss->as_string; -} - -1; rmfile ./RssC/Formatter.pm hunk ./RssC/Filter/Koshiandoh.pm 1 -# -*- cperl -*- -package RssC::Filter::Koshiandoh; -use base RssC::Filter; -use strict; -use warnings; - -sub new { - my $class = shift; - my $this = $class->SUPER::new(@_); - $this->{skip_until} = ''; - $this; -} - -sub interested_p { - my ($this, $uri) = @_; - $uri->host eq 'koshiandoh.com'; -} - -sub filter { - my ($this, $uri, $line) = @_; - - # 手抜き - $line =~ tr/0-9,//d; - - my $ad_begin = 'Special Links'; - my $ad_end = "\0" x 256; - - if ($this->{skip_until} ne '') { - if (index($line, $this->{skip_until}) != -1) { - $this->{skip_until} = ''; - } - } - elsif (index($line, $ad_begin) != -1) { - $this->{skip_until} = $ad_end; - } - else { - return $line; - } - return ''; -} - -1; rmfile ./RssC/Filter/Koshiandoh.pm hunk ./RssC/Filter/Isweb.pm 1 -# -*- cperl -*- -package RssC::Filter::Isweb; -use base RssC::Filter; -use strict; -use warnings; - -sub new { - my $class = shift; - my $this = $class->SUPER::new(@_); - $this->{skip_until} = ''; - $this; -} - -sub interested_p { - my ($this, $uri) = @_; - $uri->host =~ m/infoseek\.co\.jp$/; -} - -sub filter { - my ($this, $uri, $line) = @_; - - my $ad_begin_1 = ''; - my $ad_begin_2 = ''; - - if ($this->{skip_until} ne '') { - if (index($line, $this->{skip_until}) != -1) { - $this->{skip_until} = ''; - } - } - elsif (index($line, $ad_begin_1) != -1 or - index($line, $ad_begin_2) != -1) { - $this->{skip_until} = $ad_end; - } - else { - return $line; - } - return ''; -} - -1; rmfile ./RssC/Filter/Isweb.pm hunk ./RssC/Filter/GeocitiesJP.pm 1 -# -*- cperl -*- -package RssC::Filter::GeocitiesJP; -use base RssC::Filter; -use strict; -use warnings; - -sub new { - my $class = shift; - my $this = $class->SUPER::new(@_); - $this->{skip_until} = ''; - $this; -} - -sub interested_p { - my ($this, $uri) = @_; - $uri->host =~ m/geocities\.jp$/ or - $uri->host =~ m/geocities\.co\.jp$/; -} - -sub filter { - my ($this, $uri, $line) = @_; - - my $begin1 = ''; - my $end1 = ''; - - my $begin2 = ''; - - if ($this->{skip_until} ne '') { - if (index($line, $this->{skip_until}) != -1) { - $this->{skip_until} = ''; - } - } - elsif (index($line, $begin1) != -1) { - $this->{skip_until} = $end1; - } - elsif (index($line, $begin2) != -1) { - $this->{skip_until} = '\0' x 256; # never occurs - } - else { - return $line; - } - return ''; -} - -1; rmfile ./RssC/Filter/GeocitiesJP.pm hunk ./RssC/Filter.pm 1 -# -*- cperl -*- -package RssC::Filter; -use strict; -use warnings; - -sub new { - my $class = shift; - my $this = bless {} => $class; - - $this; -} - -sub interested_p { - # 眞僞値を返す。 - # 眞: このURIについては初めからGETメソッドを使用。 - # またフィルタリング時にこのフィルタを使用。 - # 僞: このフィルタはこのURIに興味が無い。 - my ($this, $uri) = @_; - - die "Internal error: ".ref($this)." doesn't override want_content(\$uri)!\n"; -} - -sub filter { - # フィルタ後の行を返す。 - my ($this, $uri, $line) = @_; - - die "Internal error: ".ref($this)." doesn't override filter(\$uri, \$line)!\n"; -} - -1; rmfile ./RssC/Filter.pm hunk ./RssC/DB.pm 1 -# -*- cperl -*- -package RssC::DB; -use strict; -use warnings; -use DBI; -use constant CURRENT_SCHEMA_VER => 0; -use constant MINIMUM_SCHEMA_VER => 0; -require Exporter; -our @ISA = qw(Exporter); -our @EXPORT = qw(&DB); -my $DB; - -sub DB () { - if ($DB) { - $DB->{dbh}; - } - else { - $DB = __PACKAGE__->_new; - $DB->{dbh}; - } -} - -sub _new { - my $class = shift; - my $this = bless {} => $class; - - $this->{dbh} = DBI->connect( - 'dbi:SQLite:dbname=rssc.db', - '', '', { - RaiseError => 1, - AutoCommit => 1, - }); - - if (!$this->{dbh}) { - die "Failed to open SQLite3 database rssc.db"; - } - - $this->_setup_db; - $this; -} - -sub _setup_db { - my $this = shift; - - eval { - $this->{dbh}->do('SELECT * FROM schema_ver LIMIT 0'); - }; - if ($@) { - # DBが空。 - $this->{dbh}->do(q{ -CREATE TABLE schema_ver ( - current INTEGER, - minimum INTEGER -)}); - - $this->{dbh}->do(q{ - INSERT INTO schema_ver - (current, minimum) - VALUES (? , ? ) - }, undef, CURRENT_SCHEMA_VER, MINIMUM_SCHEMA_VER); - - $this->{dbh}->do(q{ -CREATE TABLE uri ( - uri_id INTEGER PRIMARY KEY, - uri VARCHAR(255), - - UNIQUE (uri) -)}); - - $this->{dbh}->do(q{ -CREATE TABLE title ( - uri_id INTEGER, - title BLOB, - - UNIQUE (uri_id) -)}); - - $this->{dbh}->do(q{ -CREATE TABLE user_title ( - uri_id INTEGER, - user_title BLOB, - - UNIQUE (uri_id) -)}); - - $this->{dbh}->do(q{ -CREATE TABLE md5 ( - uri_id INTEGER, - md5 CHAR(32), - - UNIQUE (uri_id) -)}); - - $this->{dbh}->do(q{ -CREATE TABLE last_modified ( - uri_id INTEGER, - lastmod INTEGER, - - UNIQUE (uri_id) -)}); - - } - else { - my $row = $this->{dbh}->selectrow_hashref(q{ - SELECT * - FROM schema_ver - LIMIT 1 - }); - if (CURRENT_SCHEMA_VER < $row->{minimum}) { - die sprintf( - "DB Version Mismatch:\n". - " - DB minimum : %d\n". - " - DB current : %d\n". - " - Code current: %d\n", - @$row{qw(minimum current)}, CURRENT_SCHEMA_VER); - } - } -} - -1; rmfile ./RssC/DB.pm hunk ./RssC/Checker.pm 1 -# -*- cperl -*- -package RssC::Checker; -use strict; -use warnings; -use RssC::DB; -use RssC::Filter; -use File::Spec; -use LWP::UserAgent; -use HTTP::Cookies; -use HTTP::Status; -use Digest::MD5; -use Encode qw(from_to); -use Encode::Alias; -use Encode::Guess; -my @FILTER; -my $LWP; -my $COOKIE_JAR; - -BEGIN { - define_alias qr/^shift.*jis$/i => '"cp932"'; - define_alias qr/^(x-)?sjis(-jp)?$/i => '"cp932"'; -} - -BEGIN { - my $filter_pm = $INC{'RssC/Filter.pm'}; - my @dirpath = File::Spec->splitdir($filter_pm); - pop @dirpath; - my $dirpath = File::Spec->catdir(@dirpath); - - foreach my $modfile (<$dirpath/Filter/*.pm>) { - require $modfile; - - $_ = $modfile; - s!^$dirpath/Filter/!!; - s!\.pm$!!; - my $modname = 'RssC::Filter::' . $_; - push @FILTER, $modname; - } -} - -sub LWP () { - if ($LWP) { - return $LWP; - } - - $COOKIE_JAR = HTTP::Cookies->new( - file => 'lwp_cookies.dat'); - - $LWP = LWP::UserAgent->new; - $LWP->timeout(120); - $LWP->agent('Mozilla/1.5 ("RssC" -- RSS Concoction)'); - $LWP->cookie_jar($COOKIE_JAR); - $LWP->parse_head(1); - $LWP; -} - -sub uri_id { - if ($_[0] and $_[0] eq __PACKAGE__) { - shift @_; - } - my $uri = shift; - - my ($uri_id) = DB->selectrow_array(q{ - SELECT uri_id - FROM uri - WHERE uri = ? - }, undef, "$uri"); - if (!$uri_id) { - # まだURI IDが割當てられてゐない。 - DB->do(q{ - INSERT INTO uri - (uri) - VALUES (? ) - }, undef, "$uri"); - $uri_id = DB->last_insert_id(undef, undef, undef, undef); - } - - $uri_id; -} - -sub check { - my ($class, $uri) = @_; - - # 1. どのフィルタも興味を持たないURIは、 - # If-Modified-Since 付きでGETして、 - # Last-Modifiedが無ければ中身のMD5を取る。 - # 2. 何れかのフィルタが興味を持つURIは、 - # 最初から If-Modified-Since 無しで GET する。 - my @interested_filters; - foreach (@FILTER) { - my $mod = $_->new; - if ($mod->interested_p($uri)) { - push @interested_filters, $mod; - } - } - - my ($old_lastmod) = DB->selectrow_array(q{ - SELECT lastmod - FROM last_modified - LEFT JOIN uri USING (uri_id) - WHERE uri = ? - }, undef, $uri->as_string); - - my ($old_title) = DB->selectrow_array(q{ - SELECT title - FROM title - LEFT JOIN uri USING (uri_id) - WHERE uri = ? - }, undef, $uri->as_string); - - my $req = HTTP::Request->new( - GET => $uri->as_string, - ); - - if (!@interested_filters) { - # lastmodが存在するなら、If-Modified-Sinceを付けてリクエスト。 - if ($old_lastmod) { - $req->headers->if_modified_since($old_lastmod); - } - } - - my $resp = LWP->request($req); - $COOKIE_JAR->save; - - if ($resp->code eq RC_NOT_MODIFIED) { - # 更新されてゐないので終了。 - return ($old_lastmod, $old_title); - } - elsif ($resp->code eq RC_OK) { - # 取得成功。 - my $new_lastmod; - if (!@interested_filters and - $resp->headers->last_modified) { - # Last-Modifiedを受け取った。 - $new_lastmod = $resp->headers->last_modified; - } - - my $md5 = Digest::MD5->new; - foreach my $line (split /\r?\n|\r/, $resp->content) { - foreach my $filter (@interested_filters) { - $line = $filter->filter($uri, $line); - } - $md5->add($line); - } - - # DBに登録 - DB->do(q{BEGIN IMMEDIATE}); - - my $uri_id = uri_id($uri); - - my $title = do { - my $t = $resp->header('Title'); - # charset付きのContent-Typeを探し、最後に見付けたものを採用する。 - # parse_headによつて最後にhtml本文がパースされる爲。 - my $charset; - foreach ($resp->header('Content-Type')) { - foreach (split /\s*;\s*/, lc) { - if (m/^charset=(.+)$/i) { - $charset = $1; - } - } - } - if ($charset) { - from_to($t, $charset, 'UTF-8', Encode::FB_XMLCREF); - } - else { - my $enc = guess_encoding( - $t, qw/euc-jp cp932 iso-2022-jp utf8/, - ); - $enc and - from_to($t, $enc, 'UTF-8', Encode::FB_XMLCREF); - } - $t; - }; - - my ($old_title) = DB->selectrow_array(q{ - SELECT title - FROM title - WHERE uri_id = ? - }, undef, $uri_id); - - if ($title and - (!$old_title or - $old_title ne $title)) { - DB->do(q{ - REPLACE INTO title - (uri_id, title) - VALUES (? , ? ) - }, undef, $uri_id, $title); - } - else { - DB->do(q{ - DELETE FROM title - WHERE uri_id = ? - }, undef, $uri_id); - } - - if ($new_lastmod) { - # lastmodのみをREPLACE。 - # MD5は削除。 - - DB->do(q{ - DELETE FROM md5 - WHERE uri_id = ? - }, undef, $uri_id); - - DB->do(q{ - REPLACE INTO last_modified - (uri_id, lastmod) - VALUES (? , ? ) - }, undef, $uri_id, $new_lastmod); - } - else { - my $new_md5hex = $md5->hexdigest; - my ($old_md5hex) = DB->selectrow_array(q{ - SELECT md5 - FROM md5 - WHERE uri_id = ? - }, undef, $uri_id); - - if ($old_md5hex and - $new_md5hex eq $old_md5hex) { - # MD5に變化無し => 更新時刻に變化無し - $new_lastmod = $old_lastmod; - } - else { - # 新しいMD5と更新時刻をREPLACE - $new_lastmod = time; - - DB->do(q{ - REPLACE INTO md5 - (uri_id, md5) - VALUES (? , ? ) - }, undef, $uri_id, $new_md5hex); - - DB->do(q{ - REPLACE INTO last_modified - (uri_id, lastmod) - VALUES (? , ? ) - }, undef, $uri_id, $new_lastmod); - } - } - - DB->do(q{COMMIT}); - return ($new_lastmod, $title); - } - else { - die sprintf "Failed to fetch url [%s]: %s\n", - $uri->as_string, - $resp->status_line; - } -} - -1; rmfile ./RssC/Checker.pm hunk ./Makefile 1 -clean: - find . -name '*~' -exec rm -f {} \; - -VER = $(shell perl -ne 'm/(our \$$VERSION = .+)$$/ and do {eval $$1; print $$VERSION, "\n"}' rssc.cgi) -DIST = rssc-$(VER) -dist: clean - mkdir -p $(DIST) - rsync --exclude '.arch-*' -r ChangeLog.arch Makefile RssC *.pm css rssc.cgi *.pl *.sql tmpl $(DIST) - zip -r $(DIST).zip $(DIST) - rm -rf $(DIST) rmfile ./Makefile hunk ./ChangeLog.arch 1 -# do not edit -- automatically generated by arch changelog -# arch-tag: automatic-ChangeLog--pho@cielonegro.org--2006/rssc--mainline--1.0 -# - -2006-10-22 03:15:45 GMT phonohawk patch-6 - - Summary: - DBD::SQLite doesn't handle $dbh->begin_work...? - Revision: - rssc--mainline--1.0--patch-6 - - * DBD::SQLite seems not to handle $dbh->begin_work... - Replacing them with $dbh->do(q{BEGIN}) seems to work..... - - - - - modified files: - ChangeLog.d/ChangeLog.2006 RssC/Checker.pm RssC/Formatter.pm - rssc.cgi setup.pl - - -2006-01-29 03:30:24 GMT phonohawk patch-5 - - Summary: - Added Makefile - Revision: - rssc--mainline--1.0--patch-5 - - * Added Makefile - - new files: - .arch-ids/Makefile.id Makefile - - modified files: - ChangeLog.d/ChangeLog.2006 rssc.cgi {arch}/=tagging-method - - -2006-01-29 01:59:50 GMT phonohawk patch-4 - - Summary: - Added RSS-URL generator - Revision: - rssc--mainline--1.0--patch-4 - - * Added RSS-URL generator - - modified files: - ChangeLog.d/ChangeLog.2006 Template.pm css/style.css rssc.cgi - tmpl/index.html - - -2006-01-28 09:44:42 GMT phonohawk patch-3 - - Summary: - Added setup.pl - Revision: - rssc--mainline--1.0--patch-3 - - * Added setup.pl: - This script can be reused later! - - new files: - .arch-ids/setup.pl.id setup.pl - - modified files: - ChangeLog.d/ChangeLog.2006 - - -2006-01-28 04:28:10 GMT phonohawk patch-2 - - Summary: - A slight fix to the css. / more - Revision: - rssc--mainline--1.0--patch-2 - - * A slight fix to the css. - - * Stop inserting NULL into `title`. - - modified files: - ChangeLog.d/ChangeLog.2006 RssC/Checker.pm css/style.css - - -2006-01-27 18:41:58 GMT phonohawk patch-1 - - Summary: - Added Koshiandoh.pm / more - Revision: - rssc--mainline--1.0--patch-1 - - * Added Koshiandoh.pm - - * Fixed Geocities.pm, Isweb.pm - - * more - - new files: - ChangeLog.d/.arch-ids/=id - ChangeLog.d/.arch-ids/ChangeLog.2006.id - ChangeLog.d/ChangeLog.2006 - RssC/Filter/.arch-ids/Koshiandoh.pm.id - RssC/Filter/Koshiandoh.pm - - modified files: - RssC/Checker.pm RssC/Filter/GeocitiesJP.pm - RssC/Filter/Isweb.pm rssc.cgi - - new directories: - ChangeLog.d ChangeLog.d/.arch-ids - - -2006-01-27 07:30:14 GMT phonohawk base-0 - - Summary: - Initial import into GNU Arch - Revision: - rssc--mainline--1.0--base-0 - - * Initial import into GNU Arch - - new files: - RssC/Checker.pm RssC/DB.pm RssC/Filter.pm - RssC/Filter/GeocitiesJP.pm RssC/Filter/Isweb.pm - RssC/Formatter.pm Template.pm css/style.css rssc.cgi rssc.pl - schema.sql tmpl/index.html - - rmfile ./ChangeLog.arch hunk ./.boring 1 -# Boring file regexps: -\.hi$ -\.hi-boot$ -\.o-boot$ -\.o$ -\.o\.cmd$ -# *.ko files aren't boring by default because they might -# be Korean translations rather than kernel modules. -# \.ko$ -\.ko\.cmd$ -\.mod\.c$ -(^|/)\.tmp_versions($|/) -(^|/)CVS($|/) -\.cvsignore$ -^\.# -(^|/)RCS($|/) -,v$ -(^|/)\.svn($|/) -\.bzr$ -(^|/)SCCS($|/) -~$ -(^|/)_darcs($|/) -\.bak$ -\.BAK$ -\.orig$ -\.rej$ -(^|/)vssver\.scc$ -\.swp$ -(^|/)MT($|/) -(^|/)\{arch\}($|/) -(^|/).arch-ids($|/) -(^|/), -\.prof$ -(^|/)\.DS_Store$ -(^|/)BitKeeper($|/) -(^|/)ChangeSet($|/) -\.py[co]$ -\.elc$ -\.class$ -\# -(^|/)Thumbs\.db$ -(^|/)autom4te\.cache($|/) -(^|/)config\.(log|status)$ -^\.depend$ -(^|/)(tags|TAGS)$ -#(^|/)\.[^/] -(^|/|\.)core$ -\.(obj|a|exe|so|lo|la)$ -^\.darcs-temp-mail$ - -^\.htaccess$ -^lwp_cookies\.dat$ -^rssc\.db$ rmfile ./.boring rmdir ./tmpl rmdir ./css rmdir ./RssC/Filter rmdir ./RssC }