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

I released Gearman Client/Worker written in Python.

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.

Saturday December 02, 2006
01:52 AM

Sledge::Plugin::Inflate::DateTime

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');

Sunday November 19, 2006
09:30 AM

I want to Sledge::Config->path_to.

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.

Friday November 17, 2006
02:25 AM

implementation of Sledge::Plugin.

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;

Sunday November 05, 2006
10:32 AM

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

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!

Saturday November 04, 2006
10:12 AM

usage of sledge::view

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;

Friday November 03, 2006
09:41 AM

Sledge::View 0.04 released

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.

Thursday November 02, 2006
12:22 AM

Sledge::Config to YAML::Load

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
    -

Wednesday November 01, 2006
07:26 AM

Sledge::Plugin::URIFor

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

12:17 AM

Sledge::Plugin::CreateConfig

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.