tokuhirom's Journal

I wrote Test::TCP

tokuhirom — 2008-08-17T06:30:13+00:00

I've wrote Test::TCP today.

If you write tests with Test::TCP, easy to write the test, that using TCP socket.

follow is example code.

use warnings;
use strict;

package MyEchoServer;
use IO::Socket::INET;

sub new {
my ($class, $port) = @_;

my $sock = IO::Socket::INET->new(
LocalPort => $port,
LocalAddr => '127.0.0.1',
Proto => 'tcp',
Listen => 5,
Type => SOCK_STREAM,
) or die "Cannot open server socket: $!";
bless { sock => $sock }, $class;
}

sub run {
my $self = shift;

while (my $remote = $self->{sock}->accept) {
while (my $line = ) {
print {$remote} $line;
}
}
}

package main;
use strict;
use warnings;
use Test::More tests => 1;
use Test::TCP;
use IO::Socket::INET;

test_tcp(
client => sub {
my $port = shift;
my $sock = IO::Socket::INET->new(
PeerPort => $port,
PeerAddr => '127.0.0.1',
Proto => 'tcp'
) or die "Cannot open client socket: $!";
print {$sock} "foo\n";
my $res = ;
is $res, "foo\n";
},
server => sub {
my $port = shift;
MyEchoServer->new($port)->run;
},
);

and repository is here:

http://svn.coderepos.org/share/lang/perl/Test-TCP/trunk/lib/Test/TCP.pm

Perl5 VM Golf

tokuhirom — 2008-06-23T11:12:11+00:00

I've released Acme::PerlVMGolf.
This is new golf rule for perl hackers :)

PerlVMGolf's rule is very simple.follow is the rule:

* write the code for the score
* your score is sum of your op code number
* short perl code is good

Are you right?

You can calcurate your score by Acme::PerlVMGolf(I've uploaded to CPAN now, and you can get from our svn repos http://svn.coderepos.org/share/lang/perl/Acme-PerlVMGolf/trunk/PerlVMGolf.xs).

perl -MAcme::PerlVMGolf -e '0'
hit: 177op
hit: 174op
hit: 178op
Your perl is : 5.8.8
Your score is : 529op

I give first challenge : how to implement 1000op?

Test::Snippet - Test interactive Perl examples

tokuhirom — 2008-06-12T04:05:50+00:00

I've wrote Test::Snippet. http://svn.coderepos.org/share/lang/perl/Test-Snippet/trunk/ This is a port of Python's doctest. doctest is : http://docs.python.org/lib/module-doctest.html 1. use your module at re.pl(Devel::REPL) 2. copy and paste to pod 3. run tests. that's all. follow is example code: your code here. =head1 NAME Acme::Test - testing acme =head1 DESCRIPTION blah blah blah =begin test $ 3+2 5 $ [2,5,5,{foo => 'bar'}] $ARRAY1 = [ 2, ( 5 ) x 2, { foo => 'bar' } ]; =end test =cut something.. something.. =head1 SEE ALSO ME!

Moose::Role + overload

tokuhirom — 2008-06-04T02:20:03+00:00

follow code does not works. package MyApp::Role::Stringify; use overload q{""} => sub { shift->stringify } ; requires 'stringify'; package MyApp; with 'MyApp::Role::Stringify'; has dat ( is => 'ro', isa => 'Str' ); sub stringify { shift->dat } because, the architecture of overload.pm is export method named '()' export method named '(""' Moose::Role applies coderefs, that defined at Role.Exported methods are not import to applicant. one way to resolve this problem is: package MyApp::Role::Stringify; use Moose::Role; __PACKAGE__->meta->add_package_symbol('&()' => sub { }); # dummy __PACKAGE__->meta->add_package_symbol('&(""' => sub { shift->stringify }); but, this is not so smart :( this is Hentai way(hentai means tricky in japanese)

Moose talk in Japan

tokuhirom — 2008-06-02T23:40:26+00:00

hakobe-san makes presentation about mooooooose at Kansai.pm. slide is here: http://www.slideshare.net/hakobe/moose moooooooooooooooooooose!

MooseX::Plaggerize

tokuhirom — 2008-05-30T02:32:58+00:00

### DESCRIPTION I want to use Plagger style plugins architecture with Moose.Therefore, I created MooseX::Plaggerize! svn repos is here: http://svn.coderepos.org/share/lang/perl/MooseX-Plaggerize/trunk/ ### SYNOPSIS # in main my $c = Your::Context->new; $c->load_config('config.yaml'); # feature of MooseX::Plaggerize::ConfigLoader $c->load_plugin('HTMLFilter::StickyTime'); $c->load_plugin({module => 'HTMLFilter::DocRoot', config => { root => '/mobirc/' }}); $c->run(); package Your::Context; use Moose; with 'MooseX::Plaggerize', 'MooseX::Plaggerize::ConfigLoader'; sub run { my $self = shift; $self->run_hook('response_filter' => $args); } package Your::Plugin::HTMLFilter::StickyTime; use strict; use MooseX::Plaggerize::Plugin; hook 'response_filter' => sub { my ($self, $context, $args) = @_; }; ### CONCEPT * Plugin architecture like Plagger * Each plugin has own instance * Each plugin can have own configuration ### What's difference with MooseX::Object::Pluggable? yeah, I know MooseX::Object::Pluggable, ofcource. MooseX::Object::Pluggable stands on Moose::Role and method modifiers.This is cool architecture. But, this approach cannot use configuration like Plagger :( therefore, I wrote MooseX::Plaggerize :) ### ... We would like to hear from you

petit Moose movement in Japan

tokuhirom — 2008-05-05T16:50:11+00:00

some Japanese perl mongers are interested to Moose, and reading the code, and some bloggers are writing 'Yet Another Moose Cookbook' in Japanese :-) - my japanese blog: http://d.hatena.ne.jp/tokuhirom/ - yappo-san's : http://blog.yappo.jp/yappo/archives/000579.html - hidek-san's: http://blog.hide-k.net/ and, a few days after, many Japanese perl mongers listen a nothingmuch's Moose talk in YAPC::Asia 2008 in Japan!! Will Moose popular in Japan?

