Home > Perl Archive

[ << < 6  7  8  9  10  11  12  13  14  15  16 >> ]

Perl Archive

フレームワーク (5) - 最低限の実装完了。。。したけど

最低限の実装は完了した。。。が、このまま作り続けていくと「CGI::Application じゃあかんの? 自分用のラッパ書いたらええやん」ということになりそうな香りがプンプンと。。。そんだけ CGI::Application がよくできてるってことだなぁ

シンプルなものが欲しいはずなのに、なぜ欲張ってしまうかというと「公開」と「汎用性」が気になるから。そして、書き始めるといろんなこと試したくなるから。趣味でやってると欲にキリがなくなるので、ひとまず「融通きかなくて俺しか使えないぜベイベー」仕様を意識

フレームワーク (4) - 枠組み完成

大枠できた。簡単なコマンドラインアプリは作れるレベル

  • PATH_INFO or QUERY_STRING で実行するメソッド振り分ける部分できた
  • REQUEST_METHOD で実行するメソッド振り分ける部分できた
  • TT 使う部分は未実装だが、構想はまとまった
  • HTTP header をあつかう部分を構想中
  • CGI::Minimal の全機能使いたいかなぁ。。。と思案中
  • mod_perl とか fcgi とかについて思案中

フレームワーク (3) - $obj->query() と $obj->param()

package CGI::Minimal::App;

use strict;
use warnings;

use UNIVERSAL::require;

sub query {
    my $self = shift;
    my $query = shift;

    # If query object is not exist, set a new query object.
    unless ( exists $self->{__QUERY_OBJ} ) {
        if ( defined $query ) {
            $self->{__QUERY_OBJ} = $query;
        }
        else {
            my $module = 'CGI::Minimal';
            unless ( exists $INC{$module} ) {
                $module->require or die $!;
            }
            $self->{__QUERY_OBJ} = $module->new();
        }
    }
    return $self->{__QUERY_OBJ};
}

sub param : lvalue {
    my $self = shift;
    my @data = @_;

    # First use? Create new __PARAMS!
    $self->{__PARAMS} = {} unless exists $self->{__PARAMS};

    if ( ref($data[0]) eq 'HASH' ) {
        # param($hash_ref)
        %{$self->{__PARAMS}} = (%{$self->{__PARAMS}}, %{$data[0]});
    }
    elsif ( scalar(@data) % 2 == 0 ) {
        # param(@array)
        %{$self->{__PARAMS}} = (%{$self->{__PARAMS}}, @data);
    }
    scalar(@data) == 1 ? $self->{__PARAMS}->{$data[0]} : $self->{__PARAMS};
}

C::A::P::Stash 的に param を使いたかった & lvalue 使ってみたかった

$obj->param->{'hoge'} = 'fuga'; # OK
$obj->param('hoge','fuga');     # OK
$obj->param('hoge') = 'fuga'    # OK
$obj->param({hoge => 'fuga'});  # OK
$obj->param(hoge => 'fuga');    # OK
$obj->param = {hoge => 'fuga'}  # OK

print $obj->param->{'hoge'};    # fuga
print $obj->param('hoge');      # fuga

フレームワーク (2)

HikiDoc を使った WEB アプリケーション」の時にはしりきれとんぼだったので、今回はちょっと続けてみようかと思う。今のところは

  • 名称は CGI::Minimal::App (仮)
  • ロジックは CGI::Application をほぼそのまま頂く
    • 使い方が変わると、自分自身が使いづらくなるので
    • 細かいあたりは、コーディングを楽しめるように自分流で
  • CGI::Minimal の perldocに「warnings と vars は重て!」とか書いてあるが、どうするかは作ってから考える
  • CGI::Application::Plugin で、いつも使っているものは最初からいれてしまう

フレームワーク

お昼過ぎ、ふと思い立ってフレームワークを作り始めたので、記録残し

CGI::Simple か CGI::Minimal を使って、機能を減らして、もうちっとシンプルな俺仕様 CGI::Application が欲しい。CGI::Application 使ってると、いろんなことを覚えることができないワシはコピペが増えて困る

イチから必要な機能だけ実装した方が楽かも。自分で実装したら覚えること減りそうだし

CGI::Simple よさげだけど、どうせなら CGI::Minimal 使った方が極端で楽しいかも。これで CGI::Application より重くなったら、自分の実装が悪いということで

CGI::Application のマネをするため、コード斜め読み

とりあえずここまで

トラックバックをどうすべきか

今に始まったことじゃないが、FreeStyleWiki からトラックバックしようとすると NG のことが多いので、そろそろ何とかすべきかどうか考え中

WebService::PhotoZou::Exif をでっちあげる

で、さっそくもろもろ情報取得しようとしてみたが、あんまし欲しい情報がはいってない

