Tomyhero in the VOX

I was trying to make simple OR Mapper with Mojo::Base base for fun.

but I think I am going to quit the idea to use Mojo::Base to implement inflate and deflate parameter into attr() method... it's kinda tough to extend attr()... below is the current result...

package Onihei::ORM::Row;

use warnings;
use strict;
use base 'Mojo::Base';
use Onihei::Date;
use Onihei::ORM::Driver;

__PACKAGE__->attr( 'id' );
__PACKAGE__->attr( 'update_date'   , deflate => sub {  Onihei::Date->new($_[0])  } , inflate => sub { $_[0]->string } );
__PACKAGE__->attr( 'register_date' , deflate => sub {  Onihei::Date->new($_[0])  } , inflate => sub { $_[0]->string } );
__PACKAGE__->attr( 'driver' , default => sub { Onihei::ORM::Driver->instance  }  );

# TODO : dirty

sub dirty_dump {
    my $self = shift;
    use Data::Dumper;
    Dumper $self->{__dirty};

}

sub update {
    my $self = shift;

    my %data;
    for my $key ( keys %{$self->{__dirty}} ) {
        $data{$key} = $self->{$key}; 
    }
    # TODO update

use Data::Dumper;
warn Dumper \%data;
    # this guy is clean now!
    $self->{__dirty} = {};
    
}

sub inflate {
    my $self = shift;    
    my $attr = shift;

    if( my $sub = $self->{__inflate}{$attr} ) {
        return $sub->( $self->{$attr} );
    }
    else {
        return $self->{$attr};
    }
}
sub new {
    my $class = shift;

    # Instantiate
    return bless
      exists $_[0] ? exists $_[1] ? {@_} : $_[0] : {},
      ref $class || $class;
}


sub attr {
    my $class = shift;
    my $attrs = shift;

# Shortcut
    return unless $class && $attrs;

# Check arguments
    my $args;
    if (exists $_[1]) {
        my %args = (@_);
        $args = \%args;
    }
    else { $args = $_[0] }
    $args ||= {};

    my $chained = delete $args->{chained};
    my $default = delete $args->{default};
    my $weak    = delete $args->{weak};

    # 拡張
    my $deflate = delete $args->{deflate};
    my $inflate = delete $args->{inflate};

    undef $args;

# Check default
    Carp::croak('Default has to be a code reference or constant value')
        if ref $default && ref $default ne 'CODE';

# Allow symbolic references
    no strict 'refs';

# Create attributes
    $attrs = ref $attrs eq 'ARRAY' ? $attrs : [$attrs];
    my $ws = '    ';
    for my $attr (@$attrs) {
        Carp::croak("Attribute '$attr' invalid")
            unless $attr =~ /^[a-zA-Z_]\w*$/;

# Header
        my $code = "sub {\n";

# Warning gets optimized away
        unless ($ENV{MOJO_BASE_OPTIMIZE}) {

# Check invocant
            $code .= "${ws}Carp::confess(q[";
            $code
                .= qq/Attribute "$attr" has to be called on an object, not a class/;
            $code .= "])\n  ${ws}unless ref \$_[0];\n";
        }

# No value
        $code .= "${ws}if (\@_ == 1) {\n";
        $code .= "$ws${ws} \$_[0]->{'$attr'} = \$deflate->(\$_[0]->{'$attr'});\n" if $deflate;
        $code .= "$ws${ws} \$_[0]->{__inflate}{'$attr'} =  \$inflate unless \$_[0]->{__inflate}{'$attr'};\n" if $inflate;
        unless (defined $default) {

# Return value
            $code .= "$ws${ws}return \$_[0]->{'$attr'};\n";
        }
        else {

# Return value
            $code .= "$ws${ws}return \$_[0]->{'$attr'} ";
            $code .= "if exists \$_[0]->{'$attr'};\n";

# Return default value
            $code .= "$ws${ws}return \$_[0]->{'$attr'} = ";
            $code .=
                ref $default eq 'CODE'
                ? '$default->($_[0])'
                : '$default';
            $code .= ";\n";
        }
        $code .= "$ws}\n";

        $code .= "$ws${ws} \$_[0]->{__dirty}{'$attr'} = 1 ;\n" if $attr ne 'driver'; 
# Store argument optimized
        if (!$weak && !$chained) {
            $code .= "${ws}return \$_[0]->{'$attr'} = \$_[1];\n";
        }

# Store argument the old way
        else {
            $code .= "$ws\$_[0]->{'$attr'} = \$_[1];\n";
        }

# Weaken
        $code .= "${ws}Scalar::Util::weaken(\$_[0]->{'$attr'});\n" if $weak;

# Return value or instance for chained/weak
        if ($chained || $weak) {
            $code .= "${ws}return ";
            $code .= $chained ? '$_[0]' : "\$_[0]->{'$attr'}";
            $code .= ";\n";
        }

# Footer
        $code .= '};';

# We compile custom attribute code for speed
        *{"${class}::$attr"} = eval $code;
# This should never happen (hopefully)
        Carp::croak("Mojo::Base compiler error: \n$code\n$@\n") if $@;

# Debug mode
        if ($ENV{MOJO_BASE_DEBUG}) {
            warn "\nATTRIBUTE: $class->$attr\n";
            warn "$code\n\n";
        }
    }
}