scraping sibling nodes by Web::Scraper.

tokuhirom — 2007-11-23T02:05:19+00:00

Web::Scraper is not good at some case. likes follow... <div class="author">miyagawa</div> <div class="module">Web::Scraper</div> <div class="author">hanekomu</div> <div class="module">Dist-Joseki</div> This is not a tree structure.. hmm... Web::Scraper dependes on the tree structure, isn't it? but, XPath is swiss army chainsaw. scraper { process '//div[@class="author"]', 'modules[]', scraper { process '/.', 'author', 'TEXT'; process '/following-sibling::div[1][@class="module"]', 'title', 'TEXT'; } }; but, this code is doesn't works.scraper cannot support this way. If Web::Scraper supports this feature, you can be scraping from 'search.cpan.org', 'blog.livedoor.com', or many web sites more easily. follow is the dirty and quick patch for this problem. http://limilic.com/entry/c3qpikckc7f12jq3

I wrote Test::ShellPerl

tokuhirom — 2007-07-16T11:26:05+00:00

I wrote Test::ShellPerl. This module likes doctest@python. <blockquote> The doctest module searches for pieces of text that look like interactive Python sessions, and then executes those sessions to verify that they work exactly as shown. </blockquote> Here's a small example module of doctest@python: <pre> """ This is the "example" module. >>> factorial(5) 120 """ def factorial(n): """Return the factorial of n, an exact integer >= 0. If the result is small enough to fit in an int, return an int. Else return a long. >>> [factorial(n) for n in range(6)] [1, 1, 2, 6, 24, 120] >>> [factorial(long(n)) for n in range(6)] [1, 1, 2, 6, 24, 120] >>> factorial(30) 265252859812191058636308480000000L >>> factorial(30L) 265252859812191058636308480000000L >>> factorial(-1) Traceback (most recent call last): ... ValueError: n must be >= 0 Factorials of floats are OK, but the float must be an exact integer: >>> factorial(30.1) Traceback (most recent call last): ... ValueError: n must be exact integer >>> factorial(30.0) 265252859812191058636308480000000L It must also not be ridiculously large: >>> factorial(1e100) Traceback (most recent call last): ... OverflowError: n too large """ (snip the imprementation... </pre> Now, you can get this feature at Perl, with Shell::Perl. Shell::Perl is cool interactive interface for Perl.You can use this interface for testing.like follow: <pre> =pod =head1 DESCRIPTION This is just a simple example module. =begin test pirl @> 3+2 5 pirl @> :set out DD pirl @> [2,5,5,{foo => 'bar'}] @var = ( [ 2, 5, 5, { 'foo' => 'bar' } ] ); =end test =cut </pre> and run test then: <pre> ok 1 - 3+2 ok 2 - [2,5,5,{foo => 'bar'}] 1..2 </pre> You can get the this module at my japanese blog. http://d.hatena.ne.jp/tokuhirom/20070711/1184123829

Gearman::Taskset::Async

tokuhirom — 2007-05-06T10:56:51+00:00

I wrote Gearman::Taskset::Async, the Gearman asynchronous taskset.

