404 motivation not found | t_ishidaのブログ

2月/08

5

使えないRSSリーダー

ふだん、ブックマークするのが「はてブ」で、RSSリーダーでクリップするのが「livedoorクリップ」。これは両方を見るのが面倒になってきたので、こんなの作ってみた。うん、ただの使えないRSSリーダーだね。僕もそう思って、これ以上追求しない事にした。

はい、そこ!!「それプラ」って言ったら、お前が寝る前に、死んだはずのお婆ちゃんが念仏を唱えながら枕元を徘徊する呪い」をかけてやる。

use strict;
use lib '../public_html/cgi-bin/news_juice/lib';
use Web::WebDoc;
use Encode;
sub say {
my $buf = join ('', @_ );
Encode::from_to( $buf, 'utf8', 'sjis' );
print "$buf\n";
}
my %url = (
'はてブ'   => "http://b.hatena.ne.jp/t_ishida/rss" ,
'livedoor' => "http://clip.livedoor.com/rss/clips/ishida_tak" ,
);
my $webdoc = Web::WebDoc->new();
foreach my $key( keys %url ){
say "<<$key>>";
my $rss = $webdoc->parseRSS( $url{$key} );
my $buf = Dumper($rss);
foreach my $item( @{$rss->{items}} ){
say "■$item->{title}(by $item->{author} at $item->{date})";
say "\t$item->{url}";
say "\t$item->{summary}";
say;
}
say;
say;
}

で、WebDocって言うのが、

昔、xyzzy::CGIと言う、フレームワーク(笑)みたいなのを作って、公開してやろうと思っていたのだが、特に特徴の無いライブラリ群になってしまったので、何もしていない奴の一部。その場の都合だけで、拡張したり、消したりし過ぎて、カオスだが気にするな。若いよね、自前のxDocコメントとか作って、そのパーサーも一緒に公開しようとしてたんだから。

use strict;
#@-----------------------------------------------------------#
# Web上で取り扱われるドキュメントを表す
# 主な機能
#   1、テンプレートから、HTMLを作成する
#   2、ハッシュリファレンスからXMLを作成する
#   3、URLからHTMLを取得する
#   4、URLからXMLを取得してパースする
# @author : t_ishida
# @ver    : 0.0.0.0.0.1
# @tested : 0
#-----------------------------------------------------------@#
package Web::WebDoc;
use Carp;
use JSON;
use LWP::UserAgent;
use XML::Simple;
use XML::FeedPP;
use base 'Util::File';
use Encode;

