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 ]

nekokak (7400)

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

Journal of nekokak (7400)

Thursday November 02, 2006
02:25 AM

Sledge::Model(EXPERIMENTAL)

I wrote Sledge::Model.

This module is EXPERIMENTAL!

package Sledge::Model;
use strict;
use warnings;
our $VERSION = 0.01;
use Sledge::Exceptions;
 
sub new {
    my ($class, $page) = @_;
    return bless {page => $page}, $class;
}
 
1;
 
package Sledge::Model::CDBI;
use strict;
use warnings;
use base 'Sledge::Model';
use UNIVERSAL::require;
 
sub get {
    my ($self, $name) = @_;
    my $cdbi = $self->_get_class;
    my $cdbi_class = "$cdbi\::$name";
    $cdbi_class->use or die $@;
    return $cdbi_class;
}
 
sub _get_class { shift->{page}->config->{cdbi_class} }
 
1;
 
package Sledge::Model::DBIC::Schema;
use strict;
use base qw/Sledge::Model/;
use UNIVERSAL::require;
our $VERSION = '0.01';
 
sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->connect;
}
 
sub connect {
    my $self = shift;
    my $schema_class = $self->{page}->config->{schema_class};
    $schema_class->use or die $@;
    return $schema_class->connect($self->{page}->config->datasource);
}
 
1;
 
package Sledge::Plugin::Model;
use strict;
use warnings;
our $VERSION = '0.01';
use Sledge::Exceptions;
 
sub import {
    my $self = shift;
    my $pkg  = caller;
 
    $pkg->mk_accessors('model');
    $pkg->add_trigger(AFTER_INIT => sub {
        my $self = shift;
        $self->model($self->create_model);
    });
 
    {
        no strict 'refs'; ## no critic
        *{"$pkg\::create_model"} = sub {
            Sledge::Exception::AbstractMethod->throw
        };
    }
}
 
1;

For CDBI.
in your config.yaml:

  cdbi_class: Proj::Data
  datasource:
    - dbi:mysql:proj
    - user
    - passwd

in your controller:

  sub create_model { Sledge::Model::CDBI->new(shift) }
 
  sub dispatch_index {
    my $self = shift;
    my $memo = $self->model->get('Memo')->retrieve_all;
  }

For DBIC::Schema.
in your config.yaml:

  schema_class: Proj::Schema
  datasource:
    - dbi:mysql:proj
    - user
    - passwd

in your controller:

  sub create_model { Sledge::Model::DBIC::Schema->new(shift) }
 
  sub dispatch_index {
    my $self = shift;
    my $memo = $self->model->resultset('Hoge')->search({});
  }

Wednesday November 01, 2006
10:42 AM

DBIx::Class::Schema for Sledge.

I will do MoFedge::Data::DBIC::Schema and do the porting to Sledge::Model.

MoFedge::Data::DBIC::Schema is here.
http://code.mfac.jp/trac/browser/MoFedge-Data-DBIC-Schema/

By the way, MoFedge is a rapper of Sledge used my working.

Sledge is cool Web Application Framework.
But,it becomes old for a moment.
I want to help to improve it even a little.

See:
Ikebe-san.http://use.perl.org/~ikebe/journal/
and
Tokuhirom-san.http://use.perl.org/~tokuhirom/journal/

04:21 AM

list grep

[ #31466 ]

I want to extract only the value that exists in another array by the value of a certain array.
It cannot be done in List::MoreUtils.
And I wrote such.

package List::Grep;
use strict;
use warnings;
use base 'Exporter';
use vars qw(@EXPORT_OK %EXPORT_TAGS);
@EXPORT_OK = qw/list_grep/;
 
sub list_grep {
    my $args = shift;
    my %tmp;
    @tmp{@{$args->{base}}} = @{$args->{base}};
    return wantarray ? @tmp{@{$args->{grep_key}}} : [@tmp{@{$args->{grep_key}}}];
}
 
1;
__END__
 
=head1 SYNOPSIS
 
    use List::Grep qw/list_grep/;
    my @hoge = qw/1 2 3 4 5 5/;
    my @moge = qw/2 5/;
 
    my @result = list_grep({base => \@hoge,grep_key => \@moge});
 
    ## 2,5 in @result
 
=head1 THANKS TO
 
tokuhirom

more idea?

PS.

http://rafb.net/paste/results/UdqEr958.html
Thanks to hio_d and #catalyst-ja's member.

02:01 AM

I wrote DBIx::Class::AsFdat

[ #31465 ]

I wrote DBIx::Class::AsFdat.

DBIx::Class::AsFdat like Class::DBI::Plugin::AsFdat.

package DBIx::Class::AsFdat;
use strict;
use warnings;
use base 'DBIx::Class';
use Scalar::Util qw/blessed/;
 
our $VERSION = 0.01;
 
sub as_fdat {
    my $self = shift;
 
    my $fdat;
    for my $column ($self->result_source->columns) {
        $fdat->{$column} = $self->$column;
 
        # inflate the datetime
        if (blessed $fdat->{$column} and $fdat->{$column}->isa('DateTime')) {
            for my $type (qw(year month day hour minute second)) {
                $fdat->{"${column}_$type"}  = $fdat->{$column}->$type;
            }
        }
    }
    return $fdat;
}
 
1;
 
__END__
 
=head1 SYNOPSIS
 
    __PACKAGE__->load_components(qw/
        AsFdat
    /);
 
    my $ad = $self->model('Ad')->search(rid => $self->r->param('ad_rid'))->first;
    $self->fillin_form->fdat($ad->as_fdat);

HTML::FillInForm and compatibility are good.
It is indispensable in Web Application.
enjoy!!

PS.
However, this module is not released to CPAN.