for example:
use Gearman::Client;
use Gearman::Taskset::Async;
my $client = Gearman::Client->new(job_servers => ['127.0.0.1']);
my $ts = $client->new_async_task_set;
for (1..1000) {
$ts->add_task("echo" => \$_, +{on_complete => sub {
warn "COMPLETED";
warn "@_";
}, on_fail => sub {
warn "FAILED";
}});
}
$ts->run;

Gearman has asynchronous client(Gearman::Client::Async), is based on Danga::Socket.Danga::Socket imcompatible with mod_perl, because that uses class variables.

source code is here: Gearman::Taskset::Async

oops. It's just a Gearman::Taskset::BulkBlocRequest?

I released Gearman Client/Worker written in Python.

tokuhirom — 2007-05-06T10:41:24+00:00

Currently, gearman supports perl and ruby.I want to support Python!!Python is very sexy ;-)

yeah, I wrote the Gearman Client/Worker in Python.

now, you can use:

* Perl:Client → gearmand → Python:Worker
* Python:Client → gearmand → Ruby:Worker

and more combination.

wow! It's wonderful(In Japanese: Yume-ga-hirogarain-Guuuu!!)

source code is here: Gearman Python Code.

Sledge::Plugin::Inflate::DateTime

tokuhirom — 2006-12-02T06:52:04+00:00

I think, generate DateTime instance from CGI.pm/Apache::Request is very frequent and very painful.

Yes, I wrote the Sledge::Plugin::Inflate::DateTime.

You just write the

package Your::Pages; use Sledge::Plguin::Inflate; use Sledge::Plguin::Inflate::DateTime; __PACKAGE__->add_inflate_rule_ymd('date');

then, you can inflate DateTime object easily.

sub dispatch_foo { my $self = shift; $self->stash->{date} = $self->r->inflate('date'); }

And, Sledge::Plguin::Inflate::DateTime and HTML::DateSelector go together!

package Sledge::Plugin::Inflate::DateTime; use strict; use warnings; use DateTime; sub import { my $pkg = caller(0); no strict 'refs'; *{"$pkg\::add_inflate_rule_ymd"} = sub { my ($class, $key, $datetime) = @_; $datetime ||= 'DateTime'; $class->add_inflate_rule( $key => sub { my ( $self, ) = @_; my %args; $args{year} = $self->r->param("$key\_year"); $args{month} = $self->r->param("$key\_month"); $args{day} = $self->r->param("$key\_day"); if ( $args{year} && $args{month} && $args{day} ) { return $datetime->new(%args); } return; } ); }; } 1; __END__ =head1 SYSNOPSIS package Your::Pages; use Sledge::Plugin::Inflate::DateTime; # simple way __PACKAGE__->add_inflate_rule_ymd('from'); # you can use your customized DateTime class. __PACKAGE__->add_inflate_rule_ymd('from' => 'Your::DateTime');

I want to Sledge::Config->path_to.

tokuhirom — 2006-11-19T14:30:33+00:00

http://use.perl.org/~ikebe/journal/31636

I want to write tmpl_path with path_to in config.
Because, tmpl_path is a configuration variable.

package Project::Config; use strict; use warnings; use base qw/Sledge::Config/; use Sledge::Plugin::PathTo; use vars qw(%C); *Config = \%C; $C{TMPL_PATH} = path_to('view'); 1;

and, next version of Sledge::Config::YAML will supports
path_to, likes Catalyst::Plugin::ConfigLoader::YAML.Follw is
example configuration file:

common: tmpl_path: __path_to('view')__

Yeah, that's so cool.

implementation of Sledge::Plugin.

tokuhirom — 2006-11-17T07:25:50+00:00

http://use.perl.org/~ikebe/journal/31589

here is implementation.