1;

I will show how I load config data with catalyst.

AIM

Load config data not only for the catalyst application(MyApp::Web) but also CLI , an another Catalyst Application(e.g.. MyApp::AdminWeb) , etc...

MyApp::Config

This is how I implement config class. there are 2 points. and after set up this way, you can use this class whereever you want.  By the way, I am using Config::Multi which is just my choice ,  you can chose something else you prefere .

1. using Class::Singleton
2. using MyAPp::Utils instead of Catalyst::Utils

package MyApp::Config;

use strict;
use warnings;
use Config::Multi;
use MyApp::Utils;
use base 'Class::Singleton';

our $FILES ;
sub _new_instance {
    my $cm = Config::Multi->new(
        {
        dir => MyApp::Utils::path_to('conf')->stringify ,
        app_name    => 'myapp' ,
        extension   => 'yml'
    });
    my $config = $cm->load();
    $FILES = $cm->files;
    return $config;
}
sub files {
    return $FILES;
}

1;

MyApp::Utils

If I use Catalyst::Utils then the MyApp::Config has dependancy with Catalyst which I want to avoid it so I use this class instead.

package MyApp::Utils;

use warnings;
use strict;
use Path::Class::Dir;
use Path::Class::File;
use FindBin;

sub home {
    return $ENV{MYAPP_HOME} ||  Path::Class::Dir->new(  $FindBin::Bin, './../' );
}

sub path_to {
    my ( @path ) = @_;
    my $path = Path::Class::Dir->new( &home , @path );
    warn $path;
    if ( -d $path ) { return $path }
    else { return Path::Class::File->new( &home, @path ) }
}

1;

MyApp::Plugin::Config

package MyApp::Plugin::Config;

use strict;
use warnings;
use MyApp::Config;
use NEXT;

our $VERSION ='0.02';

sub setup {
    my $c = shift;
    my $config = MyApp::Config->instance();

    if( $c->debug ) {
        my $files = MyApp::Config->files();
        for my $file ( @{$files} ) {
            $c->log->debug( 'Load Config ' . $file );
        }
    }

    $c->config( $config ) ;
    $c->NEXT::setup( @_ );
}

1;

MyApp::Web

package MyApp::Web;

use strict;
use warnings;
use Catalyst::Runtime '5.70';
use Catalyst qw/+MyApp::Plugin::Config/;
our $VERSION = '0.01';
__PACKAGE__->setup;

1;

conf/myapp_web.yml

---
name: Config Sample

MyApp::Web::Controller::Root

package MyApp::Web::Controller::Root;

use strict;
use warnings;
use base 'Catalyst::Controller';

__PACKAGE__->config->{namespace} = '';

sub default : Private {
    my ( $self, $c ) = @_;
    $c->response->body(  $c->config->{name} );
}

sub end : ActionClass('RenderView') {}

1;

Conclusion

when I use Catalyst::Plugin::Config** I could not use the module from outside of catalyst 
but with this implementation I can use MyApp::Config whereever I want! hehehe.

perl-mongers.org < same article in japanese.

Long time not write at vox.

After YAPC::Asia 2008 , we Japanese start to get domain for perl . ye-s. that is because of  this talk.

• http://perl-mongers.org/
• http://perl-users.org/ ( http://perl.jp/ )

perl-mongers.org offer openid blogging using MT , so everybody can write and read about Perl!! The article cover newbies to hackers! Is that cool?? maybe you should try one. I will... actually I did already! surprise!

perl is undead.

I released Net::Twitter::Diff at CPAN.

What you can do with this  module are...

1. Use this module when you want to know all your followers who you are not following.
   
2. Use this module when you want to compare following with your twitter friend.
3. Use xfollowing and xfollowers instead of Net::Twitter->following(), Net::Twitter->followers() when you have more thatn 100 twitter's. following and follower methods have 100 limitation because of Twitter API. xfolloing() and xfollowers() is support more than 100 but it is unofficial use , the way I implement is not on the Twitter API Document. You can find how if you ask to google :-)
   

    use Net::Twitter::Diff;
    use Data::Dumper;
    my $diff = Net::Twitter::Diff->new(  username => '******' , password => '******');
   
    print Dumper $diff->diff();

    print Dumper $diff->comp_following( 'somebody_twitter_name' );

print Dumper $diff->xfollowing();
print Dumper $diff->xfollowers();

• You must know one thing : you have limitation for 70 times per hour for Twitter API request. so be aware.
  

I quit job recently and got job at Tokoyo. This is OK to me.

You know moving to Tokyo is cost me too much. I need to spend like $7000 for total!!! Gosh.

- transfer fee : $200 + $200(one day hotel)
- previous mansion fee for last month : $700
- moving fee : $1400
- new mansion contract fee , 2 months fee, and etc : $5000
- spend time with my daughter : priceless

cost tooooo much!!! And you know I have no job right now , so no income tt.

everybody be prepare when you quite job and move to far way !!

Recently gmail is really slow.

Right now I am thinking about performance up every day. Like how should I cache, how should I setup servers and network...

I am making kinda blog site for work. I think I will use Apache Cache. but I need to controll the cache. I want to delete when I want to delete. I want to delete which I want to delete. humm. or maybe I will generate static html...

humm...  slow slow slow slow. I hate slow. but I may making slow site . tt