#@-----------------------------------------------------------#
# コンストラクタ、渡されたパラメタ名により初期化を振り分ける
# @param_ptn1 : ハッシュリファレンス => XML化
# @param_ptn2 : URI                  => 'URLからHTMLまたはXMLを取り出して初期化するURL'
# @param_ptn3 : template             => 'HTMLテンプレート'       , data => 'HTMLテンプレートに渡すデータ'
# @param_ptn4 : contents             => 'そのまんま出力する本文' , header=> '出力するヘッダ'
#-----------------------------------------------------------@#
sub new{
my $class = shift;
my $obj   = bless {};
my (%param , $h);

##ハッシュか、ハッシュリファレンスか?
if( $#_ == 0 ){ $h     = shift; }
else          { %param = @_;    }

##なんか言わばオーバーロード
if    ( $h eq 'HASH' ){ $obj->_initAsXML($h) }
elsif ( $param{type} ){
##これは、なんかプラグインにして上手いことやりたいね。
$obj->_initAsXML($param{data})      if $param{type} =~/xml/i;
$obj->_initAsJSON($param{data})     if $param{type} =~/json/i;
}
elsif( $param{URI}          ){ $obj->_initByURI( \%param );         }
elsif( $param{file}         ){ $obj->_initByFile( \%param );        }
elsif( $param{template}     ){ $obj->_initByTemplate( \%param );    }
elsif( $param{contents}     ){ $obj->{contents} = $param{contents}; }
$obj->{header} = $param{header} if $param{header};
return $obj;
}

sub header:lvalue{shift->{header};}
sub contents:lvalue{shift->{contents};}
#@-----------------------------------------------------------#
# ヘッダを追加する
# @param : headername => headervalue
#-----------------------------------------------------------@#
sub addHeader{
my $self = shift;
my %param = @_;

$self->{header} .= "$_: $param{$_}\n" for keys %param;
}

#@---------------------------------------------------------------#
# 現在のコンテンツから、<meta name="description">の中身を取得する
# @ret : contents ="(この部分を返却)"
#---------------------------------------------------------------@#
sub getSummary{
$_[0]->{contents} =~/<meta name=["']description["'] content=["']([^"']+)['"]>/gi;
return $1;
}

#@---------------------------------------------------------------#
# ヘッダと本文をくっつけて返す
# @ret : ヘッダと本文をくっつけた文字列
#---------------------------------------------------------------@#
sub out{
my ($self) = @_;
my $h = $self->{header};
$h =~s/\n*$/\n\n/;
return $h.$self->{contents};
}

#@---------------------------------------------------------------#
# 自身がファイルであればファイルの存在チェック
# 自身がURIから取得したドキュメントであれば、URIの存在チェック
# @ret : bool =  is contents exists?
#---------------------------------------------------------------@#
sub isExists{
my($self) = @_;
if( $self->{URI} ){
my $ua = LWP::UserAgent->new();
$ua->proxy(['http', 'ftp'] => $self->{proxy}) if $self->{proxy};

my $req = HTTP::Request->new( POST => $self->{URI} );
$req->content_type('application/x-www-form-urlencoded');
$req->content('match=www&errors=0');

my $res = $ua->request($req);
return $res->is_success;
} elsif($self->{path}) {
return -e $self->{path};
}else{
return 0;
}
}

#@---------------------------------------------------------------#
# 自身の本文に格納されているXMLをハッシュリファレンスとして返す
# @ret : 本文をパースした結果
#---------------------------------------------------------------@#
sub parseXML{
my( $self ) = @_;
croak '何をパースするんんだい?' if !$self->{contents};
my $xs  = XML::Simple->new(forcearray=>1);
my $xml = $self->{contents};
eval {$xml = $xs->XMLin($xml); };
croak "XMLパースに失敗したらしいけど" . $@ if $@;
return $xml;
}

#@---------------------------------------------------------------#
# 自身の本文に格納されているJSONをハッシュリファレンスとして返す
# @ret : 本文をパースした結果
#---------------------------------------------------------------@#
sub parseJSON{
my( $self ) = @_;
croak '何をパースするんんだい?' if !$self->{contents};
my $json = $self->{contents};
eval {$json = jsonToObj($json) ; };
croak "XMLパースに失敗したらしいけど" . $@ if $@;
return $json;
}

#@---------------------------------------------------------------#
# 指定されたURIのRSSをパースする
# @ret : 本文をパースした結果
#---------------------------------------------------------------@#
sub parseRSS{
my( $self, $url ) = @_;
croak '何をパースするんんだい?' if !$url && $self->{URI};

##URLの指定が有る場合,$self->{contents}をパースするのは未実装
my $feed = XML::FeedPP->new( $url );
my $ret = {
title       => $feed->title       ,
description => $feed->description ,
date        => $feed->pubDate ,
items       => [] ,
};
foreach my $item ( $feed->get_item ){
push @{$ret->{items}} ,
{
'author'   => $item->author()    || ''     ,
'category' => $item->category()  || [] ,
'url'      => $item->link()        ,
'title'    => $item->title()       ,
'summary'  => $item->description() ,
'date'     => $item->pubDate()     ,
}
}
return $ret;
}

#@---------------------------------------------------------------#
# 自身を渡されたハッシュリファレンスからXMLとして初期化する
# @param : {elm_name => elm_value}
#---------------------------------------------------------------@#
sub _initAsXML{
my( $self , $param ) = @_;
croak 'XML化出来そうに無いわけだが?' if ref $param !~/(?:ARRAY|HASH)/;
my $xs  = XML::Simple->new(forcearray=>1);
my $xml;
eval {  $xml = $xs->XMLout($param); };
croak "XML化に失敗したらしいけど?" . $@ if $@;
$self->{contents} = '<?xml version="1.0" encoding="utf-8" ?>'."\n$xml";
}

#@---------------------------------------------------------------#
# 自身を渡されたハッシュリファレンスからJSONとして初期化する
# @param : {elm_name => elm_value}
#---------------------------------------------------------------@#
sub _initAsJSON{
my( $self , $param ) = @_;
croak 'JSON化出来そうに無いわけだが?' if ref $param !~/(?:ARRAY|HASH)/;
my $json;
eval {  $json = objToJson($param); };
croak "Json化に失敗したらしいけど?" . $@ if $@;
$self->{contents} = $json;
}

#@---------------------------------------------------------------#
# ファイルを読み込んで自身を初期化する
# @param : {file=>'ファイルパス'' , charset=>'ヘッダに載せる文字コード'}
#---------------------------------------------------------------@#
sub _initByFile{
my( $self , $param ) = @_;

$param           = {file=>$param}    if ref $param eq '';
$self->{file}    = $param->{file}    if $param->{file};
$self->{charset} = $param->{charset} if $param->{charset};
return                               if !$self->{file};
$self->{charset} = 'utf8'            if !$self->{charset};

$self->readALL($self->{file});
$self->{header} = "Content-type: text/html CHARSET=$self->{charset}\n\n";
}

#@---------------------------------------------------------------#
# URLから自身を初期化する
# @param_ptn1 : $doc->initByURI('http://adn.jp/');
# @param_ptn2 : $doc->initByURI({URI=>'http://adn.jp/',proxy=>'http://proxy.adn.jp/'});
# @exception1 : URLの指定が無い
# @exception2 : URLが存在しない
#---------------------------------------------------------------@#
sub _initByURI{
my( $self ,$param ) = @_;
$param           = {URI=>$param}          if ref $param eq '';
$self->{URI}     = $param->{URI}          if $param->{URI};
croak 'URLのやる気が有りません'           if !$self->{URI};
$self->{proxy}   = $param->{proxy}        if $param->{proxy};

my $ua = LWP::UserAgent->new();
$ua->proxy(['http', 'ftp'] => $self->{proxy}) if $self->{proxy};

my $req = HTTP::Request->new( POST => $self->{URI} );
$req->content_type('application/x-www-form-urlencoded');
$req->content('match=www&errors=0');
my $res = $ua->request($req);
if( $res->is_success ){
my $contents;
my $header;
$contents = $res->content;
$header  .= "$_ : $res->headers->{$_}\n"  for keys %{$res->headers};

##エンコード
my $charset = '';
if ( ref $res->headers->{'content-type'} eq ''){
$res->headers->{'content-type'} =~/charset=("?[^"]+"?)/; #"色分けがおかしくなるので
$charset = $1;
} else {
for( @{$res->headers->{'content-type'}} ){
$charset = $1 and last if $_=~/charset=("?[^"]+"?)/; #"色分けがおかしくなるので
}
}
$charset = 'sjis' if $charset eq '';
if( $charset ne 'utf8' ){
Encode::from_to($contents, $charset, 'utf8');
Encode::from_to($header  , $charset, 'utf8');
}
$self->header   = $header;
$self->contents = $contents;
}
}

#@---------------------------------------------------------------#
# テンプレートから自身を初期化する
# @param : $doc->initByURI(template=>'テンプレートのパス',data=>{var_name=>var_val});
#---------------------------------------------------------------@#
sub _initByTemplate{
my( $self ,$param ) = @_;
my $engine;
my $t;
croak 'さすがにそれは無理'               if !$param;
croak 'テンプレート無し?'               if !$param->{template};
croak 'データ無し?'                     if !$param->{data};
croak 'ハッシュ以外は無理'               if !$param->{data} eq 'HASH';
$param->{engine} = 'Web::Engine::TE_HT'  if !$param->{engine};

eval "use $param->{engine};";
croak 'テンプレートエンジンのやる気がありません。'.$@ if $@;

$t = $param->{engine}->new($param->{template});
$t->param($param->{data});
$self->{contents} = $t->output;
}
1;

use baseに指定されているのはこれ。

use strict;
#@---------------------------------------------------------------------------#
# ファイルクラス
# あまり使い道の無いオブジェクト指向ファイル操作系のクラス
#
#@credate: 2006/11/01
#@ver    : 0.0.0.0.0.0.0.0.0.1
#@author : t_ishida
#---------------------------------------------------------------------------@#
package Util::File;
use Carp;

#@-------------------------------------------------------#
# コンストラクタ
# @param_ptn1 : パスのみ 
# @param_ptn2 : path=>'パス',contents=>'ファイルの中身'
#-------------------------------------------------------@#
sub new{
my $class = shift;
my %param;
if( $#_ == 0 ){ $param{path} = shift; }
else          { %param = @_;          }

##とりあえずnewしとけ
my $self =  bless {
path     => $param{path} ,
contents => $param{contents} ,
} , $class;

##ファイルが存在する場合には、いろいろやっておく。
if( !$self->{contents} && -e $self->{path} ){
##一応読み込んでおく
$self->readALL();

##ファイルステータスの使いそうな一部を取得する
my @buf = stat($self->{path});
@{%{$self}}{qw(size last_access last_update)} = @buf[(7 , 8 , 9)];
}
return $self;
}

#@-------------------------------------------------------#
# ファイルを自分自身の中身で保存する
# パスの指定が無い場合には、自分自身のパスに保存する。
# パスの指定が有る場合には、指定されたパスに保存する。
# @param       :保存先のパス(必須ではない)
# @exception1  : 自身のパスが存在しない場合
# @exception2  : 自身の中身が存在しない場合
#-------------------------------------------------------@#
sub save{
my($self , $path) = @_;

$self->{path} = $path                    if $path;

croak "パスの指定のやる気が有りません。"   if !$self->{path};
croak "保存する中身のやる気が有りません。" if !$self->{contents};

#  $self->{path}=~/^(.+)[/\/][^/\/]+$/;
#  croak "保存先のディレクトリのやる気が有りません" if !-d $1;

unlink $self->{path}                     if -e $self->{path};

open F, ">$self->{path}";
flock F ,2;
print F  $self->{contents};
close F;
return 1;
}

#@-------------------------------------------------------#
# 自身の複製を作成する。
# @param       : 複製先のパス
# @ret         : 複製のオブジェクト
# @exception1  : 自身のパスが存在しない場合
# @exception2  : 自身の中身が存在しない場合
# @exception3  : 複製先のパスが存在しない場合
#-------------------------------------------------------@#
sub copyTo{
my( $self, $dest ) = @_;
croak "パスの指定のやる気が有りません。"         if !$self->{path};
croak "保存する中身のやる気が有りません。"       if !$self->{contents};
croak "複製先のやる気が有りません。"             if !$dest;

#  $dest =~/^(.+)[/\/][^/\/]+$/;
#  croak "複製先のディレクトリのやる気が有りません" if $1 && !-d $1;

my $buf = Util::File->new(
path     => $dest ,
contents => $self->{contents}
);
$buf->save();
return $buf;
}

#@-------------------------------------------------------#
# 自身を指定先に移動する
# @param       : 移動先のパス
# @exception1  : 自身のパスが存在しない場合
# @exception2  : 自身の中身が存在しない場合
# @exception3  : 移動先のパスが存在しない場合
#-------------------------------------------------------@#
sub moveTo{
my( $self, $dest ) = @_;
my $buf = $self->copyTo($dest);
$self->killMe();
$self = $buf;
return 1;
}

#@-------------------------------------------------------#
# 自身を読み込む
# @param       : 読み込み先のパス(必須ではない)
# @exception1  : 読み込み先のパスが存在しない場合
#-------------------------------------------------------@#
sub readALL{
my( $self , $path ) = @_;
$self->{path} = $path                          if $path;
croak '読み込み先のパスのやる気が有りません。' if !-e $self->{path};
open F , $self->{path};
flock F,1;
$self->{contents} = join('', <F>);
close F;
return 1;
}

#@-------------------------------------------------------#
# 自身に値を書きこむ(保存はされない)
# @param       :書き込む値
#-------------------------------------------------------@#
sub writeALL{
$_[0]->{contents} = $_[1];
return 1;
}

#@-------------------------------------------------------#
# 自身に一行追記する(保存はされない)
# @param    :書き込む値
#-------------------------------------------------------@#
sub addLine{
$_[0]->{contents} .= "$_[1]\n";
return 1;
}

#@-------------------------------------------------------#
# 自身を削除する
# @param    :書き込む値
#-------------------------------------------------------@#
sub killMe{
croak '削除するファイルのやる気が有りません' if !-e $_[0]->{path};
unlink $_[0]->{path};
$_[0]->{path} = '';
return 1;
}
1;
Share and Enjoy:
  • Digg
  • del.icio.us
  • Google Bookmarks
  • Tumblr
  • email
  • Facebook
  • FriendFeed

RSS Feed

コメントはまだありません。

Leave a comment!

<< ちょっと、そこに座って話そうか?

今日微妙にはまったこと >>

Find it!

Theme Design by devolux.org

Tag Cloud