nekokak's Journal nekokak's use Perl Journal en-us use Perl; is Copyright 1998-2006, Chris Nandor. Stories, comments, journals, and other submissions posted on use Perl; are Copyright their respective owners. 2012-01-25T02:43:50+00:00 pudge Technology hourly 1 1970-01-01T00:00+00:00 nekokak's Journal Sledge::Model(EXPERIMENTAL) <p>I wrote Sledge::Model.</p><p>This module is EXPERIMENTAL!</p><blockquote><div><p> <tt>package Sledge::Model;<br>use strict;<br>use warnings;<br>our $VERSION = 0.01;<br>use Sledge::Exceptions;<br> &nbsp; <br>sub new {<br>&nbsp; &nbsp; my ($class, $page) = @_;<br>&nbsp; &nbsp; return bless {page =&gt; $page}, $class;<br>}<br> &nbsp; <br>1;<br> &nbsp; <br>package Sledge::Model::CDBI;<br>use strict;<br>use warnings;<br>use base 'Sledge::Model';<br>use UNIVERSAL::require;<br> &nbsp; <br>sub get {<br>&nbsp; &nbsp; my ($self, $name) = @_;<br>&nbsp; &nbsp; my $cdbi = $self-&gt;_get_class;<br>&nbsp; &nbsp; my $cdbi_class = "$cdbi\::$name";<br>&nbsp; &nbsp; $cdbi_class-&gt;use or die $@;<br>&nbsp; &nbsp; return $cdbi_class;<br>}<br> &nbsp; <br>sub _get_class { shift-&gt;{page}-&gt;config-&gt;{cdbi_class} }<br> &nbsp; <br>1;<br> &nbsp; <br>package Sledge::Model::DBIC::Schema;<br>use strict;<br>use base qw/Sledge::Model/;<br>use UNIVERSAL::require;<br>our $VERSION = '0.01';<br> &nbsp; <br>sub new {<br>&nbsp; &nbsp; my $class = shift;<br>&nbsp; &nbsp; my $self&nbsp; = $class-&gt;SUPER::new(@_);<br>&nbsp; &nbsp; $self-&gt;connect;<br>}<br> &nbsp; <br>sub connect {<br>&nbsp; &nbsp; my $self = shift;<br>&nbsp; &nbsp; my $schema_class = $self-&gt;{page}-&gt;config-&gt;{schema_class};<br>&nbsp; &nbsp; $schema_class-&gt;use or die $@;<br>&nbsp; &nbsp; return $schema_class-&gt;connect($self-&gt;{page}-&gt;config-&gt;datasource);<br>}<br> &nbsp; <br>1;<br> &nbsp; <br>package Sledge::Plugin::Model;<br>use strict;<br>use warnings;<br>our $VERSION = '0.01';<br>use Sledge::Exceptions;<br> &nbsp; <br>sub import {<br>&nbsp; &nbsp; my $self = shift;<br>&nbsp; &nbsp; my $pkg&nbsp; = caller;<br> &nbsp; <br>&nbsp; &nbsp; $pkg-&gt;mk_accessors('model');<br>&nbsp; &nbsp; $pkg-&gt;add_trigger(AFTER_INIT =&gt; sub {<br>&nbsp; &nbsp; &nbsp; &nbsp; my $self = shift;<br>&nbsp; &nbsp; &nbsp; &nbsp; $self-&gt;model($self-&gt;create_model);<br>&nbsp; &nbsp; });<br> &nbsp; <br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; no strict 'refs'; ## no critic<br>&nbsp; &nbsp; &nbsp; &nbsp; *{"$pkg\::create_model"} = sub {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Sledge::Exception::AbstractMethod-&gt;throw<br>&nbsp; &nbsp; &nbsp; &nbsp; };<br>&nbsp; &nbsp; }<br>}<br> &nbsp; <br>1;</tt></p></div> </blockquote><p>For CDBI.<br>in your config.yaml:</p><blockquote><div><p> <tt>&nbsp; cdbi_class: Proj::Data<br>&nbsp; datasource:<br>&nbsp; &nbsp; - dbi:mysql:proj<br>&nbsp; &nbsp; - user<br>&nbsp; &nbsp; - passwd</tt></p></div> </blockquote><p>in your controller:</p><blockquote><div><p> <tt>&nbsp; sub create_model { Sledge::Model::CDBI-&gt;new(shift) }<br> &nbsp; <br>&nbsp; sub dispatch_index {<br>&nbsp; &nbsp; my $self = shift;<br>&nbsp; &nbsp; my $memo = $self-&gt;model-&gt;get('Memo')-&gt;retrieve_all;<br>&nbsp; }</tt></p></div> </blockquote><p>For DBIC::Schema.<br>in your config.yaml:</p><blockquote><div><p> <tt>&nbsp; schema_class: Proj::Schema<br>&nbsp; datasource:<br>&nbsp; &nbsp; - dbi:mysql:proj<br>&nbsp; &nbsp; - user<br>&nbsp; &nbsp; - passwd</tt></p></div> </blockquote><p>in your controller:</p><blockquote><div><p> <tt>&nbsp; sub create_model { Sledge::Model::DBIC::Schema-&gt;new(shift) }<br> &nbsp; <br>&nbsp; sub dispatch_index {<br>&nbsp; &nbsp; my $self = shift;<br>&nbsp; &nbsp; my $memo = $self-&gt;model-&gt;resultset('Hoge')-&gt;search({});<br>&nbsp; }</tt></p></div> </blockquote> nekokak 2006-11-02T07:25:24+00:00 useperl DBIx::Class::Schema for Sledge. <p>I will do MoFedge::Data::DBIC::Schema and do the porting to Sledge::Model.</p><p>MoFedge::Data::DBIC::Schema is here.<br><a href=""></a></p><p>By the way, MoFedge is a rapper of Sledge used my working.</p><p>Sledge is cool Web Application Framework.<br>But,it becomes old for a moment.<br>I want to help to improve it even a little.</p><p>See:<br>Ikebe-san.<a href=""></a><br>and<br>Tokuhirom-san.<a href=""></a></p> nekokak 2006-11-01T15:42:49+00:00 useperl list grep <p>I want to extract only the value that exists in another array by the value of a certain array.<br>It cannot be done in List::MoreUtils.<br>And I wrote such.</p><blockquote><div><p> <tt>package List::Grep;<br>use strict;<br>use warnings;<br>use base 'Exporter';<br>use vars qw(@EXPORT_OK %EXPORT_TAGS);<br>@EXPORT_OK = qw/list_grep/;<br> &nbsp; <br>sub list_grep {<br>&nbsp; &nbsp; my $args = shift;<br>&nbsp; &nbsp; my %tmp;<br>&nbsp; &nbsp; @tmp{@{$args-&gt;{base}}} = @{$args-&gt;{base}};<br>&nbsp; &nbsp; return wantarray ? @tmp{@{$args-&gt;{grep_key}}} : [@tmp{@{$args-&gt;{grep_key}}}];<br>}<br> &nbsp; <br>1;<br>__END__<br> &nbsp; <br>=head1 SYNOPSIS<br> &nbsp; <br>&nbsp; &nbsp; use List::Grep qw/list_grep/;<br>&nbsp; &nbsp; my @hoge = qw/1 2 3 4 5 5/;<br>&nbsp; &nbsp; my @moge = qw/2 5/;<br> &nbsp; <br>&nbsp; &nbsp; my @result = list_grep({base =&gt; \@hoge,grep_key =&gt; \@moge});<br> &nbsp; <br>&nbsp; &nbsp; ## 2,5 in @result<br> &nbsp; <br>=head1 THANKS TO<br> &nbsp; <br>tokuhirom</tt></p></div> </blockquote><p>more idea?</p><p>PS.</p><p><br>Thanks to hio_d and #catalyst-ja's member.</p> nekokak 2006-11-01T09:21:11+00:00 useperl I wrote DBIx::Class::AsFdat <p>I wrote DBIx::Class::AsFdat.</p><p>DBIx::Class::AsFdat like Class::DBI::Plugin::AsFdat.</p><blockquote><div><p> <tt>package DBIx::Class::AsFdat;<br>use strict;<br>use warnings;<br>use base 'DBIx::Class';<br>use Scalar::Util qw/blessed/;<br> &nbsp; <br>our $VERSION = 0.01;<br> &nbsp; <br>sub as_fdat {<br>&nbsp; &nbsp; my $self = shift;<br> &nbsp; <br>&nbsp; &nbsp; my $fdat;<br>&nbsp; &nbsp; for my $column ($self-&gt;result_source-&gt;columns) {<br>&nbsp; &nbsp; &nbsp; &nbsp; $fdat-&gt;{$column} = $self-&gt;$column;<br> &nbsp; <br>&nbsp; &nbsp; &nbsp; &nbsp; # inflate the datetime<br>&nbsp; &nbsp; &nbsp; &nbsp; if (blessed $fdat-&gt;{$column} and $fdat-&gt;{$column}-&gt;isa('DateTime')) {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; for my $type (qw(year month day hour minute second)) {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; $fdat-&gt;{"${column}_$type"}&nbsp; = $fdat-&gt;{$column}-&gt;$type;<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; }<br>&nbsp; &nbsp; return $fdat;<br>}<br> &nbsp; <br>1;<br> &nbsp; <br>__END__<br> &nbsp; <br>=head1 SYNOPSIS<br> &nbsp; <br>&nbsp; &nbsp; __PACKAGE__-&gt;load_components(qw/<br>&nbsp; &nbsp; &nbsp; &nbsp; AsFdat<br>&nbsp; &nbsp;<nobr> <wbr></nobr>/);<br> &nbsp; <br>&nbsp; &nbsp; my $ad = $self-&gt;model('Ad')-&gt;search(rid =&gt; $self-&gt;r-&gt;param('ad_rid'))-&gt;first;<br>&nbsp; &nbsp; $self-&gt;fillin_form-&gt;fdat($ad-&gt;as_fdat);</tt></p></div> </blockquote><p>HTML::FillInForm and compatibility are good.<br>It is indispensable in Web Application.<br>enjoy!!</p><p>PS.<br>However, this module is not released to CPAN.</p> nekokak 2006-11-01T07:01:55+00:00 useperl