Exif情報が表示されるようになりました」というのは、表示されてるだけで、API からは取得できないのね

しかたないので、正式に API で対応するまででっちあげることにした

  • 方法 1 : photo_info で取得した original_image_url からオリジナル画像を取得して解析する
    • メリット : 画像に残っている情報は根こそぎゲット
    • デメリット : オリジナル画像がでかいと、当然その分取得に時間かかる
  • 方法 2 : フォト蔵の HTML を解析して、表示されている情報を取得
    • メリット : HTML を取得する程度なら、時間はそんなにかからない
    • デメリット : 表示されているものしか取得できない。HTML の構造が変わる可能性あり

そのうち API 経由で取得できるようになるだろうから、方法 2 で。

(2007/07/03 追記) WebService::PhotoZou::photo_info が undef 返してる時のこと考慮してなかったので、一行追加

package WebService::PhotoZou::Exif;
use strict;
use warnings;
use base 'WebService::PhotoZou';

use LWP::Simple;
use HTML::TreeBuilder::Select;
use Encode;

sub exif_info {
    my ($self, %param) = @_;
    my $content = $self->photo_info(%param);
    return unless $content;  # 2007/07/03

    my $text = $content->{url} ? LWP::Simple::get($content->{url}) : '';
    $text = decode('utf8', $text);

    my $tree = HTML::TreeBuilder::Select->new;
    $tree->parse_content($text);
    my @selections = $tree->select('div#media_info_extend div.list div.title_extend,div.photodata_extend');
    my %hash = map { $_->as_text; } @selections;

    $content->{exif} = \%hash;
    return $content;
}

1;

WebService::PhotoZou に photo_info を追加

フォト蔵API」を使うために WebService::PhotoZou を覗いてみたんだが、唯一使いたいメソッド「photo_info」に対応していないので、パッチ

--- PhotoZou.pm.org     2006-09-30 01:59:58.000000000 +0900
+++ PhotoZou.pm 2007-07-02 11:21:54.000000000 +0900
@@ -122,6 +122,13 @@
     $res->{info}->{user_group} || [];
 }

+sub photo_info {
+    my ($self, %param) = @_;
+    my $content = $self->_request('photo_info', %param);
+    my $res = $self->_to_result($content) or return;
+    $res->{info}->{photo};
+}
+
 sub errormsg {
     my $self = shift;
     my $msg;

いちおう作者さんにお知らせしておこうと思ったら、フォト蔵関連エントリ 1 個。ご本人は photo_info いらないのかも

パッチどうもありがとうございます。photo_info含め、だいぶメソッドが増えているようですね。近いうちに対応します。 - spiritloose (2007年07月02日 21時22分07秒)
わーい、楽しみに待ってます - 髭。 (2007年07月02日 21時36分53秒)

サイトの全ページのスクリーンショットを自動で撮影

仕事で横着したかったので作ってみたが、これ以上改良する気もないので、忘れないうちに貼付けておく。とりあえず Windows 版。Mac 版は、自宅で使う気になった時に作る

use strict;
use warnings;

use Carp;

use Win32::CaptureIE;
use WWW::CheckSite;

sub say { print @_, "\n"; }

my $uri = $ARGV[0] or croak 'usage: spidershot.pl [uri]';
$uri !~ m|^https?://| && ($uri = 'http://'.$uri);

my $wcs = WWW::CheckSite->new(
                              uri => $uri,
                              prefix => $uri,
                              validate => 0,
                             );
$wcs->validate;
my @lists = grep {/$uri/} $wcs->dump_links();
say 'Total: ',scalar(@lists);

my $i = 0;
StartIE(width=>800,height=>600);
for my $list ( @lists ) {
  my $num = sprintf("%04d",$i++);
  say $num,': ',$list;
  Navigate($list);
  my $img = CapturePage();
  $img->Write('capt'.$num.'.jpg');
}
QuitIE;

__END__

全ページといっても、フォームに何か入力して submit とかはやらない。テストしたいわけではなかったので、入力する値準備するのがめんどかった

でも、スクロールキャプチャはするので、それなりに便利ではないかと思われ

うおっ,これは良いですね.Win32::CaptureIE なんてのがあるのか... IEのコンポーネントを内部的に使用してる? ここはぜひ Linux 版... (コラ) - 加藤泰文 (2008年06月16日 11時49分17秒)
うは。Linux も誰かが作ってそうだし、今度調べてみます - ひげまる (2008年06月16日 13時13分09秒)

オライリー学校

http://www.oreillyschool.com/

ちなみに、Learn Perl for CGI Programmingだと $398 らしい

今日はいつもより目に止まったサイトが多かったので、列挙してみた

[ << < 6  7  8  9  10  11  12  13  14  15  16 >> ]

Home > Perl Archive

Feeds

Return to page top