package Sledge::Plugin; use strict; use warnings; use base qw/Class::Data::Inheritable/; __PACKAGE__->mk_classdata('methods'); __PACKAG E__->mk_classdata('hooks'); sub import { my $class = shift; my $pkg = caler(0); # add methods while (my ($name, $code) = each %{$class->methods || {}} ) { no stirct 'refs'; *{"$pkg\::$name"} = $code; } # register hooks $class->register_hooks( %{ $class->hooks || {} } ); } sub add_methods { my ($class, %d) = @_; $class->methods( { %{ $class->methods || {} }, %d, } ); } sub register_hooks { my ($class, %d) = @_; $class->hooks( { %{ $class->hooks || {} }, %d, } ); } 1;

I released Sledge::Plugin::Pager 0.01 on CPAN.

tokuhirom — 2006-11-05T15:32:34+00:00

I wrote the Sledge::Plugin::Pager.

I want easy to write the paging, because every index page needs
paginate, in prgmatic web application.

A normal paginate dispatcher code is:

sub dispatch_index { my $self = shift; $self->stash->{pager} = Your::Data::CD->pager(20, $self->r->param('page') || 1); $self->stash->{cds} = $self->stash->{pager}->retrieve_all; }

follow is equevalent code with Sledge::Plugin::Pager.

use Sledge::Plugin::Pager; sub dispatch_index { my $self = shift; $self->pager('Your::Data::CD')->retrieve_all; }

Yeah, happy paging!

usage of sledge::view

tokuhirom — 2006-11-04T15:12:25+00:00

follow is an examle trigger code of Sledge::View.

package Your::Pages::Base; use strict; use warnings; use base qw/Sledge::Pages::Compat/; use Switch; use Jcode; use Sledge::Plugin::PluginLoader; __PACKAGE__->load_plugins( qw/Stash View/ ); __PACKAGE__->add_trigger( AFTER_DISPATCH => sub { my $self = shift; switch ($self->r->param('output')) { case 'csv' { $self->view('Sledge::View::CSV')->process; $self->response->body(Jcode->new($self->response->body, 'euc')->sjis); } else { $self->view('Template')->process; } } } ); 1;

Sledge::View 0.04 released

tokuhirom — 2006-11-03T14:41:29+00:00

I released Sledge::View 0.04 released.

This distribution includes the Sledge::View::CSV.

yeah, Japanese sales person often requires the CSV formatted files ;-)

usage:

package Your::Pages::Admin::Report; use strict; use warnings; use base qw/Sledge::Pages::Compat/; use Sledge::Plugin::View; use Sledge::Plugin::Stash; __PACKAGE__->add_trigger( AFTER_DISPATCH => sub { my $self = shift; if ($self->r->param('output') eq 'csv') { $self->view('CSV')->process; } else { $self->view('Template')->process; } } ); sub dispatch_report { my $self = shift; $self->stash->{row} = [[qw/a b/], [qw/c d/]]; }

and, your template is:

<table> [% FOR row IN rows %] <tr> [% FOR col IN row %] <td>[% col %]</td> [% END %] </tr> [% END %] </table>

if user access to '/admin/report/report' then get the html table report, and if access to '/admin/report/report?output=csv' then get the csv report.

yes, you can easy to change the view.

Sledge::Config to YAML::Load

tokuhirom — 2006-11-02T05:22:10+00:00

Long time ago, Sledge's config is written in codes, likes old version of Catalyst.

I want to write the config in YAML.YAML is cool, that is human readable and writable.

current style of Sledge::Config :

package Proj::Config; use strict; use warnings; use base qw(Sledge::Config Class::Singleton); sub case_sensitive { 0 } sub _new_instance { my $class = shift; unless (defined $ENV{SLEDGE_CONFIG_NAME}) { do '/etc/proj-conf.pl' or warn $!; } $class->SUPER::new($ENV{SLEDGE_CONFIG_NAME}); } 1; package Proj::Config::_common; use strict; use vars qw(%C); *Config = \%C; $C{TMPL_PATH} = '/path/to/tmpl_dir'; $C{COOKIE_NAME} = 'sledge_sid'; $C{COOKIE_PATH} = '/'; $C{COOKIE_DOMAIN} = undef; 1; package Proj::Config::_development; use strict; use vars qw(%C); *Config = \%C; $C{DATASOURCE} = [ 'dbi:mysql:sledge','root', '' ]; 1; package Proj::Config::_product; use strict; use vars qw(%C); *Config = \%C; $C{DATASOURCE} = [ 'dbi:mysql:sledge;host=192.168.1.30','root', '' ]; 1;

If you use the Sledge::Config::YAML, written by precuredaisuki, you can write config by YAML.

package Your::Config; use basei qw(Sledge::Config::YAML Class::Singleton); sub _new_instance { my $class = shift; $class->SUPER::new($ENV{SLEDGE_CONFIG_NAME}, $ENV{SLEDGE_CONFIG_FILE}); } 1;

and, your yaml is:

common: tmpl_path: /path/to/tmpl_dir cookie_name: sledge_sid cookie_path: / cookie_domain: ~ product: datasource: - dbi:mysql:sledge;host=192.168.1.30 - root - development: datasource: - dbi:mysql:sledge - root -

Sledge::Plugin::URIFor

tokuhirom — 2006-11-01T12:26:54+00:00

I wrote the Sledge::Plugin::URIFor.This module provides $self->uri_for() method

$self->uri_for('Proj::Pages::Foo' => 'add', {id => 35}); # => /foo/add?id=35

