Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

tokuhirom (7396)

tokuhirom
  (email not shown publicly)
http://d.hatena.ne.jp/tokuhirom/

Journal of tokuhirom (7396)

Sunday August 17, 2008
01:30 AM

I wrote Test::TCP

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

Monday June 23, 2008
06:12 AM

Perl5 VM Golf

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?

Wednesday June 11, 2008
11:05 PM

Test::Snippet - Test interactive Perl examples

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!
Tuesday June 03, 2008
09:20 PM

Moose::Role + overload

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)
Monday June 02, 2008
06:40 PM

Moose talk in Japan

hakobe-san makes presentation about mooooooose at Kansai.pm.

slide is here: http://www.slideshare.net/hakobe/moose

moooooooooooooooooooose!
Thursday May 29, 2008
09:32 PM

MooseX::Plaggerize

### 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
Monday May 05, 2008
11:50 AM

petit Moose movement in Japan

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?
Thursday November 22, 2007
09:05 PM

scraping sibling nodes by Web::Scraper.

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
Monday July 16, 2007
06:26 AM

I wrote Test::ShellPerl

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
Sunday May 06, 2007
05:56 AM

Gearman::Taskset::Async

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?