I complete wrote the code with tests.

But, Ikebe-san will release Sledge::Engine, that maybe includes url generating/parsing rule.

I'm waiting...

package Sledge::Plugin::URIFor; use strict; use warnings; our $VERSION = 0.01; use Carp; use Sledge::Utils; use URI; sub import { my $pkg = caller(0); no strict 'refs'; *{"$pkg\::uri_for"} = sub { my $self = shift; my @args = @_; my $dir = Sledge::Utils::class2prefix($self); my $page = ''; my $query = {}; for my $arg (@args) { if (ref $arg eq 'HASH') { # query $query = $arg; } elsif ($arg =~ /^[A-Z]/) { # module name my $appclass = Sledge::Utils::class2appclass($self); $arg = "${appclass}::Pages::$arg" unless $arg =~ /^$appclass/; $dir = Sledge::Utils::class2prefix($arg); } elsif ($arg =~ /^[a-z]/) { # page name next if $arg eq 'index'; # through $page = $arg; } else { die "invalid argument : $arg"; } } my $uri = URI->new($dir .($dir eq '/' ? '' : '/'). $page); $uri->query_form($query); return $uri->as_string; }; } 1;

and tests:

use strict; use warnings; use Test::Base; plan tests => 1*blocks; filters( { input => [qw/yaml/], } ); run { my $block = shift; eval qq{ package @{[ $block->pages ]}; use Sledge::Plugin::URIFor; sub new { bless {}, shift } }; die $@ if $@; my $page = $block->pages->new; is( $page->uri_for( @{ $block->input } ), $block->expected, $block->name ); }; __END__ === simple --- pages: Proj::Pages --- input - foo: bar --- expected: /?foo=bar === deep --- pages: Proj::Pages::Foo --- input - add --- expected: /foo/add === complex --- pages: Proj::Pages::Foo::Bar --- input - Bar::Baz - edit - foo: bar bar: baz --- expected: /bar/baz/edit?bar=baz&foo=bar === complex2 --- pages: Proj::Pages::Foo::Bar::Baz --- input - Proj::Pages::Bar::Baz - edit - foo: bar bar: baz --- expected: /bar/baz/edit?bar=baz&foo=bar

Sledge::Plugin::CreateConfig

tokuhirom — 2006-11-01T05:17:23+00:00

I wrote the Sledge::Plugin::CreateConfig for Sledge2.0.This module generates crete_config method automatically.

package Sledge::Plugin::CreateConfig; use strict; use warnings; our $VERSION = 0.01; use Carp; use Sledge::Utils; use UNIVERSAL::require; sub import { my $pkg = caller(0); my $config_class = Sledge::Utils::class2appclass($pkg); $config_class .= '::Config'; $config_class->use or die $@; no strict 'refs'; *{"$pkg\::create_config"} = sub { my $self = shift; return $config_class->instance; }; } 1;

Old style Sledge code is likes follow:

package Your::Pages; use base qw/Sledge::Pages::Compat/; use Your::Config; sub create_config { Your::Config->instance; }

I think, this is very verobse code.I want to write less codes.

If you use this plugin, you'll get a happy:

package Your::Pages; use base qw/Sledge::Pages::Compat/; use Sledge::Plugin::CreateConfig;

Now, This module is uped on CPAN.

load map to Sledge 2.0

tokuhirom — 2006-11-01T00:12:04+00:00

follow is a list of load map to Sledge 2.0(draft).

wrap the Apache::Request
write the Sledge::Engine
- support mod_perl2
- support fastcgi
split Sledge::MobileGate, very thick wrapper, to many plugins
add Sledge::Plugin::MobileAgent
use Encode, internal char code change euc-jp to utf-8
add the Sledge::Plugin::FormValidator::Simple?

and more...

Sledge's components(draft)

tokuhirom — 2006-11-01T00:07:57+00:00

follow is a list of Sledge's core components.

Sledge::Pages: Controller
Sledge::Authorizer: authorization
Sledge::Session: session state(e.g. cookie)
Sledge::SessionManager: session storage(e.g. memcached, mysql)
Sledge::Template: template engine(e.g. TT2, HTML::Template)
Sledge::Config: config object

I want to restructure the Sledge's components.

my first entry

tokuhirom — 2006-10-31T23:41:36+00:00

I started the blogs in 'use Perl'.

By the day, I write the blog about Sledge, web application frame work written in Perl, on vox.com.
http://tokuhirom.vox.com/

miyagawa suggests 'Your blog should be write on use Perl;'.

Yes, I started the blogs on use Perl;.

Yeah, I'll write the some entries about